From 183218aa6c54efafa20829624f6c7d1d34530b3c Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 23 Apr 2020 17:43:35 -0600 Subject: [PATCH 01/51] updated orbital calculations needed for cesm --- .../drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 222 +++++++++++++++--- 1 file changed, 191 insertions(+), 31 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index 29cd34320..49218ffe3 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -15,11 +15,11 @@ module ice_comp_nuopc use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock use NUOPC_Model , only : model_label_Finalize => label_Finalize use NUOPC_Model , only : NUOPC_ModelGet, SetVM - use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs use shr_sys_mod , only : shr_sys_abort, shr_sys_flush use shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit use shr_string_mod , only : shr_string_listGetNum - use shr_orb_mod , only : shr_orb_decl + use shr_orb_mod , only : shr_orb_decl, shr_orb_params, SHR_ORB_UNDEF_REAL, SHR_ORB_UNDEF_INT use shr_const_mod use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date use ice_constants , only : ice_init_constants @@ -71,6 +71,7 @@ module ice_comp_nuopc private :: ModelAdvance private :: ModelSetRunClock private :: ModelFinalize + private :: ice_orbital_init ! only for cesm character(len=CL) :: flds_scalar_name = '' integer :: flds_scalar_num = 0 @@ -78,6 +79,17 @@ module ice_comp_nuopc integer :: flds_scalar_index_ny = 0 integer :: flds_scalar_index_nextsw_cday = 0 + character(len=CL) :: orb_mode ! attribute - orbital mode + integer :: orb_iyear ! attribute - orbital year + integer :: orb_iyear_align ! attribute - associated with model year + real(R8) :: orb_obliq ! attribute - obliquity in degrees + real(R8) :: orb_mvelp ! attribute - moving vernal equinox longitude + real(R8) :: orb_eccen ! attribute and update- orbital eccentricity + + character(len=*) , parameter :: orb_fixed_year = 'fixed_year' + character(len=*) , parameter :: orb_variable_year = 'variable_year' + character(len=*) , parameter :: orb_fixed_parameters = 'fixed_parameters' + integer , parameter :: dbug = 10 integer , parameter :: debug_import = 0 ! internal debug level integer , parameter :: debug_export = 0 ! internal debug level @@ -346,31 +358,32 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ice_init_constants(omega_in=SHR_CONST_OMEGA, radius_in=SHR_CONST_REARTH, & spval_dbl_in=SHR_CONST_SPVAL) + call icepack_init_parameters( & - secday_in = SHR_CONST_CDAY, & - rhoi_in = SHR_CONST_RHOICE, & - rhow_in = SHR_CONST_RHOSW, & - cp_air_in = SHR_CONST_CPDAIR, & - cp_ice_in = SHR_CONST_CPICE, & - cp_ocn_in = SHR_CONST_CPSW, & - gravit_in = SHR_CONST_G, & - rhofresh_in = SHR_CONST_RHOFW, & - zvir_in = SHR_CONST_ZVIR, & - vonkar_in = SHR_CONST_KARMAN, & - cp_wv_in = SHR_CONST_CPWV, & - stefan_boltzmann_in = SHR_CONST_STEBOL, & - Tffresh_in= SHR_CONST_TKFRZ, & - Lsub_in = SHR_CONST_LATSUB, & - Lvap_in = SHR_CONST_LATVAP, & -! Lfresh_in = SHR_CONST_LATICE, & ! computed in init_parameters as Lsub-Lvap - Timelt_in = SHR_CONST_TKFRZ-SHR_CONST_TKFRZ, & - Tsmelt_in = SHR_CONST_TKFRZ-SHR_CONST_TKFRZ, & - ice_ref_salinity_in = SHR_CONST_ICE_REF_SAL, & - depressT_in = 0.054_dbl_kind, & - Tocnfrz_in= -34.0_dbl_kind*0.054_dbl_kind, & - pi_in = SHR_CONST_PI, & - snowpatch_in = 0.005_dbl_kind, & - dragio_in = 0.00962_dbl_kind) + secday_in = SHR_CONST_CDAY, & + rhoi_in = SHR_CONST_RHOICE, & + rhow_in = SHR_CONST_RHOSW, & + cp_air_in = SHR_CONST_CPDAIR, & + cp_ice_in = SHR_CONST_CPICE, & + cp_ocn_in = SHR_CONST_CPSW, & + gravit_in = SHR_CONST_G, & + rhofresh_in = SHR_CONST_RHOFW, & + zvir_in = SHR_CONST_ZVIR, & + vonkar_in = SHR_CONST_KARMAN, & + cp_wv_in = SHR_CONST_CPWV, & + stefan_boltzmann_in = SHR_CONST_STEBOL, & + Tffresh_in = SHR_CONST_TKFRZ, & + Lsub_in = SHR_CONST_LATSUB, & + Lvap_in = SHR_CONST_LATVAP, & + !Lfresh_in = SHR_CONST_LATICE, & ! computed in init_parameters as Lsub-Lvap + Timelt_in = SHR_CONST_TKFRZ-SHR_CONST_TKFRZ, & + Tsmelt_in = SHR_CONST_TKFRZ-SHR_CONST_TKFRZ, & + ice_ref_salinity_in = SHR_CONST_ICE_REF_SAL, & + depressT_in = 0.054_dbl_kind, & + Tocnfrz_in = -34.0_dbl_kind*0.054_dbl_kind, & + pi_in = SHR_CONST_PI, & + snowpatch_in = 0.005_dbl_kind, & + dragio_in = 0.00962_dbl_kind) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -382,6 +395,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Get orbital values ! Note that these values are obtained in a call to init_orbit in ice_shortwave.F90 ! if CESMCOUPLED is not defined +#ifdef CESMCOUPLED + call ice_orbital_init(gcomp, clock, nu_diag, my_task==master_task, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return +#else call NUOPC_CompAttributeGet(gcomp, name='orb_eccen', value=cvalue, isPresent=isPresent, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then @@ -403,11 +420,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) read(cvalue,*) mvelpp end if - call icepack_init_orbit(eccen_in=eccen, mvelpp_in=mvelpp, & - lambm0_in=lambm0, obliqr_in=obliqr) + call icepack_init_orbit(eccen_in=eccen, mvelpp_in=mvelpp, lambm0_in=lambm0, obliqr_in=obliqr) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) +#endif ! Determine runtype and possibly nextsw_cday call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, isPresent=isPresent, rc=rc) @@ -429,7 +446,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! In the nuopc version it will be easier to assume that on startup - nextsw_cday is just the current time ! TOOD (mvertens, 2019-03-21): need to get the perpetual run working - + if (trim(runtype) /= 'initial') then ! Set nextsw_cday to -1 (this will skip an orbital calculation on initialization nextsw_cday = -1.0_r8 @@ -441,7 +458,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end if else ! This would be the NEMS branch - ! Note that in NEMS - nextsw_cday is not needed in ice_orbital.F90 and what is needed is + ! Note that in NEMS - nextsw_cday is not needed in ice_orbital.F90 and what is needed is ! simply a CPP variable declaratino of NEMSCOUPLED runtype = 'initial' ! determined from the namelist in ice_init if CESMCOUPLED is not defined @@ -876,7 +893,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_name=flds_scalar_name, flds_scalar_num=flds_scalar_num, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return -#ifdef CESMCOUPLED +#ifdef CESMCOUPLED !----------------------------------------------------------------- ! Prescribed ice initialization - first get compid !----------------------------------------------------------------- @@ -1024,6 +1041,10 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- ! Obtain orbital values !-------------------------------- +#ifdef CESMCOUPLED + call ice_orbital_init(gcomp, clock, nu_diag, my_task==master_task, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return +#else call NUOPC_CompAttributeGet(gcomp, name='orb_eccen', value=cvalue, isPresent=isPresent, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then @@ -1050,6 +1071,7 @@ subroutine ModelAdvance(gcomp, rc) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) +#endif !-------------------------------- ! check that cice internal time is in sync with master clock before timestep update @@ -1349,4 +1371,142 @@ subroutine ModelFinalize(gcomp, rc) end subroutine ModelFinalize + !=============================================================================== + + subroutine ice_orbital_init(gcomp, clock, logunit, mastertask, rc) + + !---------------------------------------------------------- + ! Initialize orbital related values for cesm coupled + !---------------------------------------------------------- + + ! input/output variables + type(ESMF_GridComp) :: gcomp + type(ESMF_Clock) , intent(in) :: clock + integer , intent(in) :: logunit + logical , intent(in) :: mastertask + integer , intent(out) :: rc ! output error + + ! local variables + real(r8) :: eccen, obliqr, lambm0, mvelpp + character(len=CL) :: msgstr ! temporary + character(len=CL) :: cvalue ! temporary + type(ESMF_Time) :: CurrTime ! current time + integer :: year ! model year at current time + integer :: orb_year ! orbital year for current orbital computation + logical :: lprint + logical :: first_time = .true. + character(len=*) , parameter :: subname = "(cice_orbital_init)" + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + if (first_time) then + + ! Determine orbital attributes from input + call NUOPC_CompAttributeGet(gcomp, name='orb_mode', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) orb_mode + call NUOPC_CompAttributeGet(gcomp, name="orb_iyear", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) orb_iyear + call NUOPC_CompAttributeGet(gcomp, name="orb_iyear_align", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) orb_iyear_align + call NUOPC_CompAttributeGet(gcomp, name="orb_obliq", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) orb_obliq + call NUOPC_CompAttributeGet(gcomp, name="orb_eccen", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) orb_eccen + call NUOPC_CompAttributeGet(gcomp, name="orb_mvelp", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) orb_mvelp + + ! Error checks + if (trim(orb_mode) == trim(orb_fixed_year)) then + orb_obliq = SHR_ORB_UNDEF_REAL + orb_eccen = SHR_ORB_UNDEF_REAL + orb_mvelp = SHR_ORB_UNDEF_REAL + if (orb_iyear == SHR_ORB_UNDEF_INT) then + if (mastertask) then + write(logunit,*) trim(subname),' ERROR: invalid settings orb_mode =',trim(orb_mode) + write(logunit,*) trim(subname),' ERROR: fixed_year settings = ',orb_iyear + write (msgstr, *) ' ERROR: invalid settings for orb_mode '//trim(orb_mode) + end if + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + elseif (trim(orb_mode) == trim(orb_variable_year)) then + orb_obliq = SHR_ORB_UNDEF_REAL + orb_eccen = SHR_ORB_UNDEF_REAL + orb_mvelp = SHR_ORB_UNDEF_REAL + if (orb_iyear == SHR_ORB_UNDEF_INT .or. orb_iyear_align == SHR_ORB_UNDEF_INT) then + if (mastertask) then + write(logunit,*) trim(subname),' ERROR: invalid settings orb_mode =',trim(orb_mode) + write(logunit,*) trim(subname),' ERROR: variable_year settings = ',orb_iyear, orb_iyear_align + write (msgstr, *) subname//' ERROR: invalid settings for orb_mode '//trim(orb_mode) + end if + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + elseif (trim(orb_mode) == trim(orb_fixed_parameters)) then + !-- force orb_iyear to undef to make sure shr_orb_params works properly + orb_iyear = SHR_ORB_UNDEF_INT + orb_iyear_align = SHR_ORB_UNDEF_INT + if (orb_eccen == SHR_ORB_UNDEF_REAL .or. & + orb_obliq == SHR_ORB_UNDEF_REAL .or. & + orb_mvelp == SHR_ORB_UNDEF_REAL) then + if (mastertask) then + write(logunit,*) trim(subname),' ERROR: invalid settings orb_mode =',trim(orb_mode) + write(logunit,*) trim(subname),' ERROR: orb_eccen = ',orb_eccen + write(logunit,*) trim(subname),' ERROR: orb_obliq = ',orb_obliq + write(logunit,*) trim(subname),' ERROR: orb_mvelp = ',orb_mvelp + write (msgstr, *) subname//' ERROR: invalid settings for orb_mode '//trim(orb_mode) + end if + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + else + write (msgstr, *) subname//' ERROR: invalid orb_mode '//trim(orb_mode) + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + rc = ESMF_FAILURE + return ! bail out + endif + end if + + if (trim(orb_mode) == trim(orb_variable_year)) then + call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(CurrTime, yy=year, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + orb_year = orb_iyear + (year - orb_iyear_align) + lprint = mastertask + else + orb_year = orb_iyear + if (first_time) then + lprint = mastertask + else + lprint = .false. + end if + end if + + eccen = orb_eccen + call shr_orb_params(orb_year, eccen, orb_obliq, orb_mvelp, obliqr, lambm0, mvelpp, lprint) + + if ( eccen == SHR_ORB_UNDEF_REAL .or. obliqr == SHR_ORB_UNDEF_REAL .or. & + mvelpp == SHR_ORB_UNDEF_REAL .or. lambm0 == SHR_ORB_UNDEF_REAL) then + write (msgstr, *) subname//' ERROR: orb params incorrect' + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + + call icepack_init_orbit(eccen_in=eccen, mvelpp_in=mvelpp, lambm0_in=lambm0, obliqr_in=obliqr) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + first_time = .false. + + end subroutine ice_orbital_init + end module ice_comp_nuopc From 10e7c203d9492eca34787e284edd8e0159f75e6e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 29 Apr 2020 16:36:09 -0600 Subject: [PATCH 02/51] fixed problems in updated orbital calculations needed for cesm --- cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 | 2 +- cicecore/drivers/nuopc/cmeps/ice_import_export.F90 | 8 ++------ cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 | 2 +- 3 files changed, 4 insertions(+), 8 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 index 09cffa0c7..f5e7de02f 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 @@ -374,7 +374,7 @@ subroutine coupling_prep (iblk) fsens, flat, fswabs, flwout, evap, Tref, Qref, & scale_fluxes, frzmlt_init, frzmlt, Uref, wind use ice_flux_bgc, only: faero_ocn, fiso_ocn, Qref_iso, fiso_evap, & - fzsal_ai, fzsal_g_ai, flux_bio, flux_bio_ai + fzsal_ai, fzsal_g_ai, flux_bio, flux_bio_ai, & fnit, fsil, famm, fdmsp, fdms, fhum, fdust, falgalN, & fdoc, fdic, fdon, ffep, ffed, bgcflux_ice_to_ocn use ice_grid, only: tmask diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index 0fe2510aa..5e423fbb6 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -1039,7 +1039,6 @@ subroutine ice_export( exportState, rc ) lmask=tmask, ifrac=ailohi, ungridded_index=2, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif -#endif ! ------ ! optional short wave penetration to ocean ice category @@ -1056,11 +1055,12 @@ subroutine ice_export( exportState, rc ) ! penetrative shortwave by category ! Note: no need zero out pass-through fields over land for benefit of x2oacc fields in cpl hist files since ! the export state has been zeroed out at the beginning - call state_setexport(exportState, 'mean_sw_pen_to_ocn_ifrac_n', input=aicen_init, index=n, & + call state_setexport(exportState, 'mean_sw_pen_to_ocn_ifrac_n', input=fswthrun_ai, index=n, & lmask=tmask, ifrac=ailohi, ungridded_index=n, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do end if +#endif end subroutine ice_export @@ -1488,10 +1488,6 @@ subroutine state_setexport_4d_input(state, fldname, input, index, lmask, ifrac, if (geomtype == ESMF_GEOMTYPE_MESH) then - if (present(ungridded_index)) then - write(6,*)'DEBUG: fldname = ',trim(fldname),' has ungridded index= ',ungridded_index - end if - ! get field pointer if (present(ungridded_index)) then call state_getfldptr(state, trim(fldname), dataPtr2d, rc) diff --git a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 index f597015f3..4c3876f6c 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 @@ -49,7 +49,7 @@ module ice_prescribed_mod ! !PUBLIC DATA MEMBERS: logical(kind=log_kind), public :: prescribed_ice ! true if prescribed ice - integer(SHR_KIND_IN),parameter :: nFilesMaximum = 400 ! max number of files + integer(kind=int_kind),parameter :: nFilesMaximum = 400 ! max number of files integer(kind=int_kind) :: stream_year_first ! first year in stream to use integer(kind=int_kind) :: stream_year_last ! last year in stream to use integer(kind=int_kind) :: model_year_align ! align stream_year_first From ce8e5a97d051dd9ff4715f6eec6829271d774836 Mon Sep 17 00:00:00 2001 From: apcraig Date: Sat, 9 May 2020 21:29:22 -0600 Subject: [PATCH 03/51] update CICE6 to support coupling with UFS --- cicecore/cicedynB/general/ice_init.F90 | 4 +- cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 | 2 +- cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 | 4 + .../drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 206 ++++++++++++------ .../drivers/nuopc/cmeps/ice_import_export.F90 | 72 +++++- .../nuopc/cmeps/ice_prescribed_mod.F90 | 11 +- .../drivers/nuopc/cmeps/ice_shr_methods.F90 | 80 +++---- configuration/scripts/Makefile | 23 +- configuration/scripts/cice.build | 15 +- forapps/ufs/comp_ice.backend.clean | 42 ++++ forapps/ufs/comp_ice.backend.libcice | 142 ++++++++++++ 11 files changed, 479 insertions(+), 122 deletions(-) create mode 100755 forapps/ufs/comp_ice.backend.clean create mode 100755 forapps/ufs/comp_ice.backend.libcice diff --git a/cicecore/cicedynB/general/ice_init.F90 b/cicecore/cicedynB/general/ice_init.F90 index ffb070644..6ffe3d05c 100644 --- a/cicecore/cicedynB/general/ice_init.F90 +++ b/cicecore/cicedynB/general/ice_init.F90 @@ -276,7 +276,7 @@ subroutine input_data kmt_file = 'unknown_kmt_file' version_name = 'unknown_version_name' ncat = 0 ! number of ice thickness categories - nfsd = 0 ! number of floe size categories (1 = default) + nfsd = 1 ! number of floe size categories (1 = default) nilyr = 0 ! number of vertical ice layers nslyr = 0 ! number of vertical snow layers nblyr = 0 ! number of bio layers @@ -748,7 +748,7 @@ subroutine input_data ice_ic /= 'none' .and. ice_ic /= 'default') then if (my_task == master_task) then write(nu_diag,*) subname//' ERROR: runtype, restart, ice_ic are inconsistent:' - write(nu_diag,*) subname//' ERROR: runtype=',trim(runtype), 'restart=',restart, 'ice_ic=',trim(ice_ic) + write(nu_diag,*) subname//' ERROR: runtype=',trim(runtype), ' restart=',restart, ' ice_ic=',trim(ice_ic) write(nu_diag,*) subname//' ERROR: Please review user guide' endif abort_flag = 1 diff --git a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 index b72745e30..16e4216e6 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 @@ -204,9 +204,9 @@ subroutine cice_init(mpicom_ice) ! coupler communication or forcing data initialization !-------------------------------------------------------------------- +#ifndef coupled call init_forcing_atmo ! initialize atmospheric forcing (standalone) -#ifndef coupled #ifndef CESMCOUPLED if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice call get_forcing_atmo ! atmospheric forcing from data diff --git a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 index f5e7de02f..aed00a9a0 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 @@ -15,7 +15,9 @@ module CICE_RunMod use ice_kinds_mod +#ifdef CESMCOUPLED use perf_mod, only : t_startf, t_stopf, t_barrierf +#endif use ice_fileunits, only: nu_diag use ice_arrays_column, only: oceanmixed_ice use ice_constants, only: c0, c1 @@ -207,12 +209,14 @@ subroutine ice_step call init_history_bgc call ice_timer_stop(timer_diags) ! diagnostics/history +#ifdef CESMCOUPLED if (prescribed_ice) then ! read prescribed ice call t_barrierf('cice_run_presc_BARRIER',MPI_COMM_ICE) call t_startf ('cice_run_presc') call ice_prescribed_run(idate, sec) call t_stopf ('cice_run_presc') endif +#endif call save_init diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index 49218ffe3..e4c2a3802 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -15,13 +15,12 @@ module ice_comp_nuopc use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock use NUOPC_Model , only : model_label_Finalize => label_Finalize use NUOPC_Model , only : NUOPC_ModelGet, SetVM - use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs - use shr_sys_mod , only : shr_sys_abort, shr_sys_flush +#ifdef CESMCOUPLED use shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit - use shr_string_mod , only : shr_string_listGetNum use shr_orb_mod , only : shr_orb_decl, shr_orb_params, SHR_ORB_UNDEF_REAL, SHR_ORB_UNDEF_INT use shr_const_mod - use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date + use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian +#endif use ice_constants , only : ice_init_constants use ice_shr_methods , only : chkerr, state_setscalar, state_getscalar, state_diagnose, alarmInit use ice_shr_methods , only : set_component_logging, get_component_instance @@ -38,15 +37,17 @@ module ice_comp_nuopc use ice_calendar , only : force_restart_now, write_ic use ice_calendar , only : idate, mday, time, month, daycal, time2sec, year_init use ice_calendar , only : sec, dt, calendar, calendar_type, nextsw_cday, istep - use ice_kinds_mod , only : dbl_kind, int_kind, char_len + use ice_kinds_mod , only : dbl_kind, int_kind, char_len, char_len_long use ice_scam , only : scmlat, scmlon, single_column - use ice_fileunits , only : nu_diag, nu_diag_set, inst_index, inst_name, inst_suffix, release_all_fileunits + use ice_fileunits , only : nu_diag, nu_diag_set, inst_index, inst_name, inst_suffix, release_all_fileunits, flush_fileunit use ice_restart_shared , only : runid, runtype, restart_dir, restart_file use ice_history , only : accum_hist #if (defined NEWCODE) use ice_history_shared , only : model_doi_url ! TODO: add this functionality #endif +#ifdef CESMCOUPLED use ice_prescribed_mod , only : ice_prescribed_init +#endif #if (defined NEWCODE) use ice_atmo , only : flux_convergence_tolerance, flux_convergence_max_iteration use ice_atmo , only : use_coldair_outbreak_mod @@ -55,12 +56,15 @@ module ice_comp_nuopc use CICE_RunMod , only : CICE_Run use ice_exit , only : abort_ice use icepack_intfc , only : icepack_warnings_flush, icepack_warnings_aborted - use icepack_intfc , only : icepack_init_orbit, icepack_init_parameters + use icepack_intfc , only : icepack_init_orbit, icepack_init_parameters, icepack_query_orbit use icepack_intfc , only : icepack_query_tracer_flags, icepack_query_parameters +#ifdef CESMCOUPLED use perf_mod , only : t_startf, t_stopf, t_barrierf +#endif use ice_timers implicit none + private public :: SetServices public :: SetVM @@ -71,20 +75,22 @@ module ice_comp_nuopc private :: ModelAdvance private :: ModelSetRunClock private :: ModelFinalize +#ifdef CESMCOUPLED private :: ice_orbital_init ! only for cesm +#endif - character(len=CL) :: flds_scalar_name = '' + character(len=char_len_long) :: flds_scalar_name = '' integer :: flds_scalar_num = 0 integer :: flds_scalar_index_nx = 0 integer :: flds_scalar_index_ny = 0 integer :: flds_scalar_index_nextsw_cday = 0 - character(len=CL) :: orb_mode ! attribute - orbital mode + character(len=char_len_long) :: orb_mode ! attribute - orbital mode integer :: orb_iyear ! attribute - orbital year integer :: orb_iyear_align ! attribute - associated with model year - real(R8) :: orb_obliq ! attribute - obliquity in degrees - real(R8) :: orb_mvelp ! attribute - moving vernal equinox longitude - real(R8) :: orb_eccen ! attribute and update- orbital eccentricity + real(dbl_kind) :: orb_obliq ! attribute - obliquity in degrees + real(dbl_kind) :: orb_mvelp ! attribute - moving vernal equinox longitude + real(dbl_kind) :: orb_eccen ! attribute and update- orbital eccentricity character(len=*) , parameter :: orb_fixed_year = 'fixed_year' character(len=*) , parameter :: orb_variable_year = 'variable_year' @@ -182,8 +188,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer, intent(out) :: rc ! Local variables - character(len=CL) :: cvalue - character(len=CL) :: logmsg + character(len=char_len_long) :: cvalue + character(len=char_len_long) :: logmsg logical :: isPresent, isSet character(len=*), parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !-------------------------------- @@ -195,7 +201,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(trim(subname)//' flds_scalar_name = '//trim(flds_scalar_name), ESMF_LOGMSG_INFO) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call shr_sys_abort(subname//'Need to set attribute ScalarFieldName') + call abort_ice(subname//'Need to set attribute ScalarFieldName') endif call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) @@ -206,7 +212,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(trim(subname)//' flds_scalar_num = '//trim(logmsg), ESMF_LOGMSG_INFO) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call shr_sys_abort(subname//'Need to set attribute ScalarFieldCount') + call abort_ice(subname//'Need to set attribute ScalarFieldCount') endif call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) @@ -217,7 +223,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nx = '//trim(logmsg), ESMF_LOGMSG_INFO) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNX') + call abort_ice(subname//'Need to set attribute ScalarFieldIdxGridNX') endif call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) @@ -228,7 +234,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_ny = '//trim(logmsg), ESMF_LOGMSG_INFO) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNY') + call abort_ice(subname//'Need to set attribute ScalarFieldIdxGridNY') endif call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) @@ -239,7 +245,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nextsw_cday = '//trim(logmsg), ESMF_LOGMSG_INFO) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxNextSwCday') + call abort_ice(subname//'Need to set attribute ScalarFieldIdxNextSwCday') endif call ice_advertise_fields(gcomp, importState, exportState, flds_scalar_name, rc) @@ -263,15 +269,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) type(ESMF_Mesh) :: Emesh, EmeshTemp integer :: spatialDim integer :: numOwnedElements - real(R8), pointer :: ownedElemCoords(:) - real(r8), pointer :: lat(:), latMesh(:) - real(r8), pointer :: lon(:), lonMesh(:) + real(dbl_kind), pointer :: ownedElemCoords(:) + real(dbl_kind), pointer :: lat(:), latMesh(:) + real(dbl_kind), pointer :: lon(:), lonMesh(:) integer , allocatable :: gindex_ice(:) integer , allocatable :: gindex_elim(:) integer , allocatable :: gindex(:) integer :: globalID character(ESMF_MAXSTR) :: cvalue - real(r8) :: eccen, obliqr, lambm0, mvelpp + real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp character(len=char_len) :: tfrz_option character(ESMF_MAXSTR) :: convCIM, purpComp type(ESMF_VM) :: vm @@ -295,7 +301,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: dtime ! time step integer :: lmpicom integer :: shrlogunit ! original log unit - character(len=cs) :: starttype ! infodata start type + character(len=char_len) :: starttype ! infodata start type integer :: lsize ! local size of coupling array character(len=512) :: diro character(len=512) :: logfile @@ -307,8 +313,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain type(block) :: this_block ! block information for current block integer :: compid ! component id - character(len=CL) :: tempc1,tempc2 - real(R8) :: diff_lon + character(len=char_len_long) :: tempc1,tempc2 + real(dbl_kind) :: diff_lon integer :: npes integer :: num_elim_global integer :: num_elim_local @@ -350,12 +356,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! start cice timers !---------------------------------------------------------------------------- +#ifdef CESMCOUPLED call t_startf ('cice_init_total') +#endif !---------------------------------------------------------------------------- ! Initialize constants !---------------------------------------------------------------------------- +#ifdef CESMCOUPLED call ice_init_constants(omega_in=SHR_CONST_OMEGA, radius_in=SHR_CONST_REARTH, & spval_dbl_in=SHR_CONST_SPVAL) @@ -387,6 +396,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) +#endif !---------------------------------------------------------------------------- ! Determine attributes - also needed in realize phase to get grid information @@ -399,23 +409,29 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ice_orbital_init(gcomp, clock, nu_diag, my_task==master_task, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return #else + ! Start with icepack values then update with values defined in configure file if they exist + call icepack_query_orbit(eccen_out=eccen, mvelpp_out=mvelpp, lambm0_out=lambm0, obliqr_out=obliqr) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + call NUOPC_CompAttributeGet(gcomp, name='orb_eccen', value=cvalue, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then read(cvalue,*) eccen end if call NUOPC_CompAttributeGet(gcomp, name='orb_obliqr', value=cvalue, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then read(cvalue,*) obliqr end if call NUOPC_CompAttributeGet(gcomp, name='orb_lambm0', value=cvalue, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then read(cvalue,*) lambm0 end if call NUOPC_CompAttributeGet(gcomp, name='orb_mvelpp', value=cvalue, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then read(cvalue,*) mvelpp end if @@ -438,7 +454,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) else if (trim(starttype) == trim('branch')) then runtype = "continue" else - call shr_sys_abort( subname//' ERROR: unknown starttype' ) + call abort_ice( subname//' ERROR: unknown starttype' ) end if ! Note that in the mct version the atm was initialized first so that nextsw_cday could be passed to the other @@ -449,7 +465,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (trim(runtype) /= 'initial') then ! Set nextsw_cday to -1 (this will skip an orbital calculation on initialization - nextsw_cday = -1.0_r8 + nextsw_cday = -1.0_dbl_kind else call ESMF_ClockGet( clock, currTime=currTime, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -464,14 +480,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) runtype = 'initial' ! determined from the namelist in ice_init if CESMCOUPLED is not defined end if + single_column = .false. +#ifdef CESMCOUPLED ! Determine single column info call NUOPC_CompAttributeGet(gcomp, name='single_column', value=cvalue, isPresent=isPresent, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then read(cvalue,*) single_column - else - single_column = .false. end if +#endif if (single_column) then ! Must have these attributes present call NUOPC_CompAttributeGet(gcomp, name='scmlon', value=cvalue, rc=rc) @@ -484,14 +501,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Determine runid call NUOPC_CompAttributeGet(gcomp, name='case_name', value=cvalue, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then read(cvalue,*) runid else runid = 'unknown' ! read in from the namelist in ice_init.F90 if CESMCOUPLED is not defined end if +#ifdef CESMCOUPLED ! Determine tfreeze_option, flux convertence before call to cice_init + ! tcx, what is going on here? if not present, set it? if present, ignore it? call NUOPC_CompAttributeGet(gcomp, name="tfreeze_option", value=tfrz_option, isPresent=isPresent, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (.not. isPresent) then @@ -501,6 +519,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) +#endif #if (defined NEWCODE) call NUOPC_CompAttributeGet(gcomp, name="flux_convergence", value=cvalue, isPresent=isPresent, rc=rc) @@ -508,7 +527,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (isPresent) then read(cvalue,*) flux_convergence_tolerance else - flux_convergence_tolerance = 0._r8 + flux_convergence_tolerance = 0._dbl_kind end if call NUOPC_CompAttributeGet(gcomp, name="flux_max_iteration", value=cvalue, isPresent=isPresent, rc=rc) @@ -537,19 +556,19 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_TimeGet( currTime, yy=yy, mm=mm, dd=dd, s=curr_tod, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_cal_ymd2date(yy,mm,dd,curr_ymd) + call ice_cal_ymd2date(yy,mm,dd,curr_ymd) call ESMF_TimeGet( startTime, yy=yy, mm=mm, dd=dd, s=start_tod, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_cal_ymd2date(yy,mm,dd,start_ymd) + call ice_cal_ymd2date(yy,mm,dd,start_ymd) call ESMF_TimeGet( stopTime, yy=yy, mm=mm, dd=dd, s=stop_tod, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_cal_ymd2date(yy,mm,dd,stop_ymd) + call ice_cal_ymd2date(yy,mm,dd,stop_ymd) call ESMF_TimeGet( refTime, yy=yy, mm=mm, dd=dd, s=ref_tod, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_cal_ymd2date(yy,mm,dd,ref_ymd) + call ice_cal_ymd2date(yy,mm,dd,ref_ymd) call ESMF_TimeIntervalGet( timeStep, s=dtime, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -558,13 +577,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_TimeGet( currTime, calkindflag=esmf_caltype, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return +#ifdef CESMCOUPLED if (esmf_caltype == ESMF_CALKIND_NOLEAP) then calendar_type = shr_cal_noleap else if (esmf_caltype == ESMF_CALKIND_GREGORIAN) then calendar_type = shr_cal_gregorian else - call shr_sys_abort( subname//'ERROR:: bad calendar for ESMF' ) + call abort_ice( subname//'ERROR:: bad calendar for ESMF' ) end if +#endif !---------------------------------------------------------------------------- ! Set cice logging @@ -572,11 +593,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Note that sets the nu_diag module variable in ice_fileunits ! Set the nu_diag_set flag so it's not reset later +#ifdef CESMCOUPLED call set_component_logging(gcomp, my_task==master_task, nu_diag, shrlogunit, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return nu_diag_set = .true. +#endif +#ifdef CESMCOUPLED call shr_file_setLogUnit (shrlogunit) +#endif !---------------------------------------------------------------------------- ! Initialize cice @@ -585,9 +610,13 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Note that cice_init also sets time manager info as well as mpi communicator info, ! including master_task and my_task +#ifdef CESMCOUPLED call t_startf ('cice_init') +#endif call cice_init( lmpicom ) +#ifdef CESMCOUPLED call t_stopf ('cice_init') +#endif !---------------------------------------------------------------------------- ! reset shr logging to my log file @@ -647,7 +676,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) write(nu_diag,*) trim(subname),' ERROR curr_ymd,year_init =',curr_ymd,year_init write(nu_diag,*) trim(subname),' ERROR idate lt zero',idate end if - call shr_sys_abort(subname//' :: ERROR idate lt zero') + call abort_ice(subname//' :: ERROR idate lt zero') endif iyear = (idate/10000) ! integer year of basedate month = (idate-iyear*10000)/100 ! integer month of basedate @@ -658,12 +687,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) write(nu_diag,*) trim(subname),' cice year_init = ',year_init write(nu_diag,*) trim(subname),' cice start date = ',idate write(nu_diag,*) trim(subname),' cice start ymds = ',iyear,month,mday,start_tod + write(nu_diag,*) trim(subname),' cice calendar_type = ',trim(calendar_type) endif - if (calendar_type /= "GREGORIAN") then - call time2sec(iyear-year_init,month,mday,time) - else + if (calendar_type == "GREGORIAN" .or. & + calendar_type == "Gregorian" .or. & + calendar_type == "gregorian") then call time2sec(iyear-(year_init-1),month,mday,time) + else + call time2sec(iyear-year_init,month,mday,time) endif time = time+start_tod end if @@ -867,16 +899,16 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! error check differences between internally generated lons and those read in do n = 1,lsize diff_lon = abs(lonMesh(n) - lon(n)) - if ( (diff_lon > 1.e2 .and. abs(diff_lon - 360_r8) > 1.e-1) .or.& - (diff_lon > 1.e-3 .and. diff_lon < 1._r8) ) then + if ( (diff_lon > 1.e2 .and. abs(diff_lon - 360_dbl_kind) > 1.e-1) .or.& + (diff_lon > 1.e-3 .and. diff_lon < 1._dbl_kind) ) then !write(6,100)n,lonMesh(n),lon(n), diff_lon 100 format('ERROR: CICE n, lonmesh(n), lon(n), diff_lon = ',i6,2(f21.13,3x),d21.5) - !call shr_sys_abort() + !call abort_ice() end if if (abs(latMesh(n) - lat(n)) > 1.e-1) then !write(6,101)n,latMesh(n),lat(n), abs(latMesh(n)-lat(n)) 101 format('ERROR: CICE n, latmesh(n), lat(n), diff_lat = ',i6,2(f21.13,3x),d21.5) - !call shr_sys_abort() + !call abort_ice() end if end do @@ -952,12 +984,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) +#ifdef CESMCOUPLED call t_stopf ('cice_init_total') +#endif deallocate(gindex_ice) deallocate(gindex) - call shr_sys_flush(nu_diag) + call flush_fileunit(nu_diag) end subroutine InitializeRealize @@ -980,7 +1014,7 @@ subroutine ModelAdvance(gcomp, rc) type(ESMF_Time) :: nextTime type(ESMF_State) :: importState, exportState character(ESMF_MAXSTR) :: cvalue - real(r8) :: eccen, obliqr, lambm0, mvelpp + real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp integer :: shrlogunit ! original log unit integer :: k,n ! index logical :: stop_now ! .true. ==> stop at the end of this run phase @@ -994,8 +1028,8 @@ subroutine ModelAdvance(gcomp, rc) integer :: mon_sync ! Sync current month integer :: day_sync ! Sync current day integer :: tod_sync ! Sync current time of day (sec) - character(CL) :: restart_date - character(CL) :: restart_filename + character(char_len_long) :: restart_date + character(char_len_long) :: restart_filename logical :: isPresent character(*) , parameter :: F00 = "('(ice_comp_nuopc) ',2a,i8,d21.14)" character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' @@ -1009,15 +1043,19 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- call ice_timer_start(timer_total) ! time entire run +#ifdef CESMCOUPLED call t_barrierf('cice_run_total_BARRIER',mpi_comm_ice) call t_startf ('cice_run_total') +#endif !-------------------------------- ! Reset shr logging to my log file !-------------------------------- +#ifdef CESMCOUPLED call shr_file_getLogUnit (shrlogunit) call shr_file_setLogUnit (nu_diag) +#endif !-------------------------------- ! Query the Component for its clock, importState and exportState @@ -1045,23 +1083,30 @@ subroutine ModelAdvance(gcomp, rc) call ice_orbital_init(gcomp, clock, nu_diag, my_task==master_task, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return #else + ! Start with icepack values then update with values defined in configure file if they exist + ! tcx, This should be identical with initialization, why do it again? Get rid of it + call icepack_query_orbit(eccen_out=eccen, mvelpp_out=mvelpp, lambm0_out=lambm0, obliqr_out=obliqr) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + call NUOPC_CompAttributeGet(gcomp, name='orb_eccen', value=cvalue, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then read(cvalue,*) eccen end if call NUOPC_CompAttributeGet(gcomp, name='orb_obliqr', value=cvalue, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then read(cvalue,*) obliqr end if call NUOPC_CompAttributeGet(gcomp, name='orb_lambm0', value=cvalue, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then read(cvalue,*) lambm0 end if call NUOPC_CompAttributeGet(gcomp, name='orb_mvelpp', value=cvalue, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then read(cvalue,*) mvelpp end if @@ -1086,7 +1131,7 @@ subroutine ModelAdvance(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet( currTime, yy=yr_sync, mm=mon_sync, dd=day_sync, s=tod_sync, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_cal_ymd2date(yr_sync, mon_sync, day_sync, ymd_sync) + call ice_cal_ymd2date(yr_sync, mon_sync, day_sync, ymd_sync) ! error check if ( (ymd /= ymd_sync) .or. (tod /= tod_sync) ) then @@ -1130,15 +1175,19 @@ subroutine ModelAdvance(gcomp, rc) ! Unpack import state !-------------------------------- +#ifdef CESMCOUPLED call t_barrierf('cice_run_import_BARRIER',mpi_comm_ice) call t_startf ('cice_run_import') call ice_timer_start(timer_cplrecv) +#endif call ice_import(importState, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return +#ifdef CESMCOUPLED call ice_timer_stop(timer_cplrecv) call t_stopf ('cice_run_import') +#endif ! write Debug output if (debug_import > 0 .and. my_task==master_task) then @@ -1161,15 +1210,19 @@ subroutine ModelAdvance(gcomp, rc) ! Create export state !-------------------------------- +#ifdef CESMCOUPLED call t_barrierf('cice_run_export_BARRIER',mpi_comm_ice) call t_startf ('cice_run_export') call ice_timer_start(timer_cplsend) +#endif call ice_export(exportState, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return +#ifdef CESMCOUPLED call ice_timer_stop(timer_cplsend) call t_stopf ('cice_run_export') +#endif if (debug_export > 0 .and. my_task==master_task) then call State_fldDebug(exportState, flds_scalar_name, 'cice_export:', & @@ -1177,8 +1230,10 @@ subroutine ModelAdvance(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if +#ifdef CESMCOUPLED ! reset shr logging to my original values call shr_file_setLogUnit (shrlogunit) +#endif !-------------------------------- ! stop timers and print timer info @@ -1202,7 +1257,9 @@ subroutine ModelAdvance(gcomp, rc) stop_now = .false. endif +#ifdef CESMCOUPLED call t_stopf ('cice_run_total') +#endif ! Need to stop this at the end of every run phase in a coupled run. call ice_timer_stop(timer_total) @@ -1373,6 +1430,7 @@ end subroutine ModelFinalize !=============================================================================== +#ifdef CESMCOUPLED subroutine ice_orbital_init(gcomp, clock, logunit, mastertask, rc) !---------------------------------------------------------- @@ -1387,9 +1445,9 @@ subroutine ice_orbital_init(gcomp, clock, logunit, mastertask, rc) integer , intent(out) :: rc ! output error ! local variables - real(r8) :: eccen, obliqr, lambm0, mvelpp - character(len=CL) :: msgstr ! temporary - character(len=CL) :: cvalue ! temporary + real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp + character(len=char_len_long) :: msgstr ! temporary + character(len=char_len_long) :: cvalue ! temporary type(ESMF_Time) :: CurrTime ! current time integer :: year ! model year at current time integer :: orb_year ! orbital year for current orbital computation @@ -1508,5 +1566,31 @@ subroutine ice_orbital_init(gcomp, clock, logunit, mastertask, rc) first_time = .false. end subroutine ice_orbital_init +#endif + !=============================================================================== + + subroutine ice_cal_ymd2date(year, month, day, date) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + integer,intent(in ) :: year,month,day ! calendar year,month,day + integer,intent(out) :: date ! coded (yyyymmdd) calendar date + + !--- local --- + character(*),parameter :: subName = "(ice_cal_ymd2date)" + + !------------------------------------------------------------------------------- + ! NOTE: + ! this calendar has a year zero (but no day or month zero) + !------------------------------------------------------------------------------- + + date = abs(year)*10000 + month*100 + day ! coded calendar date + if (year < 0) date = -date + + end subroutine ice_cal_ymd2date + + !=============================================================================== end module ice_comp_nuopc diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index 5e423fbb6..b253c0123 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -3,10 +3,10 @@ module ice_import_export use ESMF use NUOPC use NUOPC_Model - use shr_sys_mod , only : shr_sys_abort, shr_sys_flush +#ifdef CESMCOUPLED use shr_frz_mod , only : shr_frz_freezetemp - use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs - use ice_kinds_mod , only : int_kind, dbl_kind, char_len_long, log_kind +#endif + use ice_kinds_mod , only : int_kind, dbl_kind, char_len, log_kind use ice_constants , only : c0, c1, spval_dbl use ice_constants , only : field_loc_center, field_type_scalar, field_type_vector use ice_blocks , only : block, get_block, nx_block, ny_block @@ -23,7 +23,7 @@ module ice_import_export use ice_flux , only : fresh, fsalt, zlvl, uatm, vatm, potT, Tair, Qa use ice_flux , only : rhoa, swvdr, swvdf, swidr, swidf, flw, frain use ice_flux , only : fsnow, uocn, vocn, sst, ss_tltx, ss_tlty, frzmlt - use ice_flux , only : sss, tf, wind, fsw + use ice_flux , only : sss, Tf, wind, fsw #if (defined NEWCODE) use ice_flux , only : faero_atm, faero_ocn use ice_flux , only : fiso_atm, fiso_ocn, fiso_rain, fiso_evap @@ -33,13 +33,16 @@ module ice_import_export use ice_grid , only : tlon, tlat, tarea, tmask, anglet, hm, ocn_gridcell_frac use ice_grid , only : grid_type, t2ugrid_vector use ice_boundary , only : ice_HaloUpdate - use ice_fileunits , only : nu_diag + use ice_fileunits , only : nu_diag, flush_fileunit use ice_communicate , only : my_task, master_task, MPI_COMM_ICE use ice_prescribed_mod , only : prescribed_ice use ice_shr_methods , only : chkerr, state_reset use icepack_intfc , only : icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc , only : icepack_query_parameters, icepack_query_tracer_flags + use icepack_intfc , only : icepack_liquidus_temperature +#ifdef CESMCOUPLED use perf_mod , only : t_startf, t_stopf, t_barrierf +#endif implicit none public @@ -107,8 +110,8 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam ! local variables integer :: n - character(CS) :: stdname - character(CS) :: cvalue + character(char_len) :: stdname + character(char_len) :: cvalue logical :: flds_wiso ! use case logical :: flds_i2o_per_cat ! .true. => select per ice thickness category character(len=*), parameter :: subname='(ice_import_export:ice_advertise_fields)' @@ -117,6 +120,9 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam rc = ESMF_SUCCESS if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + flds_wiso = .false. + flds_i2o_per_cat = .false. +#ifdef CESMCOUPLED call NUOPC_CompAttributeGet(gcomp, name='flds_wiso', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_wiso @@ -127,6 +133,7 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) send_i2x_per_cat call ESMF_LogWrite('flds_i2o_per_cat = '// trim(cvalue), ESMF_LOGMSG_INFO) +#endif #endif !----------------- @@ -154,7 +161,7 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsToIce_num, fldsToIce, 'inst_spec_humid_height_lowest' ) call fldlist_add(fldsToIce_num, fldsToIce, 'inst_temp_height_lowest' ) call fldlist_add(fldsToIce_num, fldsToIce, 'Sa_ptem' ) - call fldlist_add(fldsToIce_num, fldsToIce, 'air_density_height_lowest' ) + call fldlist_add(fldsToIce_num, fldsToIce, 'air_density_height_lowest' ) call fldlist_add(fldsToIce_num, fldsToIce, 'mean_down_sw_vis_dir_flx' ) call fldlist_add(fldsToIce_num, fldsToIce, 'mean_down_sw_ir_dir_flx' ) call fldlist_add(fldsToIce_num, fldsToIce, 'mean_down_sw_vis_dif_flx' ) @@ -163,6 +170,7 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsToIce_num, fldsToIce, 'mean_prec_rate' ) call fldlist_add(fldsToIce_num, fldsToIce, 'mean_fprec_rate' ) +#ifdef CESMCOUPLED ! from atm - black carbon deposition fluxes (3) call fldlist_add(fldsToIce_num, fldsToIce, 'Faxa_bcph', ungridded_lbound=1, ungridded_ubound=3) @@ -171,6 +179,7 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam ! from - atm dry dust deposition frluxes (4 sizes) call fldlist_add(fldsToIce_num, fldsToIce, 'Faxa_dstdry', ungridded_lbound=1, ungridded_ubound=4) +#endif do n = 1,fldsToIce_num call NUOPC_Advertise(importState, standardName=fldsToIce(n)%stdname, & @@ -231,9 +240,11 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsFrIce_num , fldsFrIce, 'mean_salt_rate' ) call fldlist_add(fldsFrIce_num , fldsFrIce, 'stress_on_ocn_ice_zonal' ) call fldlist_add(fldsFrIce_num , fldsFrIce, 'stress_on_ocn_ice_merid' ) +#ifdef CESMCOUPLED call fldlist_add(fldsFrIce_num , fldsFrIce, 'Fioi_bcpho' ) call fldlist_add(fldsFrIce_num , fldsFrIce, 'Fioi_bcphi' ) call fldlist_add(fldsFrIce_num , fldsFrIce, 'Fioi_flxdst' ) +#endif if (flds_wiso) then call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_fresh_water_to_ocean_rate_wiso', & ungridded_lbound=1, ungridded_ubound=3) @@ -388,6 +399,7 @@ subroutine ice_import( importState, rc ) call state_getimport(importState, 'inst_height_lowest', output=aflds, index=3, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return +!tcx errr.... this needs to be fixed in the dictionary!!! call state_getimport(importState, 'Sa_ptem', output=aflds, index=4, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -431,9 +443,13 @@ subroutine ice_import( importState, rc ) ! perform a halo update if (.not.prescribed_ice) then +#ifdef CESMCOUPLED call t_startf ('cice_imp_halo') +#endif call ice_HaloUpdate(aflds, halo_info, field_loc_center, field_type_scalar) +#ifdef CESMCOUPLED call t_stopf ('cice_imp_halo') +#endif endif ! now fill in the ice internal data types @@ -485,9 +501,13 @@ subroutine ice_import( importState, rc ) if (.not.prescribed_ice) then +#ifdef CESMCOUPLED call t_startf ('cice_imp_halo') +#endif call ice_HaloUpdate(aflds, halo_info, field_loc_center, field_type_vector) +#ifdef CESMCOUPLED call t_stopf ('cice_imp_halo') +#endif endif !$OMP PARALLEL DO PRIVATE(iblk,i,j) @@ -600,7 +620,9 @@ subroutine ice_import( importState, rc ) ! interpolate across the pole) ! use ANGLET which is on the T grid ! +#ifdef CESMCOUPLED call t_startf ('cice_imp_ocn') +#endif !$OMP PARALLEL DO PRIVATE(iblk,i,j,workx,worky) do iblk = 1, nblocks @@ -624,33 +646,47 @@ subroutine ice_import( importState, rc ) sst(i,j,iblk) = sst(i,j,iblk) - Tffresh ! sea sfc temp (C) sss(i,j,iblk) = max(sss(i,j,iblk),c0) +#ifndef CESMCOUPLED +!tcx should this be icepack_sea_freezing_temperature? + Tf (i,j,iblk) = icepack_liquidus_temperature(sss(i,j,iblk)) +#endif enddo enddo - ! Use shr_frz_mod for this +#ifdef CESMCOUPLED + ! Use shr_frz_mod for this, overwrite Tf computed above Tf(:,:,iblk) = shr_frz_freezetemp(sss(:,:,iblk)) +#endif enddo !$OMP END PARALLEL DO +#ifdef CESMCOUPLED call t_stopf ('cice_imp_ocn') +#endif ! Interpolate ocean dynamics variables from T-cell centers to ! U-cell centers. if (.not.prescribed_ice) then +#ifdef CESMCOUPLED call t_startf ('cice_imp_t2u') +#endif call t2ugrid_vector(uocn) call t2ugrid_vector(vocn) call t2ugrid_vector(ss_tltx) call t2ugrid_vector(ss_tlty) +#ifdef CESMCOUPLED call t_stopf ('cice_imp_t2u') +#endif end if ! Atmosphere variables are needed in T cell centers in ! subroutine stability and are interpolated to the U grid ! later as necessary. +#ifdef CESMCOUPLED call t_startf ('cice_imp_atm') +#endif !$OMP PARALLEL DO PRIVATE(iblk,i,j,workx,worky) do iblk = 1, nblocks do j = 1, ny_block @@ -671,7 +707,9 @@ subroutine ice_import( importState, rc ) enddo enddo !$OMP END PARALLEL DO +#ifdef CESMCOUPLED call t_stopf ('cice_imp_atm') +#endif end subroutine ice_import @@ -787,7 +825,7 @@ subroutine ice_export( exportState, rc ) if (tmask(i,j,iblk) .and. ailohi(i,j,iblk) < c0 ) then write(nu_diag,*) & ' (ice) send: ERROR ailohi < 0.0 ',i,j,ailohi(i,j,iblk) - call shr_sys_flush(nu_diag) + call flush_fileunit(nu_diag) endif end do end do @@ -1083,7 +1121,7 @@ subroutine fldlist_add(num, fldlist, stdname, ungridded_lbound, ungridded_ubound num = num + 1 if (num > fldsMax) then - call shr_sys_abort(trim(subname)//": ERROR num > fldsMax "//trim(stdname)) + call abort_ice(trim(subname)//": ERROR num > fldsMax "//trim(stdname)) endif fldlist(num)%stdname = trim(stdname) @@ -1270,6 +1308,9 @@ subroutine state_getimport_4d_output(state, fldname, output, index, do_sum, ungr rc = ESMF_SUCCESS + ! check that fieldname exists + if (.not. State_FldChk(state, trim(fldname))) return + if (geomtype == ESMF_GEOMTYPE_MESH) then ! get field pointer @@ -1381,6 +1422,9 @@ subroutine state_getimport_3d_output(state, fldname, output, do_sum, ungridded_i rc = ESMF_SUCCESS + ! check that fieldname exists + if (.not. State_FldChk(state, trim(fldname))) return + if (geomtype == ESMF_GEOMTYPE_MESH) then ! get field pointer @@ -1486,6 +1530,9 @@ subroutine state_setexport_4d_input(state, fldname, input, index, lmask, ifrac, rc = ESMF_SUCCESS + ! check that fieldname exists + if (.not. State_FldChk(state, trim(fldname))) return + if (geomtype == ESMF_GEOMTYPE_MESH) then ! get field pointer @@ -1600,6 +1647,9 @@ subroutine state_setexport_3d_input(state, fldname, input, lmask, ifrac, ungridd rc = ESMF_SUCCESS + ! check that fieldname exists + if (.not. State_FldChk(state, trim(fldname))) return + if (geomtype == ESMF_GEOMTYPE_MESH) then ! get field pointer diff --git a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 index 4c3876f6c..dd56ac441 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 @@ -1,6 +1,15 @@ module ice_prescribed_mod -#ifdef CESMCOUPLED +#ifndef CESMCOUPLED + + use ice_kinds_mod + + implicit none + private ! except + + logical(kind=log_kind), parameter, public :: prescribed_ice = .false. ! true if prescribed ice + +#else ! !DESCRIPTION: ! The prescribed ice model reads in ice concentration data from a netCDF diff --git a/cicecore/drivers/nuopc/cmeps/ice_shr_methods.F90 b/cicecore/drivers/nuopc/cmeps/ice_shr_methods.F90 index 24a4226e5..323cba9a4 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_shr_methods.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_shr_methods.F90 @@ -20,9 +20,11 @@ module ice_shr_methods use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast, ESMF_VMGetCurrent use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model , only : NUOPC_ModelGet - use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs - use shr_sys_mod , only : shr_sys_abort + use ice_kinds_mod, only : r8 => dbl_kind, cl=>char_len_long, cs=>char_len + use ice_exit , only : abort_ice +#ifdef CESMCOUPLED use shr_file_mod , only : shr_file_setlogunit, shr_file_getLogUnit +#endif implicit none private @@ -89,9 +91,11 @@ subroutine memcheck(string, level, mastertask) character(len=*), parameter :: subname='(memcheck)' !----------------------------------------------------------------------- +#ifdef CESMCOUPLED if ((mastertask .and. memdebug_level > level) .or. memdebug_level > level+1) then ierr = GPTLprint_memusage(string) endif +#endif end subroutine memcheck @@ -160,7 +164,9 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) logUnit = 6 endif +#ifdef CESMCOUPLED call shr_file_setLogUnit (logunit) +#endif end subroutine set_component_logging @@ -710,10 +716,10 @@ subroutine alarmInit( clock, alarm, option, & case (optDate) if (.not. present(opt_ymd)) then - call shr_sys_abort(subname//trim(option)//' requires opt_ymd') + call abort_ice(subname//trim(option)//' requires opt_ymd') end if if (lymd < 0 .or. ltod < 0) then - call shr_sys_abort(subname//trim(option)//'opt_ymd, opt_tod invalid') + call abort_ice(subname//trim(option)//'opt_ymd, opt_tod invalid') end if call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -723,13 +729,13 @@ subroutine alarmInit( clock, alarm, option, & case (optIfdays0) if (.not. present(opt_ymd)) then - call shr_sys_abort(subname//trim(option)//' requires opt_ymd') + call abort_ice(subname//trim(option)//' requires opt_ymd') end if if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -739,10 +745,10 @@ subroutine alarmInit( clock, alarm, option, & case (optNSteps) if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -750,8 +756,8 @@ subroutine alarmInit( clock, alarm, option, & update_nextalarm = .true. case (optNStep) - if (.not.present(opt_n)) call shr_sys_abort(subname//trim(option)//' requires opt_n') - if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n') + if (.not.present(opt_n)) call abort_ice(subname//trim(option)//' requires opt_n') + if (opt_n <= 0) call abort_ice(subname//trim(option)//' invalid opt_n') call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return AlarmInterval = AlarmInterval * opt_n @@ -759,10 +765,10 @@ subroutine alarmInit( clock, alarm, option, & case (optNSeconds) if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -771,10 +777,10 @@ subroutine alarmInit( clock, alarm, option, & case (optNSecond) if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -784,20 +790,20 @@ subroutine alarmInit( clock, alarm, option, & case (optNMinutes) call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. case (optNMinute) if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -806,10 +812,10 @@ subroutine alarmInit( clock, alarm, option, & case (optNHours) if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -818,10 +824,10 @@ subroutine alarmInit( clock, alarm, option, & case (optNHour) if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -830,10 +836,10 @@ subroutine alarmInit( clock, alarm, option, & case (optNDays) if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -842,10 +848,10 @@ subroutine alarmInit( clock, alarm, option, & case (optNDay) if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -854,10 +860,10 @@ subroutine alarmInit( clock, alarm, option, & case (optNMonths) if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -866,10 +872,10 @@ subroutine alarmInit( clock, alarm, option, & case (optNMonth) if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -885,10 +891,10 @@ subroutine alarmInit( clock, alarm, option, & case (optNYears) if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -897,10 +903,10 @@ subroutine alarmInit( clock, alarm, option, & case (optNYear) if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -915,7 +921,7 @@ subroutine alarmInit( clock, alarm, option, & update_nextalarm = .true. case default - call shr_sys_abort(subname//'unknown option '//trim(option)) + call abort_ice(subname//'unknown option '//trim(option)) end select @@ -964,7 +970,7 @@ subroutine timeInit( Time, ymd, cal, tod, rc) rc = ESMF_SUCCESS if ( (ymd < 0) .or. (tod < 0) .or. (tod > SecPerDay) )then - call shr_sys_abort( subname//'ERROR yymmdd is a negative number or time-of-day out of bounds' ) + call abort_ice( subname//'ERROR yymmdd is a negative number or time-of-day out of bounds' ) end if tdate = abs(date) diff --git a/configuration/scripts/Makefile b/configuration/scripts/Makefile index 88a5030d1..7b39d5c8d 100644 --- a/configuration/scripts/Makefile +++ b/configuration/scripts/Makefile @@ -16,7 +16,8 @@ # # Usage examples: # % gmake -j 8 VPFILE=Filepath EXEC=${ICE_RUNDIR}/cice \ -# -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.conrad_intel +# -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.conrad_intel \ +# DEPFILE=${ICE_CASEDIR}/makdep.c cice #------------------------------------------------------------------------------- #------------------------------------------------------------------------------- @@ -25,6 +26,7 @@ EXEC := a.out MACFILE := NONE +DEPFILE := NONE MODEL := NONE VPFILE := NONE VPATH := . @@ -33,6 +35,13 @@ SRCS := NONE # dependency generator DEPGEN := ./makdep +OBJS_DEPGEN := $(DEPFILE) + +ifneq ($(ESMFMKFILE),) + -include $(ESMFMKFILE) + INCLDIR += $(ESMF_F90COMPILEPATHS) + SLIBS += $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) $(ESMF_F90ESMFLINKLIBS) +endif ifneq ($(VPATH),.) # this variable was specified on cmd line or in an env var @@ -59,14 +68,14 @@ endif OBJS := $(addsuffix .o, $(sort $(basename $(notdir $(SRCS))))) DEPS := $(addsuffix .d, $(sort $(basename $(notdir $(SRCS))))) INCS := $(patsubst %,-I%, $(VPATH) ) -OBJS_DEPGEN := $(addprefix $(ICE_CASEDIR)/,$(addsuffix .c, $(notdir $(DEPGEN)))) MODDIR:= -I. RM := rm +AR := ar .SUFFIXES: .SUFFIXES: .F90 .F .c .o -.PHONY: all cice targets target db_files db_flags clean realclean +.PHONY: all cice libcice targets target db_files db_flags clean realclean all: $(EXEC) cice: $(EXEC) @@ -83,7 +92,7 @@ cice: $(EXEC) targets: @echo " " - @echo "Supported Makefile Targets are: cice, makdep, depends, clean, realclean, targets, db_files, db_flags" + @echo "Supported Makefile Targets are: cice, libcice, makdep, depends, clean, realclean, targets, db_files, db_flags" target: targets db_files: @@ -100,6 +109,7 @@ db_files: @echo "* ULIBS := $(ULIBS)" @echo "* SLIBS := $(SLIBS)" @echo "* INCLDIR := $(INCLDIR)" + @echo "* DEPFILE := $(DEPFILE)" @echo "* OBJS_DEPGEN := $(OBJS_DEPGEN)" db_flags: @echo " " @@ -112,6 +122,7 @@ db_flags: @echo "* .c.o := $(CC) $(CFLAGS) $(CPPDEFS) $(INCLDIR)" @echo "* .F.o := $(FC) -c $(FFLAGS) $(FIXEDFLAGS) $(CPPDEFS) $(INCLDIR)" @echo "* .F90.o := $(FC) -c $(FFLAGS) $(FREEFLAGS) $(CPPDEFS) $(MODDIR) $(INCLDIR)" + @echo "* libcice := $(AR) -r $(EXEC) " @echo "* $(notdir $(EXEC)) := $(LD) $(LDFLAGS) $(ULIBS) $(SLIBS)" #------------------------------------------------------------------------------- @@ -130,6 +141,10 @@ $(DEPGEN): $(OBJS_DEPGEN) $(EXEC): $(OBJS) $(LD) -o $(EXEC) $(LDFLAGS) $(OBJS) $(ULIBS) $(SLIBS) +libcice: $(OBJS) + @ echo "$(AR) -r $(EXEC) $(OBJS)" + $(AR) -r $(EXEC) $(OBJS) + .c.o: $(CC) $(CFLAGS) $(CPPDEFS) $(INCLDIR) $< diff --git a/configuration/scripts/cice.build b/configuration/scripts/cice.build index 2534bfa7e..eaa920ac4 100755 --- a/configuration/scripts/cice.build +++ b/configuration/scripts/cice.build @@ -147,7 +147,8 @@ endif if (${directmake} == 1) then echo "make ${target}" ${ICE_MACHINE_MAKE} -j ${ICE_MACHINE_BLDTHRDS} VPFILE=Filepath EXEC=${ICE_RUNDIR}/cice \ - -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.${ICE_MACHCOMP} ${target} + -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.${ICE_MACHCOMP} \ + DEPFILE=${ICE_CASEDIR}/makdep.c ${target} set bldstat = ${status} if (${bldstat} != 0) then echo "${0}: targeted make FAILED" @@ -172,10 +173,12 @@ if (${ICE_CLEANBUILD} == 'true') then echo "gmake clean" if (${quiet} == "true") then ${ICE_MACHINE_MAKE} VPFILE=Filepath EXEC=${ICE_RUNDIR}/cice \ - -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.${ICE_MACHCOMP} clean >& ${ICE_BLDLOG_FILE} + -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.${ICE_MACHCOMP} \ + DEPFILE=${ICE_CASEDIR}/makdep.c clean >& ${ICE_BLDLOG_FILE} else ${ICE_MACHINE_MAKE} VPFILE=Filepath EXEC=${ICE_RUNDIR}/cice \ - -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.${ICE_MACHCOMP} clean |& tee ${ICE_BLDLOG_FILE} + -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.${ICE_MACHCOMP} \ + DEPFILE=${ICE_CASEDIR}/makdep.c clean |& tee ${ICE_BLDLOG_FILE} endif endif @@ -183,11 +186,13 @@ echo "gmake cice" if (${quiet} == "true") then echo " quiet mode on... patience" ${ICE_MACHINE_MAKE} -j ${ICE_MACHINE_BLDTHRDS} VPFILE=Filepath EXEC=${ICE_RUNDIR}/cice \ - -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.${ICE_MACHCOMP} >& ${ICE_BLDLOG_FILE} + -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.${ICE_MACHCOMP} \ + DEPFILE=${ICE_CASEDIR}/makdep.c cice >& ${ICE_BLDLOG_FILE} set bldstat = ${status} else ${ICE_MACHINE_MAKE} -j ${ICE_MACHINE_BLDTHRDS} VPFILE=Filepath EXEC=${ICE_RUNDIR}/cice \ - -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.${ICE_MACHCOMP} |& tee ${ICE_BLDLOG_FILE} + -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.${ICE_MACHCOMP} \ + DEPFILE=${ICE_CASEDIR}/makdep.c cice |& tee ${ICE_BLDLOG_FILE} set bldstat = ${status} endif diff --git a/forapps/ufs/comp_ice.backend.clean b/forapps/ufs/comp_ice.backend.clean new file mode 100755 index 000000000..7eef2ed1a --- /dev/null +++ b/forapps/ufs/comp_ice.backend.clean @@ -0,0 +1,42 @@ +#! /bin/csh -f + +### Expect to find the following environment variables set on entry: +# SITE +# SYSTEM_USERDIR +# SRCDIR +# EXEDIR + +setenv OBJDIR $EXEDIR/compile ; if !(-d $OBJDIR) mkdir -p $OBJDIR + +if (${SITE} =~ cheyenne*) then + setenv ARCH cheyenne_intel +#else if (${SITE} =~ Orion*) then +# setenv ARCH orion_intel +#else if (${SITE} =~ hera*) then +# setenv ARCH hera_intel +else + echo "CICE6 ${0}: ERROR in ARCH setup, ${hname}" + exit -2 +endif + +echo "CICE6 ${0}: ARCH = $ARCH" + +cd $OBJDIR + +setenv MAKENAME gmake +setenv MAKETHRDS 1 +setenv MAKEFILE ${SRCDIR}/configuration/scripts/Makefile +setenv MACROSFILE ${SRCDIR}/configuration/scripts/machines/Macros.$ARCH + +echo "CICE6 ${0}: EXEDIR = ${EXEDIR}" +echo "CICE6 ${0}: OBJDIR = ${OBJDIR}" +echo "CICE6 ${0}: MAKEFILE = ${MAKEFILE}" +echo "CICE6 ${0}: MACROSFILE = ${MACROSFILE}" +echo "CICE6 ${0}: ESMFMKFILE = ${ESMFMKFILE}" + +#clean +${MAKENAME} EXEC=${OBJDIR}/libcice6.a \ + -f ${MAKEFILE} MACFILE=${MACROSFILE} clean + +#clean install +rm -r -f ${BINDIR} diff --git a/forapps/ufs/comp_ice.backend.libcice b/forapps/ufs/comp_ice.backend.libcice new file mode 100755 index 000000000..eb1b8a4e7 --- /dev/null +++ b/forapps/ufs/comp_ice.backend.libcice @@ -0,0 +1,142 @@ +#! /bin/csh -f + +### Expect to find the following environment variables set on entry: +# SITE +# SYSTEM_USERDIR +# SRCDIR +# EXEDIR + +### local variable that begin with ICE_ are needed in the Macros file +# ICE_COMMDIR +# ICE_BLDDEBUG +# ICE_THREADED +# ICE_CPPDEFS + +setenv OBJDIR $EXEDIR/compile ; if !(-d $OBJDIR) mkdir -p $OBJDIR + +setenv THRD no # set to yes for OpenMP threading + +if (${SITE} =~ cheyenne*) then + setenv ARCH cheyenne_intel +#else if (${SITE} =~ Orion*) then +# setenv ARCH orion_intel +#else if (${SITE} =~ hera*) then +# setenv ARCH hera_intel +else + echo "CICE6 ${0}: ERROR in ARCH setup, ${hname}" + exit -2 +endif + +echo "CICE6 ${0}: ARCH = $ARCH" + +cd $OBJDIR + +setenv SHRDIR csm_share # location of CCSM shared code +setenv DRVDIR nuopc/cmeps + +#if ($NTASK == 1) then +# setenv ICE_COMMDIR serial +#else + setenv ICE_COMMDIR mpi +#endif + +if ($THRD == 'yes') then + setenv ICE_THREADED true +else + setenv ICE_THREADED false +endif + +if ($?ICE_CPPDEFS) then + setenv ICE_CPPDEFS "${ICE_CPPDEFS} -Dcoupled" +else + setenv ICE_CPPDEFS "-Dcoupled" +endif + +if !($?IO_TYPE) then + setenv IO_TYPE netcdf4 # set to none if netcdf library is unavailable +endif +if ($IO_TYPE == 'netcdf3' || $IO_TYPE == 'netcdf4') then + setenv IODIR io_netcdf + setenv ICE_CPPDEFS "${ICE_CPPDEFS} -Dncdf" +else if ($IO_TYPE == 'pio') then + setenv IODIR io_pio + setenv ICE_CPPDEFS "${ICE_CPPDEFS} -Dncdf" +else + setenv IODIR io_binary +endif + +# Build in debug mode. If DEBUG=Y, enable DEBUG compilation. This +# flag is set in ${ROOTDIR}/coupledFV3_MOM6_CICE_debug.appBuilder file. +if (! $?DEBUG) then + setenv ICE_BLDDEBUG true +else + if ($DEBUG != "Y") then + setenv ICE_BLDDEBUG false + endif +endif +echo "CICE6 ${0}: DEBUG = ${ICE_BLDDEBUG}" + +### List of source code directories (in order of importance). +cat >! Filepath << EOF +${SRCDIR}/cicecore/drivers/${DRVDIR} +${SRCDIR}/cicecore/cicedynB/dynamics +${SRCDIR}/cicecore/cicedynB/general +${SRCDIR}/cicecore/cicedynB/analysis +${SRCDIR}/cicecore/cicedynB/infrastructure +${SRCDIR}/cicecore/cicedynB/infrastructure/io/${IODIR} +${SRCDIR}/cicecore/cicedynB/infrastructure/comm/${ICE_COMMDIR} +${SRCDIR}/cicecore/shared +${SRCDIR}/icepack/columnphysics +${SRCDIR}/$SHRDIR +EOF + +setenv MAKENAME gmake +setenv MAKETHRDS 1 +setenv MAKEFILE ${SRCDIR}/configuration/scripts/Makefile +setenv MACROSFILE ${SRCDIR}/configuration/scripts/machines/Macros.$ARCH +setenv DEPFILE ${SRCDIR}/configuration/scripts/makdep.c + +echo "CICE6 ${0}: EXEDIR = ${EXEDIR}" +echo "CICE6 ${0}: OBJDIR = ${OBJDIR}" +echo "CICE6 ${0}: MAKEFILE = ${MAKEFILE}" +echo "CICE6 ${0}: MACROSFILE = ${MACROSFILE}" +echo "CICE6 ${0}: DEPFILE = ${DEPFILE}" +echo "CICE6 ${0}: ESMFMKFILE = ${ESMFMKFILE}" + +#diagnostics +#${MAKENAME} -j ${MAKETHRDS} VPFILE=Filepath EXEC=${OBJDIR}/cice \ +# -f ${MAKEFILE} MACFILE=${MACROSFILE} DEPFILE=${DEPFILE} db_files +#${MAKENAME} -j ${MAKETHRDS} VPFILE=Filepath EXEC=${OBJDIR}/cice \ +# -f ${MAKEFILE} MACFILE=${MACROSFILE} DEPFILE=${DEPFILE} db_flags + +#clean +#${MAKENAME} VPFILE=Filepath EXEC=${OBJDIR}/cice \ +# -f ${MAKEFILE} MACFILE=${MACROSFILE} DEPFILE=${DEPFILE} clean + +#needed to trigger a failed build to rest of system +rm ${BINDIR}/cice6.mk + +#build lib (includes dependencies) +${MAKENAME} -j ${MAKETHRDS} VPFILE=Filepath EXEC=${OBJDIR}/libcice6.a \ + -f ${MAKEFILE} MACFILE=${MACROSFILE} DEPFILE=${DEPFILE} libcice + +if ($status != 0) then + echo "CICE6 ${0}: gmake failed, exiting" + exit -2 +endif + +#install +mkdir -p ${BINDIR} +cp -f ${OBJDIR}/libcice6.a ${BINDIR}/ +cp -f ${OBJDIR}/ice_comp_nuopc.mod ${BINDIR}/ + +cat >! ${BINDIR}/cice6.mk << EOF +# ESMF self-describing build dependency makefile fragment + +ESMF_DEP_FRONT = ice_comp_nuopc +ESMF_DEP_INCPATH = ${BINDIR} +ESMF_DEP_CMPL_OBJS = +ESMF_DEP_LINK_OBJS = ${BINDIR}/libcice6.a + +EOF + From 53715eaffa8b6a543dbb126fe922c5232626fbe8 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 24 May 2020 18:06:06 -0600 Subject: [PATCH 04/51] put in changes so that both ufsatm and cesm requirements for potential temperature and density are satisfied --- .../drivers/nuopc/cmeps/ice_import_export.F90 | 132 +++++++++++------- 1 file changed, 84 insertions(+), 48 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index b253c0123..083283895 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -3,9 +3,6 @@ module ice_import_export use ESMF use NUOPC use NUOPC_Model -#ifdef CESMCOUPLED - use shr_frz_mod , only : shr_frz_freezetemp -#endif use ice_kinds_mod , only : int_kind, dbl_kind, char_len, log_kind use ice_constants , only : c0, c1, spval_dbl use ice_constants , only : field_loc_center, field_type_scalar, field_type_vector @@ -19,16 +16,14 @@ module ice_import_export #if (defined NEWCODE) use ice_flux , only : fswthruvdr, fswthruvdf, fswthruidr, fswthruidf use ice_flux , only : send_i2x_per_cat, fswthrun_ai + use ice_flux , only : faero_atm, faero_ocn + use ice_flux , only : fiso_atm, fiso_ocn, fiso_rain, fiso_evap + use ice_flux , only : Qa_iso, Qref_iso, HDO_ocn, H2_18O_ocn, H2_16O_ocn #endif use ice_flux , only : fresh, fsalt, zlvl, uatm, vatm, potT, Tair, Qa use ice_flux , only : rhoa, swvdr, swvdf, swidr, swidf, flw, frain use ice_flux , only : fsnow, uocn, vocn, sst, ss_tltx, ss_tlty, frzmlt use ice_flux , only : sss, Tf, wind, fsw -#if (defined NEWCODE) - use ice_flux , only : faero_atm, faero_ocn - use ice_flux , only : fiso_atm, fiso_ocn, fiso_rain, fiso_evap - use ice_flux , only : Qa_iso, Qref_iso, HDO_ocn, H2_18O_ocn, H2_16O_ocn -#endif use ice_state , only : vice, vsno, aice, aicen_init, trcr use ice_grid , only : tlon, tlat, tarea, tmask, anglet, hm, ocn_gridcell_frac use ice_grid , only : grid_type, t2ugrid_vector @@ -41,6 +36,7 @@ module ice_import_export use icepack_intfc , only : icepack_query_parameters, icepack_query_tracer_flags use icepack_intfc , only : icepack_liquidus_temperature #ifdef CESMCOUPLED + use shr_frz_mod , only : shr_frz_freezetemp use perf_mod , only : t_startf, t_stopf, t_barrierf #endif @@ -127,7 +123,6 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_wiso call ESMF_LogWrite('flds_wiso = '// trim(cvalue), ESMF_LOGMSG_INFO) - #if (defined NEWCODE) call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -149,7 +144,7 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsToIce_num, fldsToIce, 's_surf' ) call fldlist_add(fldsToIce_num, fldsToIce, 'ocn_current_zonal' ) call fldlist_add(fldsToIce_num, fldsToIce, 'ocn_current_merid' ) - call fldlist_add(fldsToIce_num, fldsToIce, 'freezing_melting_potential' ) + call fldlist_add(fldsToIce_num, fldsToIce, 'freezing_melting_potential') if (flds_wiso) then call fldlist_add(fldsToIce_num, fldsToIce, 'So_roce_wiso', ungridded_lbound=1, ungridded_ubound=3) end if @@ -160,8 +155,7 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsToIce_num, fldsToIce, 'inst_merid_wind_height_lowest' ) call fldlist_add(fldsToIce_num, fldsToIce, 'inst_spec_humid_height_lowest' ) call fldlist_add(fldsToIce_num, fldsToIce, 'inst_temp_height_lowest' ) - call fldlist_add(fldsToIce_num, fldsToIce, 'Sa_ptem' ) - call fldlist_add(fldsToIce_num, fldsToIce, 'air_density_height_lowest' ) + call fldlist_add(fldsToIce_num, fldsToIce, 'inst_pres_height_lowest' ) call fldlist_add(fldsToIce_num, fldsToIce, 'mean_down_sw_vis_dir_flx' ) call fldlist_add(fldsToIce_num, fldsToIce, 'mean_down_sw_ir_dir_flx' ) call fldlist_add(fldsToIce_num, fldsToIce, 'mean_down_sw_vis_dif_flx' ) @@ -169,6 +163,8 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsToIce_num, fldsToIce, 'mean_down_lw_flx' ) call fldlist_add(fldsToIce_num, fldsToIce, 'mean_prec_rate' ) call fldlist_add(fldsToIce_num, fldsToIce, 'mean_fprec_rate' ) + call fldlist_add(fldsToIce_num, fldsToIce, 'Sa_ptem' ) !cesm + call fldlist_add(fldsToIce_num, fldsToIce, 'air_density_height_lowest' ) !cesm #ifdef CESMCOUPLED ! from atm - black carbon deposition fluxes (3) @@ -348,7 +344,7 @@ subroutine ice_import( importState, rc ) integer , intent(out) :: rc ! local variables - integer,parameter :: nflds=15 + integer,parameter :: nflds=16 integer,parameter :: nfldv=6 integer :: i, j, iblk, n integer :: ilo, ihi, jlo, jhi !beginning and end of physical domain @@ -357,6 +353,7 @@ subroutine ice_import( importState, rc ) real (kind=dbl_kind) :: workx, worky real (kind=dbl_kind) :: MIN_RAIN_TEMP, MAX_SNOW_TEMP real (kind=dbl_kind) :: tffresh + real (kind=dbl_kind) :: inst_pres_height_lowest character(len=*), parameter :: subname = 'ice_import' !----------------------------------------------------- @@ -394,50 +391,56 @@ subroutine ice_import( importState, rc ) call state_getimport(importState, 's_surf', output=aflds, index=2, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! import ocean states + ! import atm states call state_getimport(importState, 'inst_height_lowest', output=aflds, index=3, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return -!tcx errr.... this needs to be fixed in the dictionary!!! - call state_getimport(importState, 'Sa_ptem', output=aflds, index=4, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'inst_temp_height_lowest', output=aflds, index=5, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (State_FldChk(importState, 'Sa_ptem') .and. State_fldchk(importState, 'air_density_height_lowest')) then + call state_getimport(importState, 'Sa_ptem', output=aflds, index=4, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'air_density_height_lowest', output=aflds, index=5, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else if (State_FldChk(importState, 'inst_pres_height_lowest')) then + call state_getimport(importState, 'inst_pres_height_lowest', output=aflds, index=6, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call abort_ice(trim(subname)//& + ": ERROR either Sa_ptem and air_density_height_lowest OR inst_pres_height_lowest must be in import state") + end if - call state_getimport(importState, 'inst_spec_humid_height_lowest', output=aflds, index=6, rc=rc) + call state_getimport(importState, 'inst_temp_height_lowest', output=aflds, index=7, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'air_density_height_lowest', output=aflds, index=7, rc=rc) + call state_getimport(importState, 'inst_spec_humid_height_lowest', output=aflds, index=8, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! import ocn/ice fluxes - call state_getimport(importState, 'freezing_melting_potential', output=aflds, index=8, rc=rc) + call state_getimport(importState, 'freezing_melting_potential', output=aflds, index=9, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! import atm fluxes - call state_getimport(importState, 'mean_down_sw_vis_dir_flx', output=aflds, index=9, rc=rc) + call state_getimport(importState, 'mean_down_sw_vis_dir_flx', output=aflds, index=10, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_down_sw_ir_dir_flx', output=aflds, index=10, rc=rc) + call state_getimport(importState, 'mean_down_sw_ir_dir_flx', output=aflds, index=11, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_down_sw_vis_dif_flx', output=aflds, index=11, rc=rc) + call state_getimport(importState, 'mean_down_sw_vis_dif_flx', output=aflds, index=12, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_down_sw_ir_dif_flx', output=aflds, index=12, rc=rc) + call state_getimport(importState, 'mean_down_sw_ir_dif_flx', output=aflds, index=13, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_down_lw_flx', output=aflds, index=13, rc=rc) + call state_getimport(importState, 'mean_down_lw_flx', output=aflds, index=14, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_prec_rate', output=aflds, index=14, rc=rc) + call state_getimport(importState, 'mean_prec_rate', output=aflds, index=15, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_fprec_rate', output=aflds, index=15, rc=rc) + call state_getimport(importState, 'mean_fprec_rate', output=aflds, index=16, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! perform a halo update @@ -458,26 +461,59 @@ subroutine ice_import( importState, rc ) do iblk = 1, nblocks do j = 1,ny_block do i = 1,nx_block - sst (i,j,iblk) = aflds(i,j, 1,iblk) - sss (i,j,iblk) = aflds(i,j, 2,iblk) - zlvl (i,j,iblk) = aflds(i,j, 3,iblk) - potT (i,j,iblk) = aflds(i,j, 4,iblk) - Tair (i,j,iblk) = aflds(i,j, 5,iblk) - Qa (i,j,iblk) = aflds(i,j, 6,iblk) - rhoa (i,j,iblk) = aflds(i,j, 7,iblk) - frzmlt (i,j,iblk) = aflds(i,j, 8,iblk) - swvdr(i,j,iblk) = aflds(i,j, 9,iblk) - swidr(i,j,iblk) = aflds(i,j,10,iblk) - swvdf(i,j,iblk) = aflds(i,j,11,iblk) - swidf(i,j,iblk) = aflds(i,j,12,iblk) - flw (i,j,iblk) = aflds(i,j,13,iblk) - frain(i,j,iblk) = aflds(i,j,14,iblk) - fsnow(i,j,iblk) = aflds(i,j,15,iblk) - enddo !i - enddo !j - enddo !iblk + sst (i,j,iblk) = aflds(i,j, 1,iblk) + sss (i,j,iblk) = aflds(i,j, 2,iblk) + zlvl (i,j,iblk) = aflds(i,j, 3,iblk) + ! see below for 4,5,6 + Tair (i,j,iblk) = aflds(i,j, 7,iblk) + Qa (i,j,iblk) = aflds(i,j, 8,iblk) + frzmlt (i,j,iblk) = aflds(i,j, 9,iblk) + swvdr(i,j,iblk) = aflds(i,j,10,iblk) + swidr(i,j,iblk) = aflds(i,j,11,iblk) + swvdf(i,j,iblk) = aflds(i,j,12,iblk) + swidf(i,j,iblk) = aflds(i,j,13,iblk) + flw (i,j,iblk) = aflds(i,j,14,iblk) + frain(i,j,iblk) = aflds(i,j,15,iblk) + fsnow(i,j,iblk) = aflds(i,j,16,iblk) + end do + end do + end do !$OMP END PARALLEL DO + if ( State_fldChk(importState, 'Sa_ptem') .and. State_fldchk(importState,'air_density_height_lowest')) then + !$OMP PARALLEL DO PRIVATE(iblk,i,j) + do iblk = 1, nblocks + do j = 1,ny_block + do i = 1,nx_block + potT (i,j,iblk) = aflds(i,j, 4,iblk) + rhoa (i,j,iblk) = aflds(i,j, 5,iblk) + end do + end do + end do + !$OMP END PARALLEL DO + else if (State_fldChk(importState, 'inst_pres_height_lowest')) then + !$OMP PARALLEL DO PRIVATE(iblk,i,j) + do iblk = 1, nblocks + do j = 1,ny_block + do i = 1,nx_block + inst_pres_height_lowest = aflds(i,j,6,iblk) + if (inst_pres_height_lowest > 0.0_ESMF_KIND_R8) then + potT (i,j,iblk) = Tair(i,j,iblk) * (100000._ESMF_KIND_R8/inst_pres_height_lowest)**0.286_ESMF_KIND_R8 + else + potT (i,j,iblk) = 0.0_ESMF_KIND_R8 + end if + if (Tair(i,j,iblk) /= 0._ESMF_KIND_R8) then + rhoa(i,j,iblk) = inst_pres_height_lowest / & + (287.058_ESMF_KIND_R8*(1._ESMF_KIND_R8+0.608_ESMF_KIND_R8*Qa(i,j,iblk))*Tair(i,j,iblk)) + else + rhoa(i,j,iblk) = 0._ESMF_KIND_R8 + endif + end do !i + end do !j + end do !iblk + !$OMP END PARALLEL DO + end if + deallocate(aflds) allocate(aflds(nx_block,ny_block,nfldv,nblocks)) aflds = c0 From e70d1abcbeb4351195a2b81c6ce3f623c936426c Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Mon, 22 Jun 2020 14:58:13 -0600 Subject: [PATCH 05/51] update icepack submodule --- icepack | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/icepack b/icepack index 1ae044604..2b27a78aa 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 1ae044604498b8d268df6c577556d22d2baa7758 +Subproject commit 2b27a78aaecb3635d14b94464d918a67df750ff0 From 308a1d4f6a1d2e8d9b78f51599eef77a2662feea Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Mon, 22 Jun 2020 15:05:32 -0600 Subject: [PATCH 06/51] Revert "update icepack submodule" This reverts commit e70d1abcbeb4351195a2b81c6ce3f623c936426c. --- icepack | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/icepack b/icepack index 2b27a78aa..1ae044604 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 2b27a78aaecb3635d14b94464d918a67df750ff0 +Subproject commit 1ae044604498b8d268df6c577556d22d2baa7758 From 089f60faaa33b66fe878e932b8a20ab81b6f5beb Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 25 Jun 2020 15:18:56 +0000 Subject: [PATCH 07/51] update comp_ice.backend with temporary ice_timers fix --- forapps/ufs/comp_ice.backend.libcice | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/forapps/ufs/comp_ice.backend.libcice b/forapps/ufs/comp_ice.backend.libcice index eb1b8a4e7..ca718548a 100755 --- a/forapps/ufs/comp_ice.backend.libcice +++ b/forapps/ufs/comp_ice.backend.libcice @@ -18,10 +18,10 @@ setenv THRD no # set to yes for OpenMP threading if (${SITE} =~ cheyenne*) then setenv ARCH cheyenne_intel -#else if (${SITE} =~ Orion*) then -# setenv ARCH orion_intel -#else if (${SITE} =~ hera*) then -# setenv ARCH hera_intel +else if (${SITE} =~ Orion*) then + setenv ARCH orion_intel +else if (${SITE} =~ hera*) then + setenv ARCH hera_intel else echo "CICE6 ${0}: ERROR in ARCH setup, ${hname}" exit -2 @@ -129,6 +129,7 @@ endif mkdir -p ${BINDIR} cp -f ${OBJDIR}/libcice6.a ${BINDIR}/ cp -f ${OBJDIR}/ice_comp_nuopc.mod ${BINDIR}/ +cp -f ${OBJDIR}/ice_timers.mod ${BINDIR}/ cat >! ${BINDIR}/cice6.mk << EOF # ESMF self-describing build dependency makefile fragment From ad03424248118ad304290c30a1454ea591df4f0a Mon Sep 17 00:00:00 2001 From: David Bailey Date: Wed, 1 Jul 2020 12:52:00 -0600 Subject: [PATCH 08/51] Fix threading problem in init_bgc --- cicecore/shared/ice_init_column.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cicecore/shared/ice_init_column.F90 b/cicecore/shared/ice_init_column.F90 index b41e71aa1..1a4791291 100644 --- a/cicecore/shared/ice_init_column.F90 +++ b/cicecore/shared/ice_init_column.F90 @@ -865,7 +865,7 @@ subroutine init_bgc() endif ! .not. restart - !$OMP PARALLEL DO PRIVATE(iblk,i,j,n,ilo,ihi,jlo,jhi,this_block) + !$OMP PARALLEL DO PRIVATE(iblk,i,j,k,n,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks this_block = get_block(blocks_ice(iblk),iblk) From 73e77746d8204c181a311be8e51c6b3edec75dea Mon Sep 17 00:00:00 2001 From: David Bailey Date: Wed, 1 Jul 2020 14:41:27 -0600 Subject: [PATCH 09/51] Fix additional OMP problems --- cicecore/shared/ice_init_column.F90 | 8 ++++++-- cicecore/shared/ice_restart_column.F90 | 6 +++++- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/cicecore/shared/ice_init_column.F90 b/cicecore/shared/ice_init_column.F90 index 1a4791291..9e4838087 100644 --- a/cicecore/shared/ice_init_column.F90 +++ b/cicecore/shared/ice_init_column.F90 @@ -785,7 +785,7 @@ subroutine init_bgc() if (solve_zsal) then ! default values - !$OMP PARALLEL DO PRIVATE(iblk,i,j,n,ilo,ihi,jlo,jhi,this_block) + !$OMP PARALLEL DO PRIVATE(iblk,i,j,k,n,ilo,ihi,jlo,jhi,this_block,trcrn_bgc) do iblk = 1, nblocks this_block = get_block(blocks_ice(iblk),iblk) @@ -816,6 +816,7 @@ subroutine init_bgc() enddo ! i enddo ! j enddo ! iblk + !$OMP END PARALLEL DO call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -855,6 +856,7 @@ subroutine init_bgc() enddo ! j enddo ! iblk + !$OMP END PARALLEL DO call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -865,7 +867,7 @@ subroutine init_bgc() endif ! .not. restart - !$OMP PARALLEL DO PRIVATE(iblk,i,j,k,n,ilo,ihi,jlo,jhi,this_block) + !$OMP PARALLEL DO PRIVATE(iblk,i,j,k,n,ilo,ihi,jlo,jhi,this_block,sicen,trcrn_bgc) do iblk = 1, nblocks this_block = get_block(blocks_ice(iblk),iblk) @@ -900,6 +902,7 @@ subroutine init_bgc() enddo ! j enddo ! iblk + !$OMP END PARALLEL DO call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -925,6 +928,7 @@ subroutine init_bgc() enddo ! i enddo ! j enddo ! iblk + !$OMP END PARALLEL DO call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & diff --git a/cicecore/shared/ice_restart_column.F90 b/cicecore/shared/ice_restart_column.F90 index e830dd50b..e819b1098 100644 --- a/cicecore/shared/ice_restart_column.F90 +++ b/cicecore/shared/ice_restart_column.F90 @@ -809,6 +809,7 @@ subroutine read_restart_hbrine() enddo ! i enddo ! j enddo ! iblk + !$OMP END PARALLEL DO end subroutine read_restart_hbrine @@ -868,6 +869,7 @@ subroutine write_restart_hbrine() enddo ! i enddo ! j enddo ! iblk + !$OMP END PARALLEL DO call write_restart_field(nu_dump_hbrine,0,trcrn(:,:,nt_fbri,:,:),'ruf8', & 'fbrn',ncat,diag) @@ -997,6 +999,7 @@ subroutine write_restart_bgc() enddo enddo enddo + !$OMP END PARALLEL DO call write_restart_field(nu_dump_bgc,0,Rayleigh_real,'ruf8','Rayleigh',1,diag) @@ -1411,7 +1414,8 @@ subroutine read_restart_bgc() endif enddo enddo - enddo + enddo ! iblk + !$OMP END PARALLEL DO endif ! restart_zsal !----------------------------------------------------------------- From 46fcfbaaba0161c63c44ecf7f7449df027f97281 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 2 Jul 2020 05:24:54 -0600 Subject: [PATCH 10/51] changes for coldstart running --- .../cicedynB/analysis/ice_history_shared.F90 | 2 - .../drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 362 +++++++----------- .../drivers/nuopc/cmeps/ice_import_export.F90 | 29 +- 3 files changed, 147 insertions(+), 246 deletions(-) diff --git a/cicecore/cicedynB/analysis/ice_history_shared.F90 b/cicecore/cicedynB/analysis/ice_history_shared.F90 index b5f2226fa..ce177ad1e 100644 --- a/cicecore/cicedynB/analysis/ice_history_shared.F90 +++ b/cicecore/cicedynB/analysis/ice_history_shared.F90 @@ -672,9 +672,7 @@ subroutine construct_filename(ncfile,suffix,ns) iday = mday isec = sec - dt -#ifdef CESMCOUPLED if (write_ic) isec = sec -#endif ! construct filename if (write_ic) then write(ncfile,'(a,a,i4.4,a,i2.2,a,i2.2,a,i5.5,a,a)') & diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index e4c2a3802..fca4974b7 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -15,12 +15,6 @@ module ice_comp_nuopc use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock use NUOPC_Model , only : model_label_Finalize => label_Finalize use NUOPC_Model , only : NUOPC_ModelGet, SetVM -#ifdef CESMCOUPLED - use shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit - use shr_orb_mod , only : shr_orb_decl, shr_orb_params, SHR_ORB_UNDEF_REAL, SHR_ORB_UNDEF_INT - use shr_const_mod - use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian -#endif use ice_constants , only : ice_init_constants use ice_shr_methods , only : chkerr, state_setscalar, state_getscalar, state_diagnose, alarmInit use ice_shr_methods , only : set_component_logging, get_component_instance @@ -42,26 +36,20 @@ module ice_comp_nuopc use ice_fileunits , only : nu_diag, nu_diag_set, inst_index, inst_name, inst_suffix, release_all_fileunits, flush_fileunit use ice_restart_shared , only : runid, runtype, restart_dir, restart_file use ice_history , only : accum_hist -#if (defined NEWCODE) - use ice_history_shared , only : model_doi_url ! TODO: add this functionality -#endif -#ifdef CESMCOUPLED - use ice_prescribed_mod , only : ice_prescribed_init -#endif -#if (defined NEWCODE) - use ice_atmo , only : flux_convergence_tolerance, flux_convergence_max_iteration - use ice_atmo , only : use_coldair_outbreak_mod -#endif use CICE_InitMod , only : CICE_Init use CICE_RunMod , only : CICE_Run use ice_exit , only : abort_ice use icepack_intfc , only : icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc , only : icepack_init_orbit, icepack_init_parameters, icepack_query_orbit use icepack_intfc , only : icepack_query_tracer_flags, icepack_query_parameters + use ice_timers #ifdef CESMCOUPLED + use shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit + use shr_orb_mod , only : shr_orb_decl, shr_orb_params, SHR_ORB_UNDEF_REAL, SHR_ORB_UNDEF_INT + use shr_const_mod + use ice_prescribed_mod , only : ice_prescribed_init use perf_mod , only : t_startf, t_stopf, t_barrierf #endif - use ice_timers implicit none private @@ -75,32 +63,33 @@ module ice_comp_nuopc private :: ModelAdvance private :: ModelSetRunClock private :: ModelFinalize -#ifdef CESMCOUPLED - private :: ice_orbital_init ! only for cesm -#endif + private :: ice_orbital_init ! only valid for cesm character(len=char_len_long) :: flds_scalar_name = '' - integer :: flds_scalar_num = 0 - integer :: flds_scalar_index_nx = 0 - integer :: flds_scalar_index_ny = 0 - integer :: flds_scalar_index_nextsw_cday = 0 + integer :: flds_scalar_num = 0 + integer :: flds_scalar_index_nx = 0 + integer :: flds_scalar_index_ny = 0 + integer :: flds_scalar_index_nextsw_cday = 0 character(len=char_len_long) :: orb_mode ! attribute - orbital mode - integer :: orb_iyear ! attribute - orbital year - integer :: orb_iyear_align ! attribute - associated with model year - real(dbl_kind) :: orb_obliq ! attribute - obliquity in degrees - real(dbl_kind) :: orb_mvelp ! attribute - moving vernal equinox longitude - real(dbl_kind) :: orb_eccen ! attribute and update- orbital eccentricity + integer :: orb_iyear ! attribute - orbital year + integer :: orb_iyear_align ! attribute - associated with model year + real(dbl_kind) :: orb_obliq ! attribute - obliquity in degrees + real(dbl_kind) :: orb_mvelp ! attribute - moving vernal equinox longitude + real(dbl_kind) :: orb_eccen ! attribute and update- orbital eccentricity character(len=*) , parameter :: orb_fixed_year = 'fixed_year' character(len=*) , parameter :: orb_variable_year = 'variable_year' character(len=*) , parameter :: orb_fixed_parameters = 'fixed_parameters' - integer , parameter :: dbug = 10 - integer , parameter :: debug_import = 0 ! internal debug level - integer , parameter :: debug_export = 0 ! internal debug level - character(*), parameter :: modName = "(ice_comp_nuopc)" - character(*), parameter :: u_FILE_u = & + character(len=*),parameter :: shr_cal_noleap = 'NO_LEAP' + character(len=*),parameter :: shr_cal_gregorian = 'GREGORIAN' + + integer , parameter :: dbug = 10 + integer , parameter :: debug_import = 0 ! internal debug level + integer , parameter :: debug_export = 0 ! internal debug level + character(*), parameter :: modName = "(ice_comp_nuopc)" + character(*), parameter :: u_FILE_u = & __FILE__ !======================================================================= @@ -244,8 +233,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) write(logmsg,*) flds_scalar_index_nextsw_cday call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nextsw_cday = '//trim(logmsg), ESMF_LOGMSG_INFO) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call abort_ice(subname//'Need to set attribute ScalarFieldIdxNextSwCday') endif call ice_advertise_fields(gcomp, importState, exportState, flds_scalar_name, rc) @@ -265,6 +252,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer, intent(out) :: rc ! Local variables + real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp type(ESMF_DistGrid) :: distGrid type(ESMF_Mesh) :: Emesh, EmeshTemp integer :: spatialDim @@ -277,7 +265,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer , allocatable :: gindex(:) integer :: globalID character(ESMF_MAXSTR) :: cvalue - real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp character(len=char_len) :: tfrz_option character(ESMF_MAXSTR) :: convCIM, purpComp type(ESMF_VM) :: vm @@ -356,9 +343,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! start cice timers !---------------------------------------------------------------------------- -#ifdef CESMCOUPLED call t_startf ('cice_init_total') -#endif !---------------------------------------------------------------------------- ! Initialize constants @@ -403,44 +388,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- ! Get orbital values - ! Note that these values are obtained in a call to init_orbit in ice_shortwave.F90 - ! if CESMCOUPLED is not defined -#ifdef CESMCOUPLED call ice_orbital_init(gcomp, clock, nu_diag, my_task==master_task, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return -#else - ! Start with icepack values then update with values defined in configure file if they exist - call icepack_query_orbit(eccen_out=eccen, mvelpp_out=mvelpp, lambm0_out=lambm0, obliqr_out=obliqr) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - - call NUOPC_CompAttributeGet(gcomp, name='orb_eccen', value=cvalue, isPresent=isPresent, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - read(cvalue,*) eccen - end if - call NUOPC_CompAttributeGet(gcomp, name='orb_obliqr', value=cvalue, isPresent=isPresent, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - read(cvalue,*) obliqr - end if - call NUOPC_CompAttributeGet(gcomp, name='orb_lambm0', value=cvalue, isPresent=isPresent, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - read(cvalue,*) lambm0 - end if - call NUOPC_CompAttributeGet(gcomp, name='orb_mvelpp', value=cvalue, isPresent=isPresent, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - read(cvalue,*) mvelpp - end if - - call icepack_init_orbit(eccen_in=eccen, mvelpp_in=mvelpp, lambm0_in=lambm0, obliqr_in=obliqr) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) -#endif ! Determine runtype and possibly nextsw_cday call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, isPresent=isPresent, rc=rc) @@ -473,22 +422,17 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if else - ! This would be the NEMS branch - ! Note that in NEMS - nextsw_cday is not needed in ice_orbital.F90 and what is needed is - ! simply a CPP variable declaratino of NEMSCOUPLED - runtype = 'initial' ! determined from the namelist in ice_init if CESMCOUPLED is not defined end if single_column = .false. -#ifdef CESMCOUPLED - ! Determine single column info - call NUOPC_CompAttributeGet(gcomp, name='single_column', value=cvalue, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - read(cvalue,*) single_column - end if -#endif + ! Determine single column info - only valid for cesm + !call NUOPC_CompAttributeGet(gcomp, name='single_column', value=cvalue, isPresent=isPresent, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !if (isPresent) then + ! read(cvalue,*) single_column + !end if + if (single_column) then ! Must have these attributes present call NUOPC_CompAttributeGet(gcomp, name='scmlon', value=cvalue, rc=rc) @@ -507,46 +451,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) runid = 'unknown' ! read in from the namelist in ice_init.F90 if CESMCOUPLED is not defined end if -#ifdef CESMCOUPLED - ! Determine tfreeze_option, flux convertence before call to cice_init - ! tcx, what is going on here? if not present, set it? if present, ignore it? - call NUOPC_CompAttributeGet(gcomp, name="tfreeze_option", value=tfrz_option, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (.not. isPresent) then - tfrz_option = 'linear_salt' ! TODO: is this right? This must be the same as mom is using for the calculation. - end if - call icepack_init_parameters(tfrz_option_in=tfrz_option) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) -#endif - -#if (defined NEWCODE) - call NUOPC_CompAttributeGet(gcomp, name="flux_convergence", value=cvalue, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - read(cvalue,*) flux_convergence_tolerance - else - flux_convergence_tolerance = 0._dbl_kind - end if - - call NUOPC_CompAttributeGet(gcomp, name="flux_max_iteration", value=cvalue, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - read(cvalue,*) flux_convergence_max_iteration - else - flux_convergence_max_iteration = 5 - end if - - call NUOPC_CompAttributeGet(gcomp, name="coldair_outbreak_mod", value=cvalue, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - read(cvalue,*) use_coldair_outbreak_mod - else - use_coldair_outbreak_mod = .false. - end if -#endif - ! Get clock information before call to cice_init call ESMF_ClockGet( clock, & @@ -576,8 +480,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_TimeGet( currTime, calkindflag=esmf_caltype, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - -#ifdef CESMCOUPLED if (esmf_caltype == ESMF_CALKIND_NOLEAP) then calendar_type = shr_cal_noleap else if (esmf_caltype == ESMF_CALKIND_GREGORIAN) then @@ -585,7 +487,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) else call abort_ice( subname//'ERROR:: bad calendar for ESMF' ) end if -#endif !---------------------------------------------------------------------------- ! Set cice logging @@ -594,15 +495,16 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Set the nu_diag_set flag so it's not reset later #ifdef CESMCOUPLED - call set_component_logging(gcomp, my_task==master_task, nu_diag, shrlogunit, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (my_task == master_task) then + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + open(newunit=nu_diag, file=trim(diro)//"/"//trim(logfile)) + end if nu_diag_set = .true. #endif -#ifdef CESMCOUPLED - call shr_file_setLogUnit (shrlogunit) -#endif - !---------------------------------------------------------------------------- ! Initialize cice !---------------------------------------------------------------------------- @@ -610,13 +512,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Note that cice_init also sets time manager info as well as mpi communicator info, ! including master_task and my_task -#ifdef CESMCOUPLED call t_startf ('cice_init') -#endif call cice_init( lmpicom ) -#ifdef CESMCOUPLED call t_stopf ('cice_init') -#endif !---------------------------------------------------------------------------- ! reset shr logging to my log file @@ -637,10 +535,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) write(nu_diag,*) trim(subname),' inst_name = ',trim(inst_name) write(nu_diag,*) trim(subname),' inst_index = ',inst_index write(nu_diag,*) trim(subname),' inst_suffix = ',trim(inst_suffix) -#if (defined NEWCODE) - write(nu_diag,*) trim(subname),' flux_convergence = ', flux_convergence_tolerance - write(nu_diag,*) trim(subname),' flux_convergence_max_iteration = ', flux_convergence_max_iteration -#endif endif !--------------------------------------------------------------------------- @@ -968,25 +862,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - call ESMF_AttributeAdd(comp, convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ShortName", "CICE", convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", "CICE Model", convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "Description", "CICE5", convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "TBD", convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Sea Ice", convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "Name", "David Bailey", convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "EmailAddress", "dbailey@ucar.edu", convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", convention=convCIM, purpose=purpComp, rc=rc) -#endif - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) -#ifdef CESMCOUPLED call t_stopf ('cice_init_total') -#endif deallocate(gindex_ice) deallocate(gindex) @@ -1030,7 +908,7 @@ subroutine ModelAdvance(gcomp, rc) integer :: tod_sync ! Sync current time of day (sec) character(char_len_long) :: restart_date character(char_len_long) :: restart_filename - logical :: isPresent + logical :: isPresent, isSet character(*) , parameter :: F00 = "('(ice_comp_nuopc) ',2a,i8,d21.14)" character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' !-------------------------------- @@ -1043,19 +921,15 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- call ice_timer_start(timer_total) ! time entire run -#ifdef CESMCOUPLED call t_barrierf('cice_run_total_BARRIER',mpi_comm_ice) call t_startf ('cice_run_total') -#endif !-------------------------------- ! Reset shr logging to my log file !-------------------------------- -#ifdef CESMCOUPLED call shr_file_getLogUnit (shrlogunit) call shr_file_setLogUnit (nu_diag) -#endif !-------------------------------- ! Query the Component for its clock, importState and exportState @@ -1068,10 +942,18 @@ subroutine ModelAdvance(gcomp, rc) ! Determine time of next atmospheric shortwave calculation !-------------------------------- - call State_GetScalar(importState, flds_scalar_index_nextsw_cday, nextsw_cday, & - flds_scalar_name, flds_scalar_num, rc) + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - + if (isPresent .and. isSet) then + call State_GetScalar(importState, flds_scalar_index_nextsw_cday, nextsw_cday, & + flds_scalar_name, flds_scalar_num, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_ClockGetNextTime(clock, nextTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(nextTime, dayOfYear_r8=nextsw_cday, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if if (my_task == master_task) then write(nu_diag,F00) trim(subname),' cice istep, nextsw_cday = ',istep, nextsw_cday end if @@ -1079,44 +961,8 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- ! Obtain orbital values !-------------------------------- -#ifdef CESMCOUPLED call ice_orbital_init(gcomp, clock, nu_diag, my_task==master_task, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return -#else - ! Start with icepack values then update with values defined in configure file if they exist - ! tcx, This should be identical with initialization, why do it again? Get rid of it - call icepack_query_orbit(eccen_out=eccen, mvelpp_out=mvelpp, lambm0_out=lambm0, obliqr_out=obliqr) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - - call NUOPC_CompAttributeGet(gcomp, name='orb_eccen', value=cvalue, isPresent=isPresent, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - read(cvalue,*) eccen - end if - call NUOPC_CompAttributeGet(gcomp, name='orb_obliqr', value=cvalue, isPresent=isPresent, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - read(cvalue,*) obliqr - end if - call NUOPC_CompAttributeGet(gcomp, name='orb_lambm0', value=cvalue, isPresent=isPresent, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - read(cvalue,*) lambm0 - end if - call NUOPC_CompAttributeGet(gcomp, name='orb_mvelpp', value=cvalue, isPresent=isPresent, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - read(cvalue,*) mvelpp - end if - - call icepack_init_orbit(eccen_in=eccen, mvelpp_in=mvelpp, & - lambm0_in=lambm0, obliqr_in=obliqr) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) -#endif !-------------------------------- ! check that cice internal time is in sync with master clock before timestep update @@ -1175,19 +1021,11 @@ subroutine ModelAdvance(gcomp, rc) ! Unpack import state !-------------------------------- -#ifdef CESMCOUPLED call t_barrierf('cice_run_import_BARRIER',mpi_comm_ice) call t_startf ('cice_run_import') - call ice_timer_start(timer_cplrecv) -#endif - call ice_import(importState, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - -#ifdef CESMCOUPLED - call ice_timer_stop(timer_cplrecv) call t_stopf ('cice_run_import') -#endif ! write Debug output if (debug_import > 0 .and. my_task==master_task) then @@ -1200,29 +1038,17 @@ subroutine ModelAdvance(gcomp, rc) ! Advance cice and timestep update !-------------------------------- -!tcraig if (force_restart_now) then -! call CICE_Run(restart_filename=restart_filename) -! else - call CICE_Run() -! end if + call CICE_Run() !-------------------------------- ! Create export state !-------------------------------- -#ifdef CESMCOUPLED call t_barrierf('cice_run_export_BARRIER',mpi_comm_ice) call t_startf ('cice_run_export') - call ice_timer_start(timer_cplsend) -#endif - call ice_export(exportState, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - -#ifdef CESMCOUPLED - call ice_timer_stop(timer_cplsend) call t_stopf ('cice_run_export') -#endif if (debug_export > 0 .and. my_task==master_task) then call State_fldDebug(exportState, flds_scalar_name, 'cice_export:', & @@ -1230,10 +1056,8 @@ subroutine ModelAdvance(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if -#ifdef CESMCOUPLED ! reset shr logging to my original values call shr_file_setLogUnit (shrlogunit) -#endif !-------------------------------- ! stop timers and print timer info @@ -1257,9 +1081,7 @@ subroutine ModelAdvance(gcomp, rc) stop_now = .false. endif -#ifdef CESMCOUPLED call t_stopf ('cice_run_total') -#endif ! Need to stop this at the end of every run phase in a coupled run. call ice_timer_stop(timer_total) @@ -1333,7 +1155,7 @@ subroutine ModelSetRunClock(gcomp, rc) call ESMF_GridCompGet(gcomp, name=name, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//'setting alarms for' // trim(name), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//'setting alarms for ' // trim(name), ESMF_LOGMSG_INFO) !---------------- ! Restart alarm @@ -1564,8 +1386,64 @@ subroutine ice_orbital_init(gcomp, clock, logunit, mastertask, rc) file=__FILE__, line=__LINE__) first_time = .false. + end subroutine ice_orbital_init + +#else + + subroutine ice_orbital_init(gcomp, clock, logunit, mastertask, rc) + + ! dummy input/output arguments + type(ESMF_GridComp) :: gcomp + type(ESMF_Clock) , intent(in) :: clock + integer , intent(in) :: logunit + logical , intent(in) :: mastertask + integer , intent(out) :: rc ! output error + + ! local variables + real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp + logical :: isPresent, isSet + character(ESMF_MAXSTR) :: cvalue + logical :: first_time = .true. + character(len=*) , parameter :: subname = "(cice_orbital_init)" + !-------------------------------- + + rc = ESMF_SUCCESS + + if (first_time) then + ! Start with icepack values then update with values defined in configure file if they exist + ! tcx, This should be identical with initialization, why do it again? Get rid of it + call icepack_query_orbit(eccen_out=eccen, mvelpp_out=mvelpp, lambm0_out=lambm0, obliqr_out=obliqr) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + ! call NUOPC_CompAttributeGet(gcomp, name='orb_eccen', value=cvalue, isPresent=isPresent, rc=rc) + ! if (isPresent) then + ! read(cvalue,*) eccen + ! end if + ! call NUOPC_CompAttributeGet(gcomp, name='orb_obliqr', value=cvalue, isPresent=isPresent, rc=rc) + ! if (isPresent) then + ! read(cvalue,*) obliqr + ! end if + ! call NUOPC_CompAttributeGet(gcomp, name='orb_lambm0', value=cvalue, isPresent=isPresent, rc=rc) + ! if (isPresent) then + ! read(cvalue,*) lambm0 + ! end if + ! call NUOPC_CompAttributeGet(gcomp, name='orb_mvelpp', value=cvalue, isPresent=isPresent, rc=rc) + ! if (isPresent) then + ! read(cvalue,*) mvelpp + ! end if + + ! call icepack_init_orbit(eccen_in=eccen, mvelpp_in=mvelpp, lambm0_in=lambm0, obliqr_in=obliqr) + ! call icepack_warnings_flush(nu_diag) + ! if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + ! file=__FILE__, line=__LINE__) + + first_time = .false. + end if end subroutine ice_orbital_init + #endif !=============================================================================== @@ -1593,4 +1471,28 @@ end subroutine ice_cal_ymd2date !=============================================================================== +#ifndef CESMCOUPLED + subroutine shr_file_setLogUnit(nunit) + integer, intent(in) :: nunit + ! do nothing for this stub - its just here to replace + ! having cppdefs in the main program + end subroutine shr_file_setLogUnit + subroutine shr_file_getLogUnit(nunit) + integer, intent(in) :: nunit + ! do nothing for this stub - its just here to replace + ! having cppdefs in the main program + end subroutine shr_file_getLogUnit + + subroutine t_startf(string) + character(len=*) :: string + end subroutine t_startf + subroutine t_stopf(string) + character(len=*) :: string + end subroutine t_stopf + subroutine t_barrierf(string, comm) + character(len=*) :: string + integer:: comm + end subroutine t_barrierf +#endif + end module ice_comp_nuopc diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index 083283895..4cceaa9ca 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -190,19 +190,19 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsFrIce_num, fldsFrIce, trim(flds_scalar_name)) ! ice states - call fldlist_add(fldsFrIce_num, fldsFrIce, 'ice_mask' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'ice_fraction' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'sea_ice_temperature' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_ice_volume' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_snow_volume' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_tref' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_qref' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_snowh' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_u10' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_vis_dir_albedo' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_ir_dir_albedo' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_vis_dif_albedo' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_ir_dif_albedo' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'ice_mask' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'ice_fraction' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'sea_ice_surface_temperature' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_ice_volume' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_snow_volume' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_tref' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_qref' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_snowh' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_u10' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_vis_dir_albedo' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_ir_dir_albedo' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_vis_dif_albedo' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_ir_dif_albedo' ) #if (defined NEWCODE) if (send_i2x_per_cat) then call fldlist_add(fldsFrIce_num, fldsFrIce, 'ice_fraction_n', & @@ -908,7 +908,8 @@ subroutine ice_export( exportState, rc ) ! ---- ! surface temperature of ice covered portion (degK) - call state_setexport(exportState, 'sea_ice_temperature', input=Tsrf , lmask=tmask, ifrac=ailohi, rc=rc) + !call state_setexport(exportState, 'sea_ice_temperature', input=Tsrf , lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'sea_ice_surface_temperature', input=Tsrf , lmask=tmask, ifrac=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! albedo vis dir From c76233609c7e90d77618bf54fbf65e50604d851b Mon Sep 17 00:00:00 2001 From: David Bailey Date: Thu, 2 Jul 2020 11:36:49 -0600 Subject: [PATCH 11/51] Move the forapps directory --- .../scripts/forapps}/ufs/comp_ice.backend.clean | 0 .../scripts/forapps}/ufs/comp_ice.backend.libcice | 0 2 files changed, 0 insertions(+), 0 deletions(-) rename {forapps => configuration/scripts/forapps}/ufs/comp_ice.backend.clean (100%) rename {forapps => configuration/scripts/forapps}/ufs/comp_ice.backend.libcice (100%) diff --git a/forapps/ufs/comp_ice.backend.clean b/configuration/scripts/forapps/ufs/comp_ice.backend.clean similarity index 100% rename from forapps/ufs/comp_ice.backend.clean rename to configuration/scripts/forapps/ufs/comp_ice.backend.clean diff --git a/forapps/ufs/comp_ice.backend.libcice b/configuration/scripts/forapps/ufs/comp_ice.backend.libcice similarity index 100% rename from forapps/ufs/comp_ice.backend.libcice rename to configuration/scripts/forapps/ufs/comp_ice.backend.libcice From 6bccf71a499b0fa558e75d44c79159ac988f6b3c Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 2 Jul 2020 13:19:25 -0600 Subject: [PATCH 12/51] remove cesmcoupled ifdefs --- .../infrastructure/ice_read_write.F90 | 30 ++++++++++++------- .../infrastructure/ice_restart_driver.F90 | 8 ----- .../io/io_netcdf/ice_restart.F90 | 3 -- 3 files changed, 19 insertions(+), 22 deletions(-) diff --git a/cicecore/cicedynB/infrastructure/ice_read_write.F90 b/cicecore/cicedynB/infrastructure/ice_read_write.F90 index f497db49b..4fa115ee3 100644 --- a/cicecore/cicedynB/infrastructure/ice_read_write.F90 +++ b/cicecore/cicedynB/infrastructure/ice_read_write.F90 @@ -1106,6 +1106,7 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & integer (kind=int_kind) :: & varid , & ! variable id status ! status output from netcdf routines +! status , & ! status output from netcdf routines ! ndim, nvar, & ! sizes of netcdf file ! id, & ! dimension index ! dimlen ! dimension size @@ -1113,7 +1114,7 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & real (kind=dbl_kind) :: & amin, amax, asum ! min, max values and sum of input array -! character (char_len) :: & +! character (char_len) :: & ! dimname ! dimension name real (kind=dbl_kind), dimension(:,:), allocatable :: & @@ -1279,6 +1280,7 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & n, & ! ncat index varid , & ! variable id status ! status output from netcdf routines +! status , & ! status output from netcdf routines ! ndim, nvar, & ! sizes of netcdf file ! id, & ! dimension index ! dimlen ! size of dimension @@ -1286,7 +1288,7 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & real (kind=dbl_kind) :: & amin, amax, asum ! min, max values and sum of input array -! character (char_len) :: & +! character (char_len) :: & ! dimname ! dimension name real (kind=dbl_kind), dimension(:,:,:), allocatable :: & @@ -1364,7 +1366,7 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & if (my_task==master_task .and. diag) then ! write(nu_diag,*) & -! 'ice_read_nc_xyz, fid= ',fid, ', nrec = ',nrec, & +! 'ice_read_nc_xyz, fid= ',fid, ', nrec = ',nrec, & ! ', varname = ',trim(varname) ! status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar) ! write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar @@ -1835,6 +1837,7 @@ subroutine ice_write_nc_xy(fid, nrec, varid, work, diag, & ! netCDF file diagnostics: integer (kind=int_kind) :: & status ! status output from netcdf routines +! status, & ! status output from netcdf routines ! ndim, nvar, & ! sizes of netcdf file ! id, & ! dimension index ! dimlen ! size of dimension @@ -1844,7 +1847,8 @@ subroutine ice_write_nc_xy(fid, nrec, varid, work, diag, & character (char_len) :: & lvarname ! variable name -! dimname ! dimension name +! lvarname, & ! variable name +! dimname ! dimension name real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g1 @@ -1955,16 +1959,18 @@ subroutine ice_write_nc_xyz(fid, nrec, varid, work, diag, & integer (kind=int_kind) :: & n, & ! ncat index status ! status output from netcdf routines -! ndim, nvar, & ! sizes of netcdf file -! id, & ! dimension index -! dimlen ! size of dimension +! status, & ! status output from netcdf routines +! ndim, nvar, & ! sizes of netcdf file +! id, & ! dimension index +! dimlen ! size of dimension real (kind=dbl_kind) :: & amin, amax, asum ! min, max values and sum of input array character (char_len) :: & lvarname ! variable name -! dimname ! dimension name +! lvarname, & ! variable name +! dimname ! dimension name real (kind=dbl_kind), dimension(:,:,:), allocatable :: & work_g1 @@ -2081,6 +2087,7 @@ subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) integer (kind=int_kind) :: & varid, & ! netcdf id for field status ! status output from netcdf routines +! status, & ! status output from netcdf routines ! ndim, nvar, & ! sizes of netcdf file ! id, & ! dimension index ! dimlen ! size of dimension @@ -2088,9 +2095,9 @@ subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) real (kind=dbl_kind) :: & amin, amax, asum ! min, max values and sum of input array -! character (char_len) :: & +! character (char_len) :: & ! dimname ! dimension name -! + #ifdef ORCA_GRID real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g3 @@ -2232,6 +2239,7 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & integer (kind=int_kind) :: & varid , & ! variable id status ! status output from netcdf routines +! status, & ! status output from netcdf routines ! ndim, nvar, & ! sizes of netcdf file ! id, & ! dimension index ! dimlen ! size of dimension @@ -2239,7 +2247,7 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & real (kind=dbl_kind) :: & amin, amax, asum ! min, max values and sum of input array -! character (char_len) :: & +! character (char_len) :: & ! dimname ! dimension name real (kind=dbl_kind), dimension(:,:), allocatable :: & diff --git a/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 b/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 index d3829b9c4..25bb6f5f8 100644 --- a/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 +++ b/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 @@ -58,9 +58,7 @@ subroutine dumpfile(filename_spec) stressp_1, stressp_2, stressp_3, stressp_4, & stressm_1, stressm_2, stressm_3, stressm_4, & stress12_1, stress12_2, stress12_3, stress12_4 -#ifdef CESMCOUPLED use ice_flux, only: coszen -#endif use ice_state, only: aicen, vicen, vsnon, trcrn, uvel, vvel character(len=char_len_long), intent(in), optional :: filename_spec @@ -132,9 +130,7 @@ subroutine dumpfile(filename_spec) !----------------------------------------------------------------- ! radiation fields !----------------------------------------------------------------- -#ifdef CESMCOUPLED call write_restart_field(nu_dump,0,coszen,'ruf8','coszen',1,diag) -#endif call write_restart_field(nu_dump,0,scale_factor,'ruf8','scale_factor',1,diag) call write_restart_field(nu_dump,0,swvdr,'ruf8','swvdr',1,diag) @@ -209,9 +205,7 @@ subroutine restartfile (ice_ic) stressp_1, stressp_2, stressp_3, stressp_4, & stressm_1, stressm_2, stressm_3, stressm_4, & stress12_1, stress12_2, stress12_3, stress12_4 -#ifdef CESMCOUPLED use ice_flux, only: coszen -#endif use ice_grid, only: tmask, grid_type use ice_state, only: trcr_depend, aice, vice, vsno, trcr, & aice0, aicen, vicen, vsnon, trcrn, aice_init, uvel, vvel, & @@ -310,11 +304,9 @@ subroutine restartfile (ice_ic) if (my_task == master_task) & write(nu_diag,*) 'radiation fields' -#ifdef CESMCOUPLED call read_restart_field(nu_restart,0,coszen,'ruf8', & ! 'coszen',1,diag, field_loc_center, field_type_scalar) 'coszen',1,diag) -#endif call read_restart_field(nu_restart,0,scale_factor,'ruf8', & 'scale_factor',1,diag, field_loc_center, field_type_scalar) call read_restart_field(nu_restart,0,swvdr,'ruf8', & diff --git a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 index d4decf6f7..214fc356b 100644 --- a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 @@ -84,7 +84,6 @@ subroutine init_restart_read(ice_ic) endif endif ! use namelist values if use_restart_time = F - write(nu_diag,*) 'Restart read at istep=',istep0,time,time_forc endif call broadcast_scalar(istep0,master_task) @@ -228,9 +227,7 @@ subroutine init_restart_write(filename_spec) call define_rest_field(ncid,'uvel',dims) call define_rest_field(ncid,'vvel',dims) -#ifdef CESMCOUPLED call define_rest_field(ncid,'coszen',dims) -#endif call define_rest_field(ncid,'scale_factor',dims) call define_rest_field(ncid,'swvdr',dims) call define_rest_field(ncid,'swvdf',dims) From 902e8833b3c8c40f0d12fd81b38eb792ca739f0e Mon Sep 17 00:00:00 2001 From: David Bailey Date: Thu, 2 Jul 2020 15:27:55 -0600 Subject: [PATCH 13/51] Fix logging issues for NUOPC --- cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 | 8 ++------ cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 16 +++++++++++----- 2 files changed, 13 insertions(+), 11 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 index 16e4216e6..3dcd8fb2f 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 @@ -57,7 +57,7 @@ end subroutine CICE_Initialize ! ! Initialize CICE model. - subroutine cice_init(mpicom_ice) + subroutine cice_init use ice_arrays_column, only: hin_max, c_hi_range, alloc_arrays_column use ice_arrays_column, only: floe_rad_l, floe_rad_c, & @@ -66,7 +66,7 @@ subroutine cice_init(mpicom_ice) use ice_flux_bgc, only: alloc_flux_bgc use ice_calendar, only: dt, dt_dyn, time, istep, istep1, write_ic, & init_calendar, calendar - use ice_communicate, only: init_communicate, my_task, master_task + use ice_communicate, only: my_task, master_task use ice_diagnostics, only: init_diags use ice_domain, only: init_domain_blocks use ice_domain_size, only: ncat, nfsd @@ -91,14 +91,10 @@ subroutine cice_init(mpicom_ice) use drv_forcing, only: sst_sss #endif - integer (kind=int_kind), optional, intent(in) :: & - mpicom_ice ! communicator for sequential ccsm - logical(kind=log_kind) :: tr_aero, tr_zaero, skl_bgc, z_tracers, & tr_iso, tr_fsd, wave_spec character(len=*), parameter :: subname = '(cice_init)' - call init_communicate(mpicom_ice) ! initial setup for message passing call init_fileunits ! unit numbers call icepack_configure() ! initialize icepack diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index e4c2a3802..81fb1a308 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -62,6 +62,7 @@ module ice_comp_nuopc use perf_mod , only : t_startf, t_stopf, t_barrierf #endif use ice_timers + use ice_communicate, only: init_communicate implicit none private @@ -328,6 +329,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer(int_kind) :: ktherm character(*), parameter :: F00 = "('(ice_comp_nuopc) ',2a,1x,d21.14)" character(len=*), parameter :: subname=trim(modName)//':(InitializeRealize) ' + logical :: mastertask !-------------------------------- rc = ESMF_SUCCESS @@ -406,7 +408,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Note that these values are obtained in a call to init_orbit in ice_shortwave.F90 ! if CESMCOUPLED is not defined #ifdef CESMCOUPLED - call ice_orbital_init(gcomp, clock, nu_diag, my_task==master_task, rc) + mastertask = .false. + if (my_task == master_task) mastertask = .true. + call ice_orbital_init(gcomp, clock, nu_diag, mastertask, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return #else ! Start with icepack values then update with values defined in configure file if they exist @@ -593,11 +597,13 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Note that sets the nu_diag module variable in ice_fileunits ! Set the nu_diag_set flag so it's not reset later -#ifdef CESMCOUPLED - call set_component_logging(gcomp, my_task==master_task, nu_diag, shrlogunit, rc) + call init_communicate(lmpicom) ! initial setup for message passing + + mastertask = .false. + if (my_task == master_task) mastertask = .true. + call set_component_logging(gcomp, mastertask, nu_diag, shrlogunit, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return nu_diag_set = .true. -#endif #ifdef CESMCOUPLED call shr_file_setLogUnit (shrlogunit) @@ -613,7 +619,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) #ifdef CESMCOUPLED call t_startf ('cice_init') #endif - call cice_init( lmpicom ) + call cice_init #ifdef CESMCOUPLED call t_stopf ('cice_init') #endif From b4afd2e55df3a66db133775f6ceb7bd412317fab Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 4 Jul 2020 11:59:19 -0600 Subject: [PATCH 14/51] removal of many cpp-ifdefs --- cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 | 84 ++--- cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 | 50 +-- .../drivers/nuopc/cmeps/cice_wrapper_mod.F90 | 36 +++ .../drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 287 ++++++++---------- .../drivers/nuopc/cmeps/ice_import_export.F90 | 97 +++--- .../nuopc/cmeps/ice_prescribed_mod.F90 | 11 + 6 files changed, 249 insertions(+), 316 deletions(-) create mode 100644 cicecore/drivers/nuopc/cmeps/cice_wrapper_mod.F90 diff --git a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 index 16e4216e6..2ae6f87fe 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 @@ -25,40 +25,21 @@ module CICE_InitMod implicit none private - public :: CICE_Initialize, cice_init + public :: cice_init !======================================================================= contains -!======================================================================= - -! Initialize the basic state, grid and all necessary parameters for -! running the CICE model. Return the initial state in routine -! export state. -! Note: This initialization driver is designed for standalone and -! CESM-coupled applications. For other -! applications (e.g., standalone CAM), this driver would be -! replaced by a different driver that calls subroutine cice_init, -! where most of the work is done. - - subroutine CICE_Initialize - - character(len=*), parameter :: subname='(CICE_Initialize)' - !-------------------------------------------------------------------- - ! model initialization - !-------------------------------------------------------------------- - - call cice_init - - end subroutine CICE_Initialize - !======================================================================= ! ! Initialize CICE model. subroutine cice_init(mpicom_ice) + ! Initialize the basic state, grid and all necessary parameters for + ! running the CICE model. + use ice_arrays_column, only: hin_max, c_hi_range, alloc_arrays_column use ice_arrays_column, only: floe_rad_l, floe_rad_c, & floe_binwidth, c_fsd_range @@ -66,7 +47,7 @@ subroutine cice_init(mpicom_ice) use ice_flux_bgc, only: alloc_flux_bgc use ice_calendar, only: dt, dt_dyn, time, istep, istep1, write_ic, & init_calendar, calendar - use ice_communicate, only: init_communicate, my_task, master_task + use ice_communicate, only: my_task, master_task use ice_diagnostics, only: init_diags use ice_domain, only: init_domain_blocks use ice_domain_size, only: ncat, nfsd @@ -74,8 +55,7 @@ subroutine cice_init(mpicom_ice) use ice_dyn_shared, only: kdyn, init_evp, alloc_dyn_shared use ice_flux, only: init_coupler_flux, init_history_therm, & init_history_dyn, init_flux_atm, init_flux_ocn, alloc_flux - use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, & - get_forcing_atmo, get_forcing_ocn, get_wave_spec + use ice_forcing, only: init_forcing_ocn use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & faero_default, faero_optics, alloc_forcing_bgc, fiso_default use ice_grid, only: init_grid1, init_grid2, alloc_grid @@ -87,9 +67,6 @@ subroutine cice_init(mpicom_ice) use ice_restoring, only: ice_HaloRestore_init use ice_timers, only: timer_total, init_ice_timers, ice_timer_start use ice_transport_driver, only: init_transport -#ifdef popcice - use drv_forcing, only: sst_sss -#endif integer (kind=int_kind), optional, intent(in) :: & mpicom_ice ! communicator for sequential ccsm @@ -98,7 +75,6 @@ subroutine cice_init(mpicom_ice) tr_iso, tr_fsd, wave_spec character(len=*), parameter :: subname = '(cice_init)' - call init_communicate(mpicom_ice) ! initial setup for message passing call init_fileunits ! unit numbers call icepack_configure() ! initialize icepack @@ -133,10 +109,6 @@ subroutine cice_init(mpicom_ice) endif call init_coupler_flux ! initialize fluxes exchanged with coupler - -#ifdef popcice - call sst_sss ! POP data for CICE initialization -#endif call init_thermo_vertical ! initialize vertical thermodynamics call icepack_init_itd(ncat=ncat, hin_max=hin_max) ! ice thickness distribution @@ -162,7 +134,9 @@ subroutine cice_init(mpicom_ice) call calendar(time) ! determine the initial date + ! TODO: - why is this being called when you are using CMEPS? call init_forcing_ocn(dt) ! initialize sss and sst from data + call init_state ! initialize the ice state call init_transport ! initialize horizontal transport call ice_HaloRestore_init ! restored boundary conditions @@ -186,51 +160,31 @@ subroutine cice_init(mpicom_ice) if (icepack_warnings_aborted()) call abort_ice(trim(subname), & file=__FILE__,line= __LINE__) - if (tr_aero .or. tr_zaero) call faero_optics !initialize aerosol optical - !property tables + if (tr_aero .or. tr_zaero) then + call faero_optics !initialize aerosol optical property tables + end if ! Initialize shortwave components using swdn from previous timestep ! if restarting. These components will be scaled to current forcing ! in prep_radiation. - if (trim(runtype) == 'continue' .or. restart) & - call init_shortwave ! initialize radiative transfer - -! istep = istep + 1 ! update time step counters -! istep1 = istep1 + 1 -! time = time + dt ! determine the time and date -! call calendar(time) ! at the end of the first timestep - !-------------------------------------------------------------------- - ! coupler communication or forcing data initialization - !-------------------------------------------------------------------- - -#ifndef coupled - call init_forcing_atmo ! initialize atmospheric forcing (standalone) + if (trim(runtype) == 'continue' .or. restart) then + call init_shortwave ! initialize radiative transfer + end if -#ifndef CESMCOUPLED - if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice - call get_forcing_atmo ! atmospheric forcing from data - call get_forcing_ocn(dt) ! ocean forcing from data + !-------------------------------------------------------------------- + ! coupler communication or forcing data initialization + !-------------------------------------------------------------------- - ! isotopes - if (tr_iso) call fiso_default ! default values - ! aerosols - ! if (tr_aero) call faero_data ! data file - ! if (tr_zaero) call fzaero_data ! data file (gx1) - if (tr_aero .or. tr_zaero) call faero_default ! default values - if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry -#endif -#endif if (z_tracers) call get_atm_bgc ! biogeochemistry - if (runtype == 'initial' .and. .not. restart) & + if (runtype == 'initial' .and. .not. restart) then call init_shortwave ! initialize radiative transfer using current swdn + end if call init_flux_atm ! initialize atmosphere fluxes sent to coupler call init_flux_ocn ! initialize ocean fluxes sent to coupler -! if (write_ic) call accum_hist(dt) ! write initial conditions - end subroutine cice_init !======================================================================= diff --git a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 index aed00a9a0..486c36dcc 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 @@ -15,9 +15,7 @@ module CICE_RunMod use ice_kinds_mod -#ifdef CESMCOUPLED - use perf_mod, only : t_startf, t_stopf, t_barrierf -#endif + use cice_wrapper_mod, only : t_startf, t_stopf, t_barrierf use ice_fileunits, only: nu_diag use ice_arrays_column, only: oceanmixed_ice use ice_constants, only: c0, c1 @@ -79,48 +77,22 @@ subroutine CICE_Run ! timestep loop !-------------------------------------------------------------------- -! timeLoop: do - -! call ice_step - - istep = istep + 1 ! update time step counters - istep1 = istep1 + 1 - time = time + dt ! determine the time and date - -! call calendar(time) ! at the end of the timestep + istep = istep + 1 ! update time step counters + istep1 = istep1 + 1 + time = time + dt ! determine the time and date - call ice_timer_start(timer_couple) ! atm/ocn coupling - -#ifndef coupled -#ifndef CESMCOUPLED -! for now, wave_spectrum is constant in time -! if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice - call get_forcing_atmo ! atmospheric forcing from data - call get_forcing_ocn(dt) ! ocean forcing from data - - ! isotopes - if (tr_iso) call fiso_default ! default values - ! aerosols - ! if (tr_aero) call faero_data ! data file - ! if (tr_zaero) call fzaero_data ! data file (gx1) - if (tr_aero .or. tr_zaero) call faero_default ! default values - - if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry -#endif -#endif - if (z_tracers) call get_atm_bgc ! biogeochemistry + call ice_timer_start(timer_couple) ! atm/ocn coupling - call init_flux_atm ! Initialize atmosphere fluxes sent to coupler - call init_flux_ocn ! initialize ocean fluxes sent to coupler + if (z_tracers) call get_atm_bgc ! biogeochemistry - call calendar(time) ! at the end of the timestep + call init_flux_atm ! Initialize atmosphere fluxes sent to coupler + call init_flux_ocn ! initialize ocean fluxes sent to coupler - call ice_timer_stop(timer_couple) ! atm/ocn coupling + call calendar(time) ! at the end of the timestep - call ice_step + call ice_timer_stop(timer_couple) ! atm/ocn coupling -! if (stop_now >= 1) exit timeLoop -! enddo timeLoop + call ice_step !-------------------------------------------------------------------- ! end of timestep loop diff --git a/cicecore/drivers/nuopc/cmeps/cice_wrapper_mod.F90 b/cicecore/drivers/nuopc/cmeps/cice_wrapper_mod.F90 new file mode 100644 index 000000000..e350e9a52 --- /dev/null +++ b/cicecore/drivers/nuopc/cmeps/cice_wrapper_mod.F90 @@ -0,0 +1,36 @@ +module cice_wrapper_mod + +#ifdef CESMCOUPLED + use perf_mod, only : t_startf, t_stopf, t_barrierf +#endif + + +contains + +#ifndef CESMCOUPLED + ! These are just stub routines put in place to remove + + subroutine shr_file_setLogUnit(nunit) + integer, intent(in) :: nunit + ! do nothing for this stub - its just here to replace + ! having cppdefs in the main program + end subroutine shr_file_setLogUnit + subroutine shr_file_getLogUnit(nunit) + integer, intent(in) :: nunit + ! do nothing for this stub - its just here to replace + ! having cppdefs in the main program + end subroutine shr_file_getLogUnit + + subroutine t_startf(string) + character(len=*) :: string + end subroutine t_startf + subroutine t_stopf(string) + character(len=*) :: string + end subroutine t_stopf + subroutine t_barrierf(string, comm) + character(len=*) :: string + integer:: comm + end subroutine t_barrierf +#endif + +end module cice_wrapper_mod diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index fca4974b7..c3947cb98 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -27,7 +27,7 @@ module ice_comp_nuopc use ice_blocks , only : nblocks_tot, get_block_parameter use ice_distribution , only : ice_distributiongetblockloc use ice_grid , only : tlon, tlat, hm, tarea, ULON, ULAT - use ice_communicate , only : my_task, master_task, mpi_comm_ice + use ice_communicate , only : init_communicate, my_task, master_task, mpi_comm_ice use ice_calendar , only : force_restart_now, write_ic use ice_calendar , only : idate, mday, time, month, daycal, time2sec, year_init use ice_calendar , only : sec, dt, calendar, calendar_type, nextsw_cday, istep @@ -36,19 +36,19 @@ module ice_comp_nuopc use ice_fileunits , only : nu_diag, nu_diag_set, inst_index, inst_name, inst_suffix, release_all_fileunits, flush_fileunit use ice_restart_shared , only : runid, runtype, restart_dir, restart_file use ice_history , only : accum_hist - use CICE_InitMod , only : CICE_Init - use CICE_RunMod , only : CICE_Run + use CICE_InitMod , only : cice_init + use CICE_RunMod , only : cice_run use ice_exit , only : abort_ice use icepack_intfc , only : icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc , only : icepack_init_orbit, icepack_init_parameters, icepack_query_orbit use icepack_intfc , only : icepack_query_tracer_flags, icepack_query_parameters use ice_timers + use cice_wrapper_mod , only : t_startf, t_stopf, t_barrierf + use cice_wrapper_mod , only : shr_file_getlogunit, shr_file_setlogunit #ifdef CESMCOUPLED - use shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit - use shr_orb_mod , only : shr_orb_decl, shr_orb_params, SHR_ORB_UNDEF_REAL, SHR_ORB_UNDEF_INT use shr_const_mod + use shr_orb_mod , only : shr_orb_decl, shr_orb_params, SHR_ORB_UNDEF_REAL, SHR_ORB_UNDEF_INT use ice_prescribed_mod , only : ice_prescribed_init - use perf_mod , only : t_startf, t_stopf, t_barrierf #endif implicit none @@ -179,7 +179,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Local variables character(len=char_len_long) :: cvalue character(len=char_len_long) :: logmsg - logical :: isPresent, isSet + logical :: isPresent, isSet character(len=*), parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !-------------------------------- @@ -252,69 +252,69 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer, intent(out) :: rc ! Local variables - real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp - type(ESMF_DistGrid) :: distGrid - type(ESMF_Mesh) :: Emesh, EmeshTemp - integer :: spatialDim - integer :: numOwnedElements - real(dbl_kind), pointer :: ownedElemCoords(:) - real(dbl_kind), pointer :: lat(:), latMesh(:) - real(dbl_kind), pointer :: lon(:), lonMesh(:) - integer , allocatable :: gindex_ice(:) - integer , allocatable :: gindex_elim(:) - integer , allocatable :: gindex(:) - integer :: globalID - character(ESMF_MAXSTR) :: cvalue - character(len=char_len) :: tfrz_option - character(ESMF_MAXSTR) :: convCIM, purpComp - type(ESMF_VM) :: vm - type(ESMF_Time) :: currTime ! Current time - type(ESMF_Time) :: startTime ! Start time - type(ESMF_Time) :: stopTime ! Stop time - type(ESMF_Time) :: refTime ! Ref time - type(ESMF_TimeInterval) :: timeStep ! Model timestep - type(ESMF_Calendar) :: esmf_calendar ! esmf calendar - type(ESMF_CalKind_Flag) :: esmf_caltype ! esmf calendar type - integer :: start_ymd ! Start date (YYYYMMDD) - integer :: start_tod ! start time of day (s) - integer :: curr_ymd ! Current date (YYYYMMDD) - integer :: curr_tod ! Current time of day (s) - integer :: stop_ymd ! stop date (YYYYMMDD) - integer :: stop_tod ! stop time of day (sec) - integer :: ref_ymd ! Reference date (YYYYMMDD) - integer :: ref_tod ! reference time of day (s) - integer :: yy,mm,dd ! Temporaries for time query - integer :: iyear ! yyyy - integer :: dtime ! time step - integer :: lmpicom - integer :: shrlogunit ! original log unit - character(len=char_len) :: starttype ! infodata start type - integer :: lsize ! local size of coupling array - character(len=512) :: diro - character(len=512) :: logfile - logical :: isPresent - integer :: localPet - integer :: n,c,g,i,j,m ! indices - integer :: iblk, jblk ! indices - integer :: ig, jg ! indices - integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain - type(block) :: this_block ! block information for current block - integer :: compid ! component id + real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp + type(ESMF_DistGrid) :: distGrid + type(ESMF_Mesh) :: Emesh, EmeshTemp + integer :: spatialDim + integer :: numOwnedElements + real(dbl_kind), pointer :: ownedElemCoords(:) + real(dbl_kind), pointer :: lat(:), latMesh(:) + real(dbl_kind), pointer :: lon(:), lonMesh(:) + integer , allocatable :: gindex_ice(:) + integer , allocatable :: gindex_elim(:) + integer , allocatable :: gindex(:) + integer :: globalID + character(ESMF_MAXSTR) :: cvalue + character(len=char_len) :: tfrz_option + character(ESMF_MAXSTR) :: convCIM, purpComp + type(ESMF_VM) :: vm + type(ESMF_Time) :: currTime ! Current time + type(ESMF_Time) :: startTime ! Start time + type(ESMF_Time) :: stopTime ! Stop time + type(ESMF_Time) :: refTime ! Ref time + type(ESMF_TimeInterval) :: timeStep ! Model timestep + type(ESMF_Calendar) :: esmf_calendar ! esmf calendar + type(ESMF_CalKind_Flag) :: esmf_caltype ! esmf calendar type + integer :: start_ymd ! Start date (YYYYMMDD) + integer :: start_tod ! start time of day (s) + integer :: curr_ymd ! Current date (YYYYMMDD) + integer :: curr_tod ! Current time of day (s) + integer :: stop_ymd ! stop date (YYYYMMDD) + integer :: stop_tod ! stop time of day (sec) + integer :: ref_ymd ! Reference date (YYYYMMDD) + integer :: ref_tod ! reference time of day (s) + integer :: yy,mm,dd ! Temporaries for time query + integer :: iyear ! yyyy + integer :: dtime ! time step + integer :: lmpicom + integer :: shrlogunit ! original log unit + character(len=char_len) :: starttype ! infodata start type + integer :: lsize ! local size of coupling array + logical :: isPresent + logical :: isSet + integer :: localPet + integer :: n,c,g,i,j,m ! indices + integer :: iblk, jblk ! indices + integer :: ig, jg ! indices + integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain + type(block) :: this_block ! block information for current block + integer :: compid ! component id character(len=char_len_long) :: tempc1,tempc2 - real(dbl_kind) :: diff_lon - integer :: npes - integer :: num_elim_global - integer :: num_elim_local - integer :: num_elim - integer :: num_ice - integer :: num_elim_gcells ! local number of eliminated gridcells - integer :: num_elim_blocks ! local number of eliminated blocks - integer :: num_total_blocks - integer :: my_elim_start, my_elim_end - real(dbl_kind) :: rad_to_deg - integer(int_kind) :: ktherm - character(*), parameter :: F00 = "('(ice_comp_nuopc) ',2a,1x,d21.14)" - character(len=*), parameter :: subname=trim(modName)//':(InitializeRealize) ' + real(dbl_kind) :: diff_lon + integer :: npes + integer :: num_elim_global + integer :: num_elim_local + integer :: num_elim + integer :: num_ice + integer :: num_elim_gcells ! local number of eliminated gridcells + integer :: num_elim_blocks ! local number of eliminated blocks + integer :: num_total_blocks + integer :: my_elim_start, my_elim_end + real(dbl_kind) :: rad_to_deg + integer(int_kind) :: ktherm + character(len=char_len_long) :: diag_filename = 'unset' + character(len=*), parameter :: F00 = "('(ice_comp_nuopc) ',2a,1x,d21.14)" + character(len=*), parameter :: subname=trim(modName)//':(InitializeRealize) ' !-------------------------------- rc = ESMF_SUCCESS @@ -378,6 +378,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) pi_in = SHR_CONST_PI, & snowpatch_in = 0.005_dbl_kind, & dragio_in = 0.00962_dbl_kind) + call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -406,12 +407,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call abort_ice( subname//' ERROR: unknown starttype' ) end if - ! Note that in the mct version the atm was initialized first so that nextsw_cday could be passed to the other - ! components - this assumed that cam or datm was ALWAYS initialized first. - ! In the nuopc version it will be easier to assume that on startup - nextsw_cday is just the current time - + ! We assume here that on startup - nextsw_cday is just the current time ! TOOD (mvertens, 2019-03-21): need to get the perpetual run working - if (trim(runtype) /= 'initial') then ! Set nextsw_cday to -1 (this will skip an orbital calculation on initialization nextsw_cday = -1.0_dbl_kind @@ -425,34 +422,33 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) runtype = 'initial' ! determined from the namelist in ice_init if CESMCOUPLED is not defined end if - single_column = .false. - ! Determine single column info - only valid for cesm - !call NUOPC_CompAttributeGet(gcomp, name='single_column', value=cvalue, isPresent=isPresent, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !if (isPresent) then - ! read(cvalue,*) single_column - !end if - - if (single_column) then - ! Must have these attributes present - call NUOPC_CompAttributeGet(gcomp, name='scmlon', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) scmlon - call NUOPC_CompAttributeGet(gcomp, name='scmlat', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) scmlat + ! Determine if single column + call NUOPC_CompAttributeGet(gcomp, name='single_column', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) single_column + if (single_column) then + call NUOPC_CompAttributeGet(gcomp, name='scmlon', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scmlon + call NUOPC_CompAttributeGet(gcomp, name='scmlat', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scmlat + end if + else + single_column = .false. end if ! Determine runid - call NUOPC_CompAttributeGet(gcomp, name='case_name', value=cvalue, isPresent=isPresent, rc=rc) - if (isPresent) then + call NUOPC_CompAttributeGet(gcomp, name='case_name', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (isPresent .and. isSet) then read(cvalue,*) runid else - runid = 'unknown' ! read in from the namelist in ice_init.F90 if CESMCOUPLED is not defined + ! read in from the namelist in ice_init.F90 if this is not an attribute passed from the driver + runid = 'unknown' end if ! Get clock information before call to cice_init - call ESMF_ClockGet( clock, & currTime=currTime, startTime=startTime, stopTime=stopTime, refTime=RefTime, & timeStep=timeStep, rc=rc) @@ -488,22 +484,35 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call abort_ice( subname//'ERROR:: bad calendar for ESMF' ) end if + !---------------------------------------------------------------------------- + ! Initialize cice communicators + !---------------------------------------------------------------------------- + + call init_communicate(lmpicom) ! initial setup for message passing + !---------------------------------------------------------------------------- ! Set cice logging !---------------------------------------------------------------------------- + ! Note - this must be done AFTER the communicators are set ! Note that sets the nu_diag module variable in ice_fileunits ! Set the nu_diag_set flag so it's not reset later -#ifdef CESMCOUPLED if (my_task == master_task) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name="diro", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) + if (isPresent .and. isSet) then + diag_filename = trim(cvalue) + end if + call NUOPC_CompAttributeGet(gcomp, name="logfile", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - open(newunit=nu_diag, file=trim(diro)//"/"//trim(logfile)) + if (isPresent .and. isSet) then + diag_filename = trim(diag_filename) // '/' // trim(cvalue) + end if + if (trim(diag_filename) /= 'unset') then + open(newunit=nu_diag, file=trim(diag_filename)) + nu_diag_set = .true. + end if end if - nu_diag_set = .true. -#endif !---------------------------------------------------------------------------- ! Initialize cice @@ -513,7 +522,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! including master_task and my_task call t_startf ('cice_init') - call cice_init( lmpicom ) + call cice_init() call t_stopf ('cice_init') !---------------------------------------------------------------------------- @@ -819,18 +828,18 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_name=flds_scalar_name, flds_scalar_num=flds_scalar_num, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return -#ifdef CESMCOUPLED !----------------------------------------------------------------- ! Prescribed ice initialization - first get compid !----------------------------------------------------------------- - call NUOPC_CompAttributeGet(gcomp, name='MCTID', value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='MCTID', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) compid ! convert from string to integer - - ! Having this if-defd means that MCT does not need to be build in a NEMS configuration + if (isPresent and isSet) then + read(cvalue,*) compid ! convert from string to integer + else + compid = 0 + end if call ice_prescribed_init(lmpicom, compid, gindex_ice) -#endif !----------------------------------------------------------------- ! Create cice export state @@ -847,7 +856,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! TODO (mvertens, 2018-12-21): fill in iceberg_prognostic as .false. - if (debug_export > 0 .and. my_task==master_task) then call State_fldDebug(exportState, flds_scalar_name, 'cice_export:', & idate, sec, nu_diag, rc=rc) @@ -1267,14 +1275,14 @@ subroutine ice_orbital_init(gcomp, clock, logunit, mastertask, rc) integer , intent(out) :: rc ! output error ! local variables - real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp + real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp character(len=char_len_long) :: msgstr ! temporary character(len=char_len_long) :: cvalue ! temporary - type(ESMF_Time) :: CurrTime ! current time - integer :: year ! model year at current time - integer :: orb_year ! orbital year for current orbital computation - logical :: lprint - logical :: first_time = .true. + type(ESMF_Time) :: CurrTime ! current time + integer :: year ! model year at current time + integer :: orb_year ! orbital year for current orbital computation + logical :: lprint + logical :: first_time = .true. character(len=*) , parameter :: subname = "(cice_orbital_init)" !------------------------------------------------------------------------------- @@ -1388,7 +1396,7 @@ subroutine ice_orbital_init(gcomp, clock, logunit, mastertask, rc) first_time = .false. end subroutine ice_orbital_init -#else +#else subroutine ice_orbital_init(gcomp, clock, logunit, mastertask, rc) @@ -1401,12 +1409,10 @@ subroutine ice_orbital_init(gcomp, clock, logunit, mastertask, rc) ! local variables real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp - logical :: isPresent, isSet - character(ESMF_MAXSTR) :: cvalue logical :: first_time = .true. character(len=*) , parameter :: subname = "(cice_orbital_init)" !-------------------------------- - + rc = ESMF_SUCCESS if (first_time) then @@ -1417,28 +1423,6 @@ subroutine ice_orbital_init(gcomp, clock, logunit, mastertask, rc) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - ! call NUOPC_CompAttributeGet(gcomp, name='orb_eccen', value=cvalue, isPresent=isPresent, rc=rc) - ! if (isPresent) then - ! read(cvalue,*) eccen - ! end if - ! call NUOPC_CompAttributeGet(gcomp, name='orb_obliqr', value=cvalue, isPresent=isPresent, rc=rc) - ! if (isPresent) then - ! read(cvalue,*) obliqr - ! end if - ! call NUOPC_CompAttributeGet(gcomp, name='orb_lambm0', value=cvalue, isPresent=isPresent, rc=rc) - ! if (isPresent) then - ! read(cvalue,*) lambm0 - ! end if - ! call NUOPC_CompAttributeGet(gcomp, name='orb_mvelpp', value=cvalue, isPresent=isPresent, rc=rc) - ! if (isPresent) then - ! read(cvalue,*) mvelpp - ! end if - - ! call icepack_init_orbit(eccen_in=eccen, mvelpp_in=mvelpp, lambm0_in=lambm0, obliqr_in=obliqr) - ! call icepack_warnings_flush(nu_diag) - ! if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - ! file=__FILE__, line=__LINE__) - first_time = .false. end if @@ -1471,28 +1455,5 @@ end subroutine ice_cal_ymd2date !=============================================================================== -#ifndef CESMCOUPLED - subroutine shr_file_setLogUnit(nunit) - integer, intent(in) :: nunit - ! do nothing for this stub - its just here to replace - ! having cppdefs in the main program - end subroutine shr_file_setLogUnit - subroutine shr_file_getLogUnit(nunit) - integer, intent(in) :: nunit - ! do nothing for this stub - its just here to replace - ! having cppdefs in the main program - end subroutine shr_file_getLogUnit - - subroutine t_startf(string) - character(len=*) :: string - end subroutine t_startf - subroutine t_stopf(string) - character(len=*) :: string - end subroutine t_stopf - subroutine t_barrierf(string, comm) - character(len=*) :: string - integer:: comm - end subroutine t_barrierf -#endif end module ice_comp_nuopc diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index 4cceaa9ca..da022ddcf 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -35,9 +35,9 @@ module ice_import_export use icepack_intfc , only : icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc , only : icepack_query_parameters, icepack_query_tracer_flags use icepack_intfc , only : icepack_liquidus_temperature + use ice_wrapper_mod , only : t_startf, t_stopf, t_barrierf #ifdef CESMCOUPLED use shr_frz_mod , only : shr_frz_freezetemp - use perf_mod , only : t_startf, t_stopf, t_barrierf #endif implicit none @@ -105,30 +105,35 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam integer , intent(out) :: rc ! local variables - integer :: n + integer :: n character(char_len) :: stdname character(char_len) :: cvalue - logical :: flds_wiso ! use case - logical :: flds_i2o_per_cat ! .true. => select per ice thickness category + logical :: flds_wiso ! use case + logical :: flds_i2o_per_cat ! .true. => select per ice thickness category + logical :: isPresent, isSet character(len=*), parameter :: subname='(ice_import_export:ice_advertise_fields)' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + ! Determine if the following attributes are sent by the driver and if so read them in flds_wiso = .false. - flds_i2o_per_cat = .false. -#ifdef CESMCOUPLED - call NUOPC_CompAttributeGet(gcomp, name='flds_wiso', value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='flds_wiso', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) flds_wiso - call ESMF_LogWrite('flds_wiso = '// trim(cvalue), ESMF_LOGMSG_INFO) + if (isPresent .and. isSet) then + read(cvalue,*) flds_wiso + call ESMF_LogWrite('flds_wiso = '// trim(cvalue), ESMF_LOGMSG_INFO) + end if + #if (defined NEWCODE) - call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, rc=rc) + flds_i2o_per_cat = .false. + call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) send_i2x_per_cat - call ESMF_LogWrite('flds_i2o_per_cat = '// trim(cvalue), ESMF_LOGMSG_INFO) -#endif + if (isPresent .and. isSet) then + read(cvalue,*) send_i2x_per_cat + call ESMF_LogWrite('flds_i2o_per_cat = '// trim(cvalue), ESMF_LOGMSG_INFO) + end if #endif !----------------- @@ -166,16 +171,14 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsToIce_num, fldsToIce, 'Sa_ptem' ) !cesm call fldlist_add(fldsToIce_num, fldsToIce, 'air_density_height_lowest' ) !cesm -#ifdef CESMCOUPLED + ! the folloing are advertised but might not be connected if they are not present + ! in the cmeps esmFldsExchange_xxx_mod.F90 that is model specific ! from atm - black carbon deposition fluxes (3) call fldlist_add(fldsToIce_num, fldsToIce, 'Faxa_bcph', ungridded_lbound=1, ungridded_ubound=3) - ! from atm - wet dust deposition frluxes (4 sizes) call fldlist_add(fldsToIce_num, fldsToIce, 'Faxa_dstwet', ungridded_lbound=1, ungridded_ubound=4) - ! from - atm dry dust deposition frluxes (4 sizes) call fldlist_add(fldsToIce_num, fldsToIce, 'Faxa_dstdry', ungridded_lbound=1, ungridded_ubound=4) -#endif do n = 1,fldsToIce_num call NUOPC_Advertise(importState, standardName=fldsToIce(n)%stdname, & @@ -203,7 +206,10 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_ir_dir_albedo' ) call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_vis_dif_albedo' ) call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_ir_dif_albedo' ) + #if (defined NEWCODE) + ! the following are advertised but might not be connected if they are not present + ! in the cmeps esmFldsExchange_xxx_mod.F90 that is model specific if (send_i2x_per_cat) then call fldlist_add(fldsFrIce_num, fldsFrIce, 'ice_fraction_n', & ungridded_lbound=1, ungridded_ubound=ncat) @@ -226,6 +232,7 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_sw_pen_to_ocn_vis_dif_flx' ) call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_sw_pen_to_ocn_ir_dir_flx' ) call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_sw_pen_to_ocn_ir_dif_flx' ) + #if (defined NEWCODE) if (send_i2x_per_cat) then call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_sw_pen_to_ocn_ifrac_n', & @@ -236,11 +243,13 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsFrIce_num , fldsFrIce, 'mean_salt_rate' ) call fldlist_add(fldsFrIce_num , fldsFrIce, 'stress_on_ocn_ice_zonal' ) call fldlist_add(fldsFrIce_num , fldsFrIce, 'stress_on_ocn_ice_merid' ) -#ifdef CESMCOUPLED + + ! the following are advertised but might not be connected if they are not present + ! in the cmeps esmFldsExchange_xxx_mod.F90 that is model specific call fldlist_add(fldsFrIce_num , fldsFrIce, 'Fioi_bcpho' ) call fldlist_add(fldsFrIce_num , fldsFrIce, 'Fioi_bcphi' ) call fldlist_add(fldsFrIce_num , fldsFrIce, 'Fioi_flxdst' ) -#endif + if (flds_wiso) then call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_fresh_water_to_ocean_rate_wiso', & ungridded_lbound=1, ungridded_ubound=3) @@ -446,13 +455,9 @@ subroutine ice_import( importState, rc ) ! perform a halo update if (.not.prescribed_ice) then -#ifdef CESMCOUPLED call t_startf ('cice_imp_halo') -#endif call ice_HaloUpdate(aflds, halo_info, field_loc_center, field_type_scalar) -#ifdef CESMCOUPLED call t_stopf ('cice_imp_halo') -#endif endif ! now fill in the ice internal data types @@ -537,13 +542,9 @@ subroutine ice_import( importState, rc ) if (.not.prescribed_ice) then -#ifdef CESMCOUPLED call t_startf ('cice_imp_halo') -#endif call ice_HaloUpdate(aflds, halo_info, field_loc_center, field_type_vector) -#ifdef CESMCOUPLED call t_stopf ('cice_imp_halo') -#endif endif !$OMP PARALLEL DO PRIVATE(iblk,i,j) @@ -656,9 +657,8 @@ subroutine ice_import( importState, rc ) ! interpolate across the pole) ! use ANGLET which is on the T grid ! -#ifdef CESMCOUPLED call t_startf ('cice_imp_ocn') -#endif + !$OMP PARALLEL DO PRIVATE(iblk,i,j,workx,worky) do iblk = 1, nblocks @@ -667,14 +667,16 @@ subroutine ice_import( importState, rc ) ! ocean workx = uocn (i,j,iblk) ! currents, m/s worky = vocn (i,j,iblk) - uocn(i,j,iblk) = workx*cos(ANGLET(i,j,iblk)) & ! convert to POP grid + + uocn(i,j,iblk) = workx*cos(ANGLET(i,j,iblk)) & ! rotate to align with model i,j + worky*sin(ANGLET(i,j,iblk)) vocn(i,j,iblk) = worky*cos(ANGLET(i,j,iblk)) & - workx*sin(ANGLET(i,j,iblk)) workx = ss_tltx (i,j,iblk) ! sea sfc tilt, m/m worky = ss_tlty (i,j,iblk) - ss_tltx(i,j,iblk) = workx*cos(ANGLET(i,j,iblk)) & ! convert to POP grid + + ss_tltx(i,j,iblk) = workx*cos(ANGLET(i,j,iblk)) & ! rotate to align with model i,j + worky*sin(ANGLET(i,j,iblk)) ss_tlty(i,j,iblk) = worky*cos(ANGLET(i,j,iblk)) & - workx*sin(ANGLET(i,j,iblk)) @@ -682,47 +684,46 @@ subroutine ice_import( importState, rc ) sst(i,j,iblk) = sst(i,j,iblk) - Tffresh ! sea sfc temp (C) sss(i,j,iblk) = max(sss(i,j,iblk),c0) -#ifndef CESMCOUPLED -!tcx should this be icepack_sea_freezing_temperature? - Tf (i,j,iblk) = icepack_liquidus_temperature(sss(i,j,iblk)) -#endif + enddo enddo + end do #ifdef CESMCOUPLED - ! Use shr_frz_mod for this, overwrite Tf computed above - Tf(:,:,iblk) = shr_frz_freezetemp(sss(:,:,iblk)) + ! Use shr_frz_mod for this + Tf(:,:,iblk) = shr_frz_freezetemp(sss(:,:,iblk)) +#else + !$OMP PARALLEL DO PRIVATE(iblk,i,j,workx,worky) + do iblk = 1, nblocks + do j = 1,ny_block + do i = 1,nx_block + !TODO: tcx should this be icepack_sea_freezing_temperature? + Tf (i,j,iblk) = icepack_liquidus_temperature(sss(i,j,iblk)) + end do + end do + end do + !$OMP END PARALLEL DO #endif - enddo - !$OMP END PARALLEL DO -#ifdef CESMCOUPLED call t_stopf ('cice_imp_ocn') -#endif ! Interpolate ocean dynamics variables from T-cell centers to ! U-cell centers. if (.not.prescribed_ice) then -#ifdef CESMCOUPLED call t_startf ('cice_imp_t2u') -#endif call t2ugrid_vector(uocn) call t2ugrid_vector(vocn) call t2ugrid_vector(ss_tltx) call t2ugrid_vector(ss_tlty) -#ifdef CESMCOUPLED call t_stopf ('cice_imp_t2u') -#endif end if ! Atmosphere variables are needed in T cell centers in ! subroutine stability and are interpolated to the U grid ! later as necessary. -#ifdef CESMCOUPLED call t_startf ('cice_imp_atm') -#endif !$OMP PARALLEL DO PRIVATE(iblk,i,j,workx,worky) do iblk = 1, nblocks do j = 1, ny_block @@ -743,9 +744,7 @@ subroutine ice_import( importState, rc ) enddo enddo !$OMP END PARALLEL DO -#ifdef CESMCOUPLED call t_stopf ('cice_imp_atm') -#endif end subroutine ice_import diff --git a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 index dd56ac441..85b4177fd 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 @@ -95,6 +95,8 @@ module ice_prescribed_mod contains !=============================================================================== +#ifdef CESM_COUPLED + subroutine ice_prescribed_init(mpicom, compid, gindex) use shr_pio_mod, only : shr_pio_getiotype, shr_pio_getiosys, shr_pio_getioformat @@ -647,6 +649,15 @@ subroutine ice_prescribed_set_domain( lsize, mpicom, gsmap_i, dom_i ) end subroutine ice_prescribed_set_domain +#else + ! This is a stub routine for now + subroutine ice_prescribed_init(mpicom, compid, gindex) + integer(kind=int_kind), intent(in) :: mpicom + integer(kind=int_kind), intent(in) :: compid + integer(kind=int_kind), intent(in) :: gindex(:) + ! do nothing + end subroutine ice_prescribed_init + #endif end module ice_prescribed_mod From 3a1b88bffa5abe4741be4effb9f13fcbfe07b189 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sat, 4 Jul 2020 13:25:48 -0600 Subject: [PATCH 15/51] fix compile errors --- cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 4 ++-- cicecore/drivers/nuopc/cmeps/ice_import_export.F90 | 8 ++++---- cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 | 5 ++++- 3 files changed, 10 insertions(+), 7 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index c3947cb98..53c57f721 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -48,8 +48,8 @@ module ice_comp_nuopc #ifdef CESMCOUPLED use shr_const_mod use shr_orb_mod , only : shr_orb_decl, shr_orb_params, SHR_ORB_UNDEF_REAL, SHR_ORB_UNDEF_INT - use ice_prescribed_mod , only : ice_prescribed_init #endif + use ice_prescribed_mod , only : ice_prescribed_init implicit none private @@ -834,7 +834,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call NUOPC_CompAttributeGet(gcomp, name='MCTID', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent and isSet) then + if (isPresent .and. isSet) then read(cvalue,*) compid ! convert from string to integer else compid = 0 diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index da022ddcf..9adb868db 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -35,7 +35,7 @@ module ice_import_export use icepack_intfc , only : icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc , only : icepack_query_parameters, icepack_query_tracer_flags use icepack_intfc , only : icepack_liquidus_temperature - use ice_wrapper_mod , only : t_startf, t_stopf, t_barrierf + use cice_wrapper_mod , only : t_startf, t_stopf, t_barrierf #ifdef CESMCOUPLED use shr_frz_mod , only : shr_frz_freezetemp #endif @@ -171,7 +171,7 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsToIce_num, fldsToIce, 'Sa_ptem' ) !cesm call fldlist_add(fldsToIce_num, fldsToIce, 'air_density_height_lowest' ) !cesm - ! the folloing are advertised but might not be connected if they are not present + ! the following are advertised but might not be connected if they are not present ! in the cmeps esmFldsExchange_xxx_mod.F90 that is model specific ! from atm - black carbon deposition fluxes (3) call fldlist_add(fldsToIce_num, fldsToIce, 'Faxa_bcph', ungridded_lbound=1, ungridded_ubound=3) @@ -253,8 +253,8 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam if (flds_wiso) then call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_fresh_water_to_ocean_rate_wiso', & ungridded_lbound=1, ungridded_ubound=3) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_evap_rate_atm_into_ice_wiso', & - ungridded_lbound=1, ungridded_ubound=3) + !call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_evap_rate_atm_into_ice_wiso', & + ! ungridded_lbound=1, ungridded_ubound=3) call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_qref_wiso', & ungridded_lbound=1, ungridded_ubound=3) end if diff --git a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 index 85b4177fd..4104b70b4 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 @@ -7,6 +7,9 @@ module ice_prescribed_mod implicit none private ! except + ! MEMBER FUNCTIONS: + public :: ice_prescribed_init ! initialize input data stream + logical(kind=log_kind), parameter, public :: prescribed_ice = .false. ! true if prescribed ice #else @@ -90,6 +93,7 @@ module ice_prescribed_mod ! , rcpidepressT = rcpi*depressT & ! param for finding T(z) from q (J/m^3) ! , rLfidepressT = rLfi*depressT ! param for heat capacity (J deg/m^3) ! ! heat capacity of sea ice, rhoi*C=rcpi+rLfidepressT*salinity/T^2 +#endif !======================================================================= contains @@ -657,7 +661,6 @@ subroutine ice_prescribed_init(mpicom, compid, gindex) integer(kind=int_kind), intent(in) :: gindex(:) ! do nothing end subroutine ice_prescribed_init - #endif end module ice_prescribed_mod From 41855fde3b5a463b20455cc4bfb8a5af6a16436f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 4 Jul 2020 14:29:12 -0600 Subject: [PATCH 16/51] fixes to get cesm working --- .../drivers/nuopc/cmeps/cice_wrapper_mod.F90 | 7 +- .../nuopc/cmeps/ice_prescribed_mod.F90 | 159 ++++++------------ 2 files changed, 56 insertions(+), 110 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/cice_wrapper_mod.F90 b/cicecore/drivers/nuopc/cmeps/cice_wrapper_mod.F90 index e350e9a52..0da2ed491 100644 --- a/cicecore/drivers/nuopc/cmeps/cice_wrapper_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/cice_wrapper_mod.F90 @@ -1,13 +1,12 @@ module cice_wrapper_mod #ifdef CESMCOUPLED - use perf_mod, only : t_startf, t_stopf, t_barrierf -#endif - + use perf_mod , only : t_startf, t_stopf, t_barrierf + use shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit +#else contains -#ifndef CESMCOUPLED ! These are just stub routines put in place to remove subroutine shr_file_setLogUnit(nunit) diff --git a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 index 4104b70b4..78ea39b4e 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 @@ -1,5 +1,12 @@ module ice_prescribed_mod + ! !DESCRIPTION: + ! The prescribed ice model reads in ice concentration data from a netCDF + ! file. Ice thickness, temperature, the ice temperature profile are + ! prescribed. Air/ice fluxes are computed to get surface temperature, + ! Ice/ocean fluxes are set to zero, and ice dynamics are not calculated. + ! Regridding and data cycling capabilities are included. + #ifndef CESMCOUPLED use ice_kinds_mod @@ -7,22 +14,21 @@ module ice_prescribed_mod implicit none private ! except - ! MEMBER FUNCTIONS: public :: ice_prescribed_init ! initialize input data stream - logical(kind=log_kind), parameter, public :: prescribed_ice = .false. ! true if prescribed ice -#else +contains + ! This is a stub routine for now + subroutine ice_prescribed_init(mpicom, compid, gindex) + integer(kind=int_kind), intent(in) :: mpicom + integer(kind=int_kind), intent(in) :: compid + integer(kind=int_kind), intent(in) :: gindex(:) + ! do nothing + end subroutine ice_prescribed_init - ! !DESCRIPTION: - ! The prescribed ice model reads in ice concentration data from a netCDF - ! file. Ice thickness, temperature, the ice temperature profile are - ! prescribed. Air/ice fluxes are computed to get surface temperature, - ! Ice/ocean fluxes are set to zero, and ice dynamics are not calculated. - ! Regridding and data cycling capabilities are included. +#else - ! !USES: - use shr_nl_mod, only : shr_nl_find_group_name + use shr_nl_mod , only : shr_nl_find_group_name use shr_strdata_mod use shr_dmodel_mod use shr_string_mod @@ -31,24 +37,23 @@ module ice_prescribed_mod use shr_mct_mod use mct_mod use pio - use ice_broadcast - use ice_communicate , only : my_task, master_task, MPI_COMM_ICE + use ice_communicate , only : my_task, master_task, MPI_COMM_ICE use ice_kinds_mod use ice_fileunits - use ice_exit , only : abort_ice - use ice_domain_size , only : nx_global, ny_global, ncat, nilyr, nslyr, max_blocks + use ice_exit , only : abort_ice + use ice_domain_size , only : nx_global, ny_global, ncat, nilyr, nslyr, max_blocks use ice_constants - use ice_blocks , only : nx_block, ny_block, block, get_block - use ice_domain , only : nblocks, distrb_info, blocks_ice - use ice_grid , only : TLAT, TLON, hm, tmask, tarea, grid_type, ocn_gridcell_frac - use ice_calendar , only : idate, sec, calendar_type - use ice_arrays_column, only : hin_max + use ice_blocks , only : nx_block, ny_block, block, get_block + use ice_domain , only : nblocks, distrb_info, blocks_ice + use ice_grid , only : TLAT, TLON, hm, tmask, tarea, grid_type, ocn_gridcell_frac + use ice_calendar , only : idate, sec, calendar_type + use ice_arrays_column , only : hin_max use ice_read_write - use ice_exit, only: abort_ice - use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted - use icepack_intfc, only: icepack_query_tracer_indices, icepack_query_tracer_sizes - use icepack_intfc, only: icepack_query_parameters + use ice_exit , only: abort_ice + use icepack_intfc , only: icepack_warnings_flush, icepack_warnings_aborted + use icepack_intfc , only: icepack_query_tracer_indices, icepack_query_tracer_sizes + use icepack_intfc , only: icepack_query_parameters implicit none private ! except @@ -59,59 +64,38 @@ module ice_prescribed_mod public :: ice_prescribed_phys ! set prescribed ice state and fluxes ! !PUBLIC DATA MEMBERS: - logical(kind=log_kind), public :: prescribed_ice ! true if prescribed ice - + logical(kind=log_kind), public :: prescribed_ice ! true if prescribed ice integer(kind=int_kind),parameter :: nFilesMaximum = 400 ! max number of files - integer(kind=int_kind) :: stream_year_first ! first year in stream to use - integer(kind=int_kind) :: stream_year_last ! last year in stream to use - integer(kind=int_kind) :: model_year_align ! align stream_year_first - ! with this model year - - character(len=char_len_long) :: stream_fldVarName - character(len=char_len_long) :: stream_fldFileName(nFilesMaximum) - character(len=char_len_long) :: stream_domTvarName - character(len=char_len_long) :: stream_domXvarName - character(len=char_len_long) :: stream_domYvarName - character(len=char_len_long) :: stream_domAreaName - character(len=char_len_long) :: stream_domMaskName - character(len=char_len_long) :: stream_domFileName - character(len=char_len_long) :: stream_mapread - logical(kind=log_kind) :: prescribed_ice_fill ! true if data fill required - - type(shr_strdata_type) :: sdat ! prescribed data stream - character(len=char_len_long) :: fldList ! list of fields in data stream - real(kind=dbl_kind),allocatable :: ice_cov(:,:,:) ! ice cover - -! real (kind=dbl_kind), parameter :: & -! cp_sno = 0.0_dbl_kind & ! specific heat of snow (J/kg/K) -! , rLfi = Lfresh*rhoi & ! latent heat of fusion ice (J/m^3) -! , rLfs = Lfresh*rhos & ! latent heat of fusion snow (J/m^3) -! , rLvi = Lvap*rhoi & ! latent heat of vapor*rhoice (J/m^3) -! , rLvs = Lvap*rhos & ! latent heat of vapor*rhosno (J/m^3) -! , rcpi = cp_ice*rhoi & ! heat capacity of fresh ice (J/m^3) -! , rcps = cp_sno*rhos & ! heat capacity of snow (J/m^3) -! , rcpidepressT = rcpi*depressT & ! param for finding T(z) from q (J/m^3) -! , rLfidepressT = rLfi*depressT ! param for heat capacity (J deg/m^3) -! ! heat capacity of sea ice, rhoi*C=rcpi+rLfidepressT*salinity/T^2 -#endif + integer(kind=int_kind) :: stream_year_first ! first year in stream to use + integer(kind=int_kind) :: stream_year_last ! last year in stream to use + integer(kind=int_kind) :: model_year_align ! align stream_year_first with this model year + character(len=char_len_long) :: stream_fldVarName + character(len=char_len_long) :: stream_fldFileName(nFilesMaximum) + character(len=char_len_long) :: stream_domTvarName + character(len=char_len_long) :: stream_domXvarName + character(len=char_len_long) :: stream_domYvarName + character(len=char_len_long) :: stream_domAreaName + character(len=char_len_long) :: stream_domMaskName + character(len=char_len_long) :: stream_domFileName + character(len=char_len_long) :: stream_mapread + logical(kind=log_kind) :: prescribed_ice_fill ! true if data fill required + type(shr_strdata_type) :: sdat ! prescribed data stream + character(len=char_len_long) :: fldList ! list of fields in data stream + real(kind=dbl_kind),allocatable :: ice_cov(:,:,:) ! ice cover -!======================================================================= contains -!=============================================================================== - -#ifdef CESM_COUPLED subroutine ice_prescribed_init(mpicom, compid, gindex) - use shr_pio_mod, only : shr_pio_getiotype, shr_pio_getiosys, shr_pio_getioformat - ! !DESCRIPTION: ! Prescribed ice initialization - needed to ! work with new shr_strdata module derived type - ! !INPUT/OUTPUT PARAMETERS: + use shr_pio_mod, only : shr_pio_getiotype, shr_pio_getiosys, shr_pio_getioformat + implicit none include 'mpif.h' + ! !nput/output parameters: integer(kind=int_kind), intent(in) :: mpicom integer(kind=int_kind), intent(in) :: compid integer(kind=int_kind), intent(in) :: gindex(:) @@ -263,7 +247,6 @@ subroutine ice_prescribed_init(mpicom, compid, gindex) end subroutine ice_prescribed_init !======================================================================= - subroutine ice_prescribed_run(mDateIn, secIn) ! !DESCRIPTION: @@ -335,25 +318,12 @@ subroutine ice_prescribed_run(mDateIn, secIn) end subroutine ice_prescribed_run !=============================================================================== - !BOP =========================================================================== - ! - ! !IROUTINE: ice_prescribed_phys -- set prescribed ice state and fluxes - ! - ! !DESCRIPTION: - ! - ! Set prescribed ice state using input ice concentration; - ! set surface ice temperature to atmospheric value; use - ! linear temperature gradient in ice to ocean temperature. - ! - ! !REVISION HISTORY: - ! 2005-May-23 - J. Schramm - Updated with data models - ! 2004-July - J. Schramm - Modified to allow variable snow cover - ! 2001-May - B. P. Briegleb - Original version - ! - ! !INTERFACE: ------------------------------------------------------------------ - subroutine ice_prescribed_phys + ! Set prescribed ice state using input ice concentration; + ! set surface ice temperature to atmospheric value; use + ! linear temperature gradient in ice to ocean temperature. + ! !USES: use ice_flux use ice_state @@ -395,20 +365,6 @@ subroutine ice_prescribed_phys if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - !----------------------------------------------------------------- - ! Initialize ice state - !----------------------------------------------------------------- - - ! TODO - can we now get rid of the following??? - - ! aicen(:,:,:,:) = c0 - ! vicen(:,:,:,:) = c0 - ! eicen(:,:,:,:) = c0 - - ! do nc=1,ncat - ! trcrn(:,:,nt_Tsfc,nc,:) = Tf(:,:,:) - ! enddo - !----------------------------------------------------------------- ! Set ice cover over land to zero, not sure if this should be ! be done earier, before time/spatial interp?????? @@ -554,7 +510,6 @@ subroutine ice_prescribed_phys end subroutine ice_prescribed_phys !=============================================================================== - subroutine ice_prescribed_set_domain( lsize, mpicom, gsmap_i, dom_i ) ! Arguments @@ -653,14 +608,6 @@ subroutine ice_prescribed_set_domain( lsize, mpicom, gsmap_i, dom_i ) end subroutine ice_prescribed_set_domain -#else - ! This is a stub routine for now - subroutine ice_prescribed_init(mpicom, compid, gindex) - integer(kind=int_kind), intent(in) :: mpicom - integer(kind=int_kind), intent(in) :: compid - integer(kind=int_kind), intent(in) :: gindex(:) - ! do nothing - end subroutine ice_prescribed_init #endif end module ice_prescribed_mod From 30a81cce323bfd6b742e9cb6be00c8708b4f8bde Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 7 Jul 2020 12:17:21 -0600 Subject: [PATCH 17/51] fixed white space issue --- .../infrastructure/ice_read_write.F90 | 30 +++++++------------ 1 file changed, 11 insertions(+), 19 deletions(-) diff --git a/cicecore/cicedynB/infrastructure/ice_read_write.F90 b/cicecore/cicedynB/infrastructure/ice_read_write.F90 index 4fa115ee3..f497db49b 100644 --- a/cicecore/cicedynB/infrastructure/ice_read_write.F90 +++ b/cicecore/cicedynB/infrastructure/ice_read_write.F90 @@ -1106,7 +1106,6 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & integer (kind=int_kind) :: & varid , & ! variable id status ! status output from netcdf routines -! status , & ! status output from netcdf routines ! ndim, nvar, & ! sizes of netcdf file ! id, & ! dimension index ! dimlen ! dimension size @@ -1114,7 +1113,7 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & real (kind=dbl_kind) :: & amin, amax, asum ! min, max values and sum of input array -! character (char_len) :: & +! character (char_len) :: & ! dimname ! dimension name real (kind=dbl_kind), dimension(:,:), allocatable :: & @@ -1280,7 +1279,6 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & n, & ! ncat index varid , & ! variable id status ! status output from netcdf routines -! status , & ! status output from netcdf routines ! ndim, nvar, & ! sizes of netcdf file ! id, & ! dimension index ! dimlen ! size of dimension @@ -1288,7 +1286,7 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & real (kind=dbl_kind) :: & amin, amax, asum ! min, max values and sum of input array -! character (char_len) :: & +! character (char_len) :: & ! dimname ! dimension name real (kind=dbl_kind), dimension(:,:,:), allocatable :: & @@ -1366,7 +1364,7 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & if (my_task==master_task .and. diag) then ! write(nu_diag,*) & -! 'ice_read_nc_xyz, fid= ',fid, ', nrec = ',nrec, & +! 'ice_read_nc_xyz, fid= ',fid, ', nrec = ',nrec, & ! ', varname = ',trim(varname) ! status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar) ! write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar @@ -1837,7 +1835,6 @@ subroutine ice_write_nc_xy(fid, nrec, varid, work, diag, & ! netCDF file diagnostics: integer (kind=int_kind) :: & status ! status output from netcdf routines -! status, & ! status output from netcdf routines ! ndim, nvar, & ! sizes of netcdf file ! id, & ! dimension index ! dimlen ! size of dimension @@ -1847,8 +1844,7 @@ subroutine ice_write_nc_xy(fid, nrec, varid, work, diag, & character (char_len) :: & lvarname ! variable name -! lvarname, & ! variable name -! dimname ! dimension name +! dimname ! dimension name real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g1 @@ -1959,18 +1955,16 @@ subroutine ice_write_nc_xyz(fid, nrec, varid, work, diag, & integer (kind=int_kind) :: & n, & ! ncat index status ! status output from netcdf routines -! status, & ! status output from netcdf routines -! ndim, nvar, & ! sizes of netcdf file -! id, & ! dimension index -! dimlen ! size of dimension +! ndim, nvar, & ! sizes of netcdf file +! id, & ! dimension index +! dimlen ! size of dimension real (kind=dbl_kind) :: & amin, amax, asum ! min, max values and sum of input array character (char_len) :: & lvarname ! variable name -! lvarname, & ! variable name -! dimname ! dimension name +! dimname ! dimension name real (kind=dbl_kind), dimension(:,:,:), allocatable :: & work_g1 @@ -2087,7 +2081,6 @@ subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) integer (kind=int_kind) :: & varid, & ! netcdf id for field status ! status output from netcdf routines -! status, & ! status output from netcdf routines ! ndim, nvar, & ! sizes of netcdf file ! id, & ! dimension index ! dimlen ! size of dimension @@ -2095,9 +2088,9 @@ subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) real (kind=dbl_kind) :: & amin, amax, asum ! min, max values and sum of input array -! character (char_len) :: & +! character (char_len) :: & ! dimname ! dimension name - +! #ifdef ORCA_GRID real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g3 @@ -2239,7 +2232,6 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & integer (kind=int_kind) :: & varid , & ! variable id status ! status output from netcdf routines -! status, & ! status output from netcdf routines ! ndim, nvar, & ! sizes of netcdf file ! id, & ! dimension index ! dimlen ! size of dimension @@ -2247,7 +2239,7 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & real (kind=dbl_kind) :: & amin, amax, asum ! min, max values and sum of input array -! character (char_len) :: & +! character (char_len) :: & ! dimname ! dimension name real (kind=dbl_kind), dimension(:,:), allocatable :: & From 27dd3b7e6003b8aac0977d3a057e9a61ed7305d4 Mon Sep 17 00:00:00 2001 From: David Bailey Date: Tue, 7 Jul 2020 12:40:33 -0600 Subject: [PATCH 18/51] Add restart_coszen namelist option --- cicecore/cicedynB/general/ice_init.F90 | 8 ++++++-- .../infrastructure/ice_restart_driver.F90 | 15 +++------------ .../infrastructure/io/io_netcdf/ice_restart.F90 | 7 ++----- .../infrastructure/io/io_pio2/ice_restart.F90 | 8 +++----- cicecore/shared/ice_restart_shared.F90 | 1 + configuration/scripts/ice_in | 1 + doc/source/cice_index.rst | 1 + doc/source/user_guide/ug_case_settings.rst | 1 + doc/source/user_guide/ug_implementation.rst | 4 ++++ 9 files changed, 22 insertions(+), 24 deletions(-) diff --git a/cicecore/cicedynB/general/ice_init.F90 b/cicecore/cicedynB/general/ice_init.F90 index f43c08793..91c5d539d 100644 --- a/cicecore/cicedynB/general/ice_init.F90 +++ b/cicecore/cicedynB/general/ice_init.F90 @@ -73,7 +73,7 @@ subroutine input_data restart_pond_cesm, restart_pond_lvl, restart_pond_topo, restart_aero, & restart_fsd, restart_iso use ice_restart_shared, only: & - restart, restart_ext, restart_dir, restart_file, pointer_file, & + restart, restart_ext, restart_coszen, restart_dir, restart_file, pointer_file, & runid, runtype, use_restart_time, restart_format, lcdf64 use ice_history_shared, only: hist_avg, history_dir, history_file, & incond_dir, incond_file, version_name, & @@ -149,7 +149,8 @@ subroutine input_data dt, npt, ndtd, numin, & runtype, runid, bfbflag, numax, & ice_ic, restart, restart_dir, restart_file, & - restart_ext, use_restart_time, restart_format, lcdf64, & + restart_ext, restart_coszen, use_restart_time, restart_format, & + lcdf64, & pointer_file, dumpfreq, dumpfreq_n, dump_last, & diagfreq, diag_type, diag_file, history_format,& print_global, print_points, latpnt, lonpnt, & @@ -269,6 +270,7 @@ subroutine input_data restart_dir = './' ! write to executable dir for default restart_file = 'iced' ! restart file name prefix restart_ext = .false. ! if true, read/write ghost cells + restart_coszen = .false. ! if true, read/write coszen use_restart_time = .true. ! if true, use time info written in file pointer_file = 'ice.restart_file' restart_format = 'default' ! restart file format @@ -563,6 +565,7 @@ subroutine input_data call broadcast_scalar(restart, master_task) call broadcast_scalar(restart_dir, master_task) call broadcast_scalar(restart_ext, master_task) + call broadcast_scalar(restart_coszen, master_task) call broadcast_scalar(use_restart_time, master_task) call broadcast_scalar(restart_format, master_task) call broadcast_scalar(lcdf64, master_task) @@ -1458,6 +1461,7 @@ subroutine input_data write(nu_diag,*) ' restart_dir = ', & trim(restart_dir) write(nu_diag,*) ' restart_ext = ', restart_ext + write(nu_diag,*) ' restart_coszen = ', restart_coszen write(nu_diag,*) ' restart_format = ', & trim(restart_format) write(nu_diag,*) ' lcdf64 = ', & diff --git a/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 b/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 index d3829b9c4..7eb7c020d 100644 --- a/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 +++ b/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 @@ -23,7 +23,7 @@ module ice_restart_driver field_loc_center, field_loc_NEcorner, & field_type_scalar, field_type_vector use ice_restart_shared, only: restart_dir, pointer_file, & - runid, use_restart_time, lenstr + runid, use_restart_time, lenstr, restart_coszen use ice_restart use ice_exit, only: abort_ice use ice_fileunits, only: nu_diag, nu_rst_pointer, nu_restart, nu_dump @@ -58,9 +58,7 @@ subroutine dumpfile(filename_spec) stressp_1, stressp_2, stressp_3, stressp_4, & stressm_1, stressm_2, stressm_3, stressm_4, & stress12_1, stress12_2, stress12_3, stress12_4 -#ifdef CESMCOUPLED use ice_flux, only: coszen -#endif use ice_state, only: aicen, vicen, vsnon, trcrn, uvel, vvel character(len=char_len_long), intent(in), optional :: filename_spec @@ -132,9 +130,7 @@ subroutine dumpfile(filename_spec) !----------------------------------------------------------------- ! radiation fields !----------------------------------------------------------------- -#ifdef CESMCOUPLED - call write_restart_field(nu_dump,0,coszen,'ruf8','coszen',1,diag) -#endif + if (restart_coszen) call write_restart_field(nu_dump,0,coszen,'ruf8','coszen',1,diag) call write_restart_field(nu_dump,0,scale_factor,'ruf8','scale_factor',1,diag) call write_restart_field(nu_dump,0,swvdr,'ruf8','swvdr',1,diag) @@ -209,9 +205,7 @@ subroutine restartfile (ice_ic) stressp_1, stressp_2, stressp_3, stressp_4, & stressm_1, stressm_2, stressm_3, stressm_4, & stress12_1, stress12_2, stress12_3, stress12_4 -#ifdef CESMCOUPLED use ice_flux, only: coszen -#endif use ice_grid, only: tmask, grid_type use ice_state, only: trcr_depend, aice, vice, vsno, trcr, & aice0, aicen, vicen, vsnon, trcrn, aice_init, uvel, vvel, & @@ -310,11 +304,8 @@ subroutine restartfile (ice_ic) if (my_task == master_task) & write(nu_diag,*) 'radiation fields' -#ifdef CESMCOUPLED - call read_restart_field(nu_restart,0,coszen,'ruf8', & -! 'coszen',1,diag, field_loc_center, field_type_scalar) + if (restart_coszen) call read_restart_field(nu_restart,0,coszen,'ruf8', & 'coszen',1,diag) -#endif call read_restart_field(nu_restart,0,scale_factor,'ruf8', & 'scale_factor',1,diag, field_loc_center, field_type_scalar) call read_restart_field(nu_restart,0,swvdr,'ruf8', & diff --git a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 index d4decf6f7..d3cf954a0 100644 --- a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 @@ -11,7 +11,7 @@ module ice_restart use netcdf use ice_restart_shared, only: & restart_ext, restart_dir, restart_file, pointer_file, & - runid, use_restart_time, lcdf64, lenstr + runid, use_restart_time, lcdf64, lenstr, restart_coszen use ice_fileunits, only: nu_diag, nu_rst_pointer use ice_exit, only: abort_ice use icepack_intfc, only: icepack_query_parameters @@ -227,10 +227,7 @@ subroutine init_restart_write(filename_spec) call define_rest_field(ncid,'uvel',dims) call define_rest_field(ncid,'vvel',dims) - -#ifdef CESMCOUPLED - call define_rest_field(ncid,'coszen',dims) -#endif + if (restart_coszen) call define_rest_field(ncid,'coszen',dims) call define_rest_field(ncid,'scale_factor',dims) call define_rest_field(ncid,'swvdr',dims) call define_rest_field(ncid,'swvdf',dims) diff --git a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 index 5bb880dc5..b11dcf0d0 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 @@ -11,7 +11,8 @@ module ice_restart use ice_kinds_mod use ice_restart_shared, only: & restart, restart_ext, restart_dir, restart_file, pointer_file, & - runid, runtype, use_restart_time, restart_format, lcdf64, lenstr + runid, runtype, use_restart_time, restart_format, lcdf64, lenstr, & + restart_coszen use ice_pio use pio use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted @@ -245,10 +246,7 @@ subroutine init_restart_write(filename_spec) call define_rest_field(File,'uvel',dims) call define_rest_field(File,'vvel',dims) - -#ifdef CESMCOUPLED - call define_rest_field(File,'coszen',dims) -#endif + if (restart_coszen) call define_rest_field(File,'coszen',dims) call define_rest_field(File,'scale_factor',dims) call define_rest_field(File,'swvdr',dims) call define_rest_field(File,'swvdf',dims) diff --git a/cicecore/shared/ice_restart_shared.F90 b/cicecore/shared/ice_restart_shared.F90 index 82b82c5ce..6578ef3ad 100644 --- a/cicecore/shared/ice_restart_shared.F90 +++ b/cicecore/shared/ice_restart_shared.F90 @@ -11,6 +11,7 @@ module ice_restart_shared logical (kind=log_kind), public :: & restart , & ! if true, initialize using restart file instead of defaults restart_ext, & ! if true, read/write extended grid (with ghost cells) + restart_coszen, & ! if true, read/write coszen use_restart_time ! if true, use time written in core restart file character (len=char_len), public :: & diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index 9d35b4366..54663f86c 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -10,6 +10,7 @@ ice_ic = './restart/iced_gx3_v5.nc' restart = .true. restart_ext = .false. + restart_coszen = .false. use_restart_time = .true. restart_format = 'default' lcdf64 = .false. diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index 1884d03f1..1d3baca38 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -523,6 +523,7 @@ either Celsius or Kelvin units). "restart_format", ":math:`\bullet` restart file format", "" "restart_[tracer]", ":math:`\bullet` if true, read tracer restart file", "" "restart_ext", ":math:`\bullet` if true, read/write halo cells in restart file", "" + "restart_coszen", ":math:`\bullet` if true, read/write coszen in restart file", "" "restore_bgc", ":math:`\bullet` if true, restore nitrate/silicate to data", "" "restore_ice", ":math:`\bullet` if true, restore ice state along lateral boundaries", "" "restore_ocn", ":math:`\bullet` restore sst to data", "" diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 84d3633b1..5512841a2 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -148,6 +148,7 @@ setup_nml "``restart``", "logical", "initialize using restart file", "``.false.``" "``restart_dir``", "string", "path to restart directory", "'./'" "``restart_ext``", "logical", "read/write halo cells in restart files", "``.false.``" + "``restart_coszen``", "logical", "read/write coszen in restart files", "``.false.``" "``restart_file``", "string", "output file prefix for restart dump", "'iced'" "``restart_format``", "``default``", "read/write restart file with default format", "``default``" "", "``pio_pnetcdf``", "read/write restart files with pnetcdf in pio", "" diff --git a/doc/source/user_guide/ug_implementation.rst b/doc/source/user_guide/ug_implementation.rst index b7d9c0f47..44d4ef1d6 100644 --- a/doc/source/user_guide/ug_implementation.rst +++ b/doc/source/user_guide/ug_implementation.rst @@ -569,6 +569,10 @@ An additional namelist option, ``restart_ext`` specifies whether halo cells are included in the restart files. This option is useful for tripole and regional grids, but can not be used with PIO. +An additional namelist option, ``restart_coszen`` specifies whether the +cosine of the zenith angle is included in the restart files. This is mainly +used in coupled models. + MPI is initialized in *init\_communicate* for both coupled and stand-alone MPI runs. The ice component communicates with a flux coupler or other climate components via external routines that handle the From aa9ef50bffcd9997893061514c9ec8260a783396 Mon Sep 17 00:00:00 2001 From: David Bailey Date: Wed, 15 Jul 2020 14:48:25 -0600 Subject: [PATCH 19/51] Update NUOPC cap to work with latest CICE6 master --- cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 | 8 +++++- .../drivers/nuopc/cmeps/ice_import_export.F90 | 28 ++++++++----------- 2 files changed, 18 insertions(+), 18 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 index 486c36dcc..644ef72fa 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 @@ -346,6 +346,7 @@ subroutine coupling_prep (iblk) alvdf_ai, alidf_ai, alvdr_ai, alidr_ai, fhocn_ai, & fresh_ai, fsalt_ai, fsalt, & fswthru_ai, fhocn, fswthru, scale_factor, snowfrac, & + fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & fsens, flat, fswabs, flwout, evap, Tref, Qref, & scale_fluxes, frzmlt_init, frzmlt, Uref, wind @@ -543,7 +544,12 @@ subroutine coupling_prep (iblk) evap (:,:,iblk), & Tref (:,:,iblk), Qref (:,:,iblk), & fresh (:,:,iblk), fsalt (:,:,iblk), & - fhocn (:,:,iblk), fswthru (:,:,iblk), & + fhocn (:,:,iblk), & + fswthru (:,:,iblk), & + fswthru_vdr(:,:,iblk), & + fswthru_vdf(:,:,iblk), & + fswthru_idr(:,:,iblk), & + fswthru_idf(:,:,iblk), & faero_ocn(:,:,:,iblk), & alvdr (:,:,iblk), alidr (:,:,iblk), & alvdf (:,:,iblk), alidf (:,:,iblk), & diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index 11cfcfbab..d466c2215 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -13,13 +13,13 @@ module ice_import_export use ice_flux , only : strairxt, strairyt, strocnxt, strocnyt use ice_flux , only : alvdr, alidr, alvdf, alidf, Tref, Qref, Uref use ice_flux , only : flat, fsens, flwout, evap, fswabs, fhocn, fswthru -#if (defined NEWCODE) use ice_flux , only : fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf +#if (defined NEWCODE) use ice_flux , only : send_i2x_per_cat, fswthrun_ai - use ice_flux , only : faero_atm, faero_ocn - use ice_flux , only : fiso_atm, fiso_ocn, fiso_rain, fiso_evap - use ice_flux , only : Qa_iso, Qref_iso, HDO_ocn, H2_18O_ocn, H2_16O_ocn #endif + use ice_flux_bgc , only : faero_atm, faero_ocn + use ice_flux_bgc , only : fiso_atm, fiso_ocn, fiso_evap + use ice_flux_bgc , only : Qa_iso, Qref_iso, HDO_ocn, H2_18O_ocn, H2_16O_ocn use ice_flux , only : fresh, fsalt, zlvl, uatm, vatm, potT, Tair, Qa use ice_flux , only : rhoa, swvdr, swvdf, swidr, swidf, flw, frain use ice_flux , only : fsnow, uocn, vocn, sst, ss_tltx, ss_tlty, frzmlt @@ -568,7 +568,6 @@ subroutine ice_import( importState, rc ) ! Get aerosols from mediator !------------------------------------------------------- -#if (defined NEWCODE) if (State_FldChk(importState, 'Faxa_bcph')) then ! the following indices are based on what the atmosphere is sending ! bcphidry ungridded_index=1 @@ -604,7 +603,6 @@ subroutine ice_import( importState, rc ) call state_getimport(importState, 'Faxa_dstdry', output=faero_atm, index=3, do_sum=.true., ungridded_index=4, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if -#endif !------------------------------------------------------- ! Water isotopes from the mediator @@ -614,7 +612,6 @@ subroutine ice_import( importState, rc ) ! 18O => ungridded_index=2 ! HDO => ungridded_index=3 -#if (defined NEWCODE) if (State_FldChk(importState, 'shum_wiso')) then call state_getimport(importState, 'inst_spec_humid_height_lowest_wiso', output=Qa_iso, index=1, ungridded_index=3, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -623,12 +620,12 @@ subroutine ice_import( importState, rc ) call state_getimport(importState, 'inst_spec_humid_height_lowest_wiso', output=Qa_iso, index=3, ungridded_index=2, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_prec_rate_wiso', output=fiso_rain, index=1, ungridded_index=3, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_prec_rate_wiso', output=fiso_rain, index=2, ungridded_index=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_prec_rate_wiso', output=fiso_rain, index=3, ungridded_index=2, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call state_getimport(importState, 'mean_prec_rate_wiso', output=fiso_rain, index=1, ungridded_index=3, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call state_getimport(importState, 'mean_prec_rate_wiso', output=fiso_rain, index=2, ungridded_index=1, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call state_getimport(importState, 'mean_prec_rate_wiso', output=fiso_rain, index=3, ungridded_index=2, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_getimport(importState, 'mean_fprec_rate_wiso', output=fiso_atm, index=1, ungridded_index=3, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -644,7 +641,6 @@ subroutine ice_import( importState, rc ) call state_getimport(importState, 'So_roce_wiso', output=H2_18O_ocn, ungridded_index=2, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if -#endif !----------------------------------------------------------------- ! rotate zonal/meridional vectors to local coordinates @@ -1005,7 +1001,6 @@ subroutine ice_export( exportState, rc ) call state_setexport(exportState, 'mean_sw_pen_to_ocn' , input=fswthru, lmask=tmask, ifrac=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return -#if (defined NEWCODE) ! flux of vis dir shortwave through ice to ocean call state_setexport(exportState, 'mean_sw_pen_to_ocn_vis_dir_flx' , input=fswthru_vdr, lmask=tmask, ifrac=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1021,7 +1016,6 @@ subroutine ice_export( exportState, rc ) ! flux of ir dif shortwave through ice to ocean call state_setexport(exportState, 'mean_sw_pen_to_ocn_ir_dif_flx' , input=fswthru_idf, lmask=tmask, ifrac=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return -#endif ! heat exchange with ocean call state_setexport(exportState, 'net_heat_flx_to_ocn' , input=fhocn, lmask=tmask, ifrac=ailohi, rc=rc) @@ -1043,7 +1037,6 @@ subroutine ice_export( exportState, rc ) call state_setexport(exportState, 'stress_on_ocn_ice_merid' , input=tauyo, lmask=tmask, ifrac=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return -#if (defined NEWCODE) ! ------ ! optional aerosol fluxes to ocean ! ------ @@ -1114,6 +1107,7 @@ subroutine ice_export( exportState, rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif +#if (defined NEWCODE) ! ------ ! optional short wave penetration to ocean ice category ! ------ From 7fc1c3013d93d272eb159f1beb4d5ab5f6fe4fd0 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 5 Aug 2020 18:49:28 -0400 Subject: [PATCH 20/51] nuopc,cmeps or s2s build updates --- .../drivers/nuopc/cmeps/CICE_FinalMod.F90 | 5 ++- .../drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 35 ++++++++++++++++++- .../drivers/nuopc/cmeps/ice_import_export.F90 | 21 +++++++---- .../forapps/ufs/comp_ice.backend.clean | 8 ++--- .../forapps/ufs/comp_ice.backend.libcice | 12 ++++--- .../scripts/machines/Macros.cheyenne_intel | 2 +- .../scripts/machines/Macros.hera_intel | 2 +- .../scripts/machines/Macros.orion_intel | 2 +- 8 files changed, 64 insertions(+), 23 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/CICE_FinalMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_FinalMod.F90 index c2331e4e5..943787498 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_FinalMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_FinalMod.F90 @@ -55,9 +55,8 @@ subroutine CICE_Finalize ! quit MPI !------------------------------------------------------------------- -#ifndef coupled - call end_run ! quit MPI -#endif +! standalone +! call end_run ! quit MPI end subroutine CICE_Finalize diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index aff4b5099..9f5d4ec27 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -539,6 +539,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- call icepack_query_parameters(ktherm_out=ktherm) + call icepack_query_parameters(tfrz_option_out=tfrz_option) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -602,6 +603,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) write(nu_diag,*) trim(subname),' cice calendar_type = ',trim(calendar_type) endif +#ifdef CESMCOUPLED if (calendar_type == "GREGORIAN" .or. & calendar_type == "Gregorian" .or. & calendar_type == "gregorian") then @@ -609,6 +611,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) else call time2sec(iyear-year_init,month,mday,time) endif +#endif time = time+start_tod end if @@ -875,7 +878,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- if (dbug > 1) then - call State_diagnose(exportState,subname//':ES',rc=rc) + call state_diagnose(exportState,subname//':ES',rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -905,8 +908,10 @@ subroutine ModelAdvance(gcomp, rc) ! Local variables type(ESMF_Clock) :: clock type(ESMF_Alarm) :: alarm + type(ESMF_Time) :: startTime type(ESMF_Time) :: currTime type(ESMF_Time) :: nextTime + type(ESMF_TimeInterval) :: timeStep type(ESMF_State) :: importState, exportState character(ESMF_MAXSTR) :: cvalue real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp @@ -928,11 +933,30 @@ subroutine ModelAdvance(gcomp, rc) logical :: isPresent, isSet character(*) , parameter :: F00 = "('(ice_comp_nuopc) ',2a,i8,d21.14)" character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' + character(char_len_long) :: msgString !-------------------------------- rc = ESMF_SUCCESS if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + ! query the Component for its clock, importState and exportState + call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & + exportState=exportState, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockPrint(clock, options="currTime", & + preString="------>Advancing ICE from: ", unit=msgString, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//trim(msgString), ESMF_LOGMSG_INFO) + + call ESMF_ClockGet(clock, startTime=startTime, currTime=currTime, & + timeStep=timeStep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimePrint(currTime + timeStep, & + preString="--------------------------------> to: ", unit=msgString, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) !-------------------------------- ! Turn on timers !-------------------------------- @@ -1050,6 +1074,10 @@ subroutine ModelAdvance(gcomp, rc) idate, sec, nu_diag, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + if (dbug > 1) then + call state_diagnose(importState,subname//':IS',rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if !-------------------------------- ! Advance cice and timestep update @@ -1067,11 +1095,16 @@ subroutine ModelAdvance(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf ('cice_run_export') + ! write Debug output if (debug_export > 0 .and. my_task==master_task) then call State_fldDebug(exportState, flds_scalar_name, 'cice_export:', & idate, sec, nu_diag, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + if (dbug > 1) then + call state_diagnose(exportState,subname//':ES',rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if ! reset shr logging to my original values call shr_file_setLogUnit (shrlogunit) diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index d466c2215..45f60ccf1 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -35,6 +35,7 @@ module ice_import_export use icepack_intfc , only : icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc , only : icepack_query_parameters, icepack_query_tracer_flags use icepack_intfc , only : icepack_liquidus_temperature + use icepack_intfc , only : icepack_sea_freezing_temperature use cice_wrapper_mod , only : t_startf, t_stopf, t_barrierf #ifdef CESMCOUPLED use shr_frz_mod , only : shr_frz_freezetemp @@ -253,8 +254,8 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam if (flds_wiso) then call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_fresh_water_to_ocean_rate_wiso', & ungridded_lbound=1, ungridded_ubound=3) - !call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_evap_rate_atm_into_ice_wiso', & - ! ungridded_lbound=1, ungridded_ubound=3) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_evap_rate_atm_into_ice_wiso', & + ungridded_lbound=1, ungridded_ubound=3) call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_qref_wiso', & ungridded_lbound=1, ungridded_ubound=3) end if @@ -361,12 +362,20 @@ subroutine ice_import( importState, rc ) real (kind=dbl_kind),allocatable :: aflds(:,:,:,:) real (kind=dbl_kind) :: workx, worky real (kind=dbl_kind) :: MIN_RAIN_TEMP, MAX_SNOW_TEMP - real (kind=dbl_kind) :: tffresh + real (kind=dbl_kind) :: Tffresh real (kind=dbl_kind) :: inst_pres_height_lowest + character(len=char_len) :: tfrz_option + integer(int_kind) :: ktherm character(len=*), parameter :: subname = 'ice_import' + character(len=1024) :: msgString !----------------------------------------------------- call icepack_query_parameters(Tffresh_out=Tffresh) + call icepack_query_parameters(tfrz_option_out=tfrz_option) + call icepack_query_parameters(ktherm_out=ktherm) + write(msgString,'(A,i8)')trim(subname)//' tfrz_option = ' & + // trim(tfrz_option)//', ktherm = ',ktherm + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) ! call icepack_query_parameters(tfrz_option_out=tfrz_option, & ! modal_aero_out=modal_aero, z_tracers_out=z_tracers, skl_bgc_out=skl_bgc, & ! Tffresh_out=Tffresh) @@ -693,8 +702,7 @@ subroutine ice_import( importState, rc ) do iblk = 1, nblocks do j = 1,ny_block do i = 1,nx_block - !TODO: tcx should this be icepack_sea_freezing_temperature? - Tf (i,j,iblk) = icepack_liquidus_temperature(sss(i,j,iblk)) + Tf(i,j,iblk) = icepack_sea_freezing_temperature(sss(i,j,iblk)) end do end do end do @@ -769,7 +777,7 @@ subroutine ice_export( exportState, rc ) real (kind=dbl_kind) :: tauyo (nx_block,ny_block,max_blocks) ! ice/ocean stress real (kind=dbl_kind) :: ailohi(nx_block,ny_block,max_blocks) ! fractional ice area real (kind=dbl_kind), allocatable :: tempfld(:,:,:) - real (kind=dbl_kind) :: tffresh + real (kind=dbl_kind) :: Tffresh character(len=*),parameter :: subname = 'ice_export' !----------------------------------------------------- @@ -903,7 +911,6 @@ subroutine ice_export( exportState, rc ) ! ---- ! surface temperature of ice covered portion (degK) - !call state_setexport(exportState, 'sea_ice_temperature', input=Tsrf , lmask=tmask, ifrac=ailohi, rc=rc) call state_setexport(exportState, 'sea_ice_surface_temperature', input=Tsrf , lmask=tmask, ifrac=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/configuration/scripts/forapps/ufs/comp_ice.backend.clean b/configuration/scripts/forapps/ufs/comp_ice.backend.clean index 7eef2ed1a..823f1f586 100755 --- a/configuration/scripts/forapps/ufs/comp_ice.backend.clean +++ b/configuration/scripts/forapps/ufs/comp_ice.backend.clean @@ -10,10 +10,10 @@ setenv OBJDIR $EXEDIR/compile ; if !(-d $OBJDIR) mkdir -p $OBJDIR if (${SITE} =~ cheyenne*) then setenv ARCH cheyenne_intel -#else if (${SITE} =~ Orion*) then -# setenv ARCH orion_intel -#else if (${SITE} =~ hera*) then -# setenv ARCH hera_intel +else if (${SITE} =~ orion*) then + setenv ARCH orion_intel +else if (${SITE} =~ hera*) then + setenv ARCH hera_intel else echo "CICE6 ${0}: ERROR in ARCH setup, ${hname}" exit -2 diff --git a/configuration/scripts/forapps/ufs/comp_ice.backend.libcice b/configuration/scripts/forapps/ufs/comp_ice.backend.libcice index ca718548a..ea38e048b 100755 --- a/configuration/scripts/forapps/ufs/comp_ice.backend.libcice +++ b/configuration/scripts/forapps/ufs/comp_ice.backend.libcice @@ -18,7 +18,7 @@ setenv THRD no # set to yes for OpenMP threading if (${SITE} =~ cheyenne*) then setenv ARCH cheyenne_intel -else if (${SITE} =~ Orion*) then +else if (${SITE} =~ orion*) then setenv ARCH orion_intel else if (${SITE} =~ hera*) then setenv ARCH hera_intel @@ -57,10 +57,10 @@ if !($?IO_TYPE) then endif if ($IO_TYPE == 'netcdf3' || $IO_TYPE == 'netcdf4') then setenv IODIR io_netcdf - setenv ICE_CPPDEFS "${ICE_CPPDEFS} -Dncdf" + setenv ICE_CPPDEFS "${ICE_CPPDEFS} -DUSE_NETCDF" else if ($IO_TYPE == 'pio') then setenv IODIR io_pio - setenv ICE_CPPDEFS "${ICE_CPPDEFS} -Dncdf" + setenv ICE_CPPDEFS "${ICE_CPPDEFS} -DUSE_NETCDF" else setenv IODIR io_binary endif @@ -68,9 +68,11 @@ endif # Build in debug mode. If DEBUG=Y, enable DEBUG compilation. This # flag is set in ${ROOTDIR}/coupledFV3_MOM6_CICE_debug.appBuilder file. if (! $?DEBUG) then - setenv ICE_BLDDEBUG true + setenv ICE_BLDDEBUG false else - if ($DEBUG != "Y") then + if ($DEBUG == "Y") then + setenv ICE_BLDDEBUG true + else setenv ICE_BLDDEBUG false endif endif diff --git a/configuration/scripts/machines/Macros.cheyenne_intel b/configuration/scripts/machines/Macros.cheyenne_intel index 902224766..243295487 100644 --- a/configuration/scripts/machines/Macros.cheyenne_intel +++ b/configuration/scripts/machines/Macros.cheyenne_intel @@ -12,7 +12,7 @@ FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -trace FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) - FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created + FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -link_mpi=dbg else FFLAGS += -O2 endif diff --git a/configuration/scripts/machines/Macros.hera_intel b/configuration/scripts/machines/Macros.hera_intel index 519e3a5ba..230f43e70 100644 --- a/configuration/scripts/machines/Macros.hera_intel +++ b/configuration/scripts/machines/Macros.hera_intel @@ -12,7 +12,7 @@ FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -trace FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) - FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created + FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -link_mpi=dbg else FFLAGS += -O2 endif diff --git a/configuration/scripts/machines/Macros.orion_intel b/configuration/scripts/machines/Macros.orion_intel index aae839f4e..6dffdd0a2 100644 --- a/configuration/scripts/machines/Macros.orion_intel +++ b/configuration/scripts/machines/Macros.orion_intel @@ -12,7 +12,7 @@ FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -trace FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) - FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created + FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -link_mpi=dbg else FFLAGS += -O2 endif From 1802396b399eb5c8f87cd4ea9c6f874dc9628229 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 6 Aug 2020 16:20:09 -0400 Subject: [PATCH 21/51] fixes for dbug_flag --- cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 17 +++++++++++++---- .../drivers/nuopc/cmeps/ice_import_export.F90 | 14 ++++++++------ 2 files changed, 21 insertions(+), 10 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index 9f5d4ec27..da3d95369 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -86,7 +86,7 @@ module ice_comp_nuopc character(len=*),parameter :: shr_cal_noleap = 'NO_LEAP' character(len=*),parameter :: shr_cal_gregorian = 'GREGORIAN' - integer , parameter :: dbug = 10 + integer :: dbug = 0 integer , parameter :: debug_import = 0 ! internal debug level integer , parameter :: debug_export = 0 ! internal debug level character(*), parameter :: modName = "(ice_comp_nuopc)" @@ -236,6 +236,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif + call NUOPC_CompAttributeGet(gcomp, name='dbug_flag', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) dbug + end if + write(logmsg,'(i6)') dbug + call ESMF_LogWrite('CICE_cap: dbug = '//trim(logmsg), ESMF_LOGMSG_INFO) + call ice_advertise_fields(gcomp, importState, exportState, flds_scalar_name, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -877,7 +885,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! diagnostics !-------------------------------- - if (dbug > 1) then + if (dbug > 0) then call state_diagnose(exportState,subname//':ES',rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -957,6 +965,7 @@ subroutine ModelAdvance(gcomp, rc) preString="--------------------------------> to: ", unit=msgString, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + !-------------------------------- ! Turn on timers !-------------------------------- @@ -1074,7 +1083,7 @@ subroutine ModelAdvance(gcomp, rc) idate, sec, nu_diag, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (dbug > 1) then + if (dbug > 0) then call state_diagnose(importState,subname//':IS',rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -1101,7 +1110,7 @@ subroutine ModelAdvance(gcomp, rc) idate, sec, nu_diag, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (dbug > 1) then + if (dbug > 0) then call state_diagnose(exportState,subname//':ES',rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index 45f60ccf1..29af8e941 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -88,7 +88,7 @@ module ice_import_export type (fld_list_type) :: fldsFrIce(fldsMax) type(ESMF_GeomType_Flag) :: geomtype - integer , parameter :: dbug = 10 ! i/o debug messages + integer , parameter :: io_dbug = 10 ! i/o debug messages character(*), parameter :: u_FILE_u = & __FILE__ @@ -116,7 +116,7 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + if (io_dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! Determine if the following attributes are sent by the driver and if so read them in flds_wiso = .false. @@ -266,7 +266,7 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam if (ChkErr(rc,__LINE__,u_FILE_u)) return enddo - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + if (io_dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine ice_advertise_fields @@ -373,9 +373,11 @@ subroutine ice_import( importState, rc ) call icepack_query_parameters(Tffresh_out=Tffresh) call icepack_query_parameters(tfrz_option_out=tfrz_option) call icepack_query_parameters(ktherm_out=ktherm) - write(msgString,'(A,i8)')trim(subname)//' tfrz_option = ' & + if (io_dbug > 5) then + write(msgString,'(A,i8)')trim(subname)//' tfrz_option = ' & // trim(tfrz_option)//', ktherm = ',ktherm - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + end if ! call icepack_query_parameters(tfrz_option_out=tfrz_option, & ! modal_aero_out=modal_aero, z_tracers_out=z_tracers, skl_bgc_out=skl_bgc, & ! Tffresh_out=Tffresh) @@ -782,7 +784,7 @@ subroutine ice_export( exportState, rc ) !----------------------------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + if (io_dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) call icepack_query_parameters(Tffresh_out=Tffresh) ! call icepack_query_parameters(tfrz_option_out=tfrz_option, & From 1cf95cfcc7eba0ca77fecaabe8f0bd8c97c95aa0 Mon Sep 17 00:00:00 2001 From: David Bailey Date: Mon, 10 Aug 2020 16:36:38 -0600 Subject: [PATCH 22/51] Update nuopc2 to latest CICE master --- README.md | 10 +- cice.setup | 19 +- cicecore/cicedynB/dynamics/ice_dyn_shared.F90 | 39 ++-- cicecore/cicedynB/general/ice_flux.F90 | 14 ++ cicecore/cicedynB/general/ice_forcing.F90 | 91 +++------ cicecore/cicedynB/general/ice_forcing_bgc.F90 | 24 +-- cicecore/cicedynB/general/ice_init.F90 | 94 ++++++---- cicecore/cicedynB/general/ice_step_mod.F90 | 21 ++- .../comm/mpi/ice_communicate.F90 | 7 + .../comm/mpi/ice_gather_scatter.F90 | 69 +++---- .../infrastructure/comm/mpi/ice_reprosum.F90 | 4 +- .../comm/serial/ice_communicate.F90 | 80 +------- .../comm/serial/ice_reprosum.F90 | 4 +- .../cicedynB/infrastructure/ice_domain.F90 | 24 ++- cicecore/cicedynB/infrastructure/ice_grid.F90 | 34 +++- .../infrastructure/ice_read_write.F90 | 173 +++++++++--------- .../io/io_netcdf/ice_history_write.F90 | 11 +- .../io/io_netcdf/ice_restart.F90 | 39 ++++ .../io/io_pio2/ice_history_write.F90 | 6 - .../infrastructure/io/io_pio2/ice_restart.F90 | 2 +- cicecore/drivers/direct/hadgem3/CICE.F90 | 2 - .../drivers/direct/hadgem3/CICE_FinalMod.F90 | 5 +- .../drivers/direct/hadgem3/CICE_InitMod.F90 | 30 ++- .../drivers/direct/hadgem3/CICE_RunMod.F90 | 20 +- cicecore/drivers/mct/cesm1/CICE_FinalMod.F90 | 5 +- cicecore/drivers/mct/cesm1/CICE_InitMod.F90 | 32 ++-- cicecore/drivers/mct/cesm1/CICE_RunMod.F90 | 23 +-- .../drivers/nuopc/cmeps/ice_import_export.F90 | 48 ++--- cicecore/drivers/nuopc/dmi/CICE.F90 | 2 - cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 | 6 - cicecore/drivers/standalone/cice/CICE.F90 | 2 - .../drivers/standalone/cice/CICE_FinalMod.F90 | 2 - .../drivers/standalone/cice/CICE_InitMod.F90 | 10 - .../drivers/standalone/cice/CICE_RunMod.F90 | 4 - .../standalone/cice/CICE_RunMod.F90_debug | 4 - configuration/scripts/cice.build | 4 +- configuration/scripts/ice_in | 8 + configuration/scripts/options/set_nml.alt03 | 3 + configuration/scripts/options/set_nml.alt04 | 3 + configuration/scripts/parse_namelist.sh | 27 ++- configuration/scripts/parse_settings.sh | 28 +++ configuration/scripts/tests/cice.lcov.csh | 2 +- .../scripts/tests/cice_test_codecov.csh | 4 +- configuration/scripts/tests/io_suite.ts | 5 +- .../scripts/tests/report_results.csh | 2 +- doc/source/cice_index.rst | 1 + doc/source/intro/citing.rst | 26 ++- doc/source/user_guide/ug_case_settings.rst | 64 ++++++- doc/source/user_guide/ug_implementation.rst | 6 + doc/source/user_guide/ug_running.rst | 37 +++- doc/source/user_guide/ug_testing.rst | 6 +- icepack | 2 +- 52 files changed, 655 insertions(+), 533 deletions(-) diff --git a/README.md b/README.md index 0c5940a7a..a584e8ac9 100644 --- a/README.md +++ b/README.md @@ -11,21 +11,19 @@ CICE is a computationally efficient model for simulating the growth, melting, an This repository contains the files and code needed to run the CICE sea ice numerical model starting with version 6. CICE is maintained by the CICE Consortium. Versions prior to v6 are found in the [CICE-svn-trunk repository](https://github.com/CICE-Consortium/CICE-svn-trunk). -CICE consists of a top level driver and dynamical core plus the [Icepack column physics code][icepack], which is included in CICE as a Git submodule. Because Icepack is a submodule of CICE, Icepack and CICE development are handled independently with respect to the GitHub repositories even though development and testing may be done together. +CICE consists of a top level driver and dynamical core plus the [Icepack][icepack] column physics code], which is included in CICE as a Git submodule. Because Icepack is a submodule of CICE, Icepack and CICE development are handled independently with respect to the GitHub repositories even though development and testing may be done together. [icepack]: https://github.com/CICE-Consortium/Icepack -The first point of contact with the CICE Consortium is the [Consortium Community Forum][forum]. +The first point of contact with the CICE Consortium is the Consortium Community [Forum][forum]. This forum is monitored by Consortium members and also opened to the whole community. Please do not use our issue tracker for general support questions. -[doc-resources]: https://github.com/CICE-Consortium/About-Us/wiki/Resource-Index#model-documentation -[doc-running]: https://cice-consortium-cice.readthedocs.io/en/master/user_guide/ug_running.html [forum]: https://xenforo.cgd.ucar.edu/cesm/forums/cice-consortium.146/ If you expect to make any changes to the code, we recommend that you first fork both the CICE and Icepack repositories. In order to incorporate your developments into the Consortium code it is imperative you follow the guidance for Pull Requests and requisite testing. -Head over to our [Contribution guide][contributing] to learn more about how you can help improve CICE. +Head over to our [Contributing][contributing] guide to learn more about how you can help improve CICE. [contributing]: https://github.com/CICE-Consortium/About-Us/wiki/Contributing @@ -34,7 +32,7 @@ Head over to our [Contribution guide][contributing] to learn more about how you Information about the CICE model -* **CICE Version Index**: https://github.com/CICE-Consortium/CICE/wiki/CICE-Version-Index +* **CICE Release Table**: https://github.com/CICE-Consortium/CICE/wiki/CICE-Release-Table Numbered CICE releases since version 6 with associated documentation and DOIs. diff --git a/cice.setup b/cice.setup index 43fdd836c..3efe94827 100755 --- a/cice.setup +++ b/cice.setup @@ -40,6 +40,7 @@ set suitebuild = true set suitereuse = true set suiterun = false set suitesubmit = true +set ignoreuserset = false if ($#argv < 1) then set helpheader = 1 @@ -98,6 +99,7 @@ DESCRIPTION --acct : account number for the batch submission --grid, -g : grid, grid (default = ${grid}) --set, -s : case option setting(s), comma separated (default = " ") + --ignore-user-set: ignore ~/.cice_set if it exists --queue : queue for the batch submission For testing @@ -112,7 +114,7 @@ DESCRIPTION --diff : generate comparison against another case --report : automatically post results when tests are complete --coverage : generate and report test coverage metrics when tests are complete, - requires GNU compiler (ie. normally ``--env gnu``) + requires GNU compiler (ie. normally --env gnu) --setup-only : for suite, setup testcases, no build, no submission --setup-build : for suite, setup and build testcases, no submission --setup-build-run : for suite, setup, build, and run interactively @@ -263,6 +265,10 @@ while (1) set suitesubmit = true shift argv + else if ("$option" == "--ignore-user-set") then + set ignoreuserset = true + shift argv + # arguments with settings else shift argv @@ -412,6 +418,17 @@ set vers = ${ICE_VERSION} set shhash = `echo ${hash} | cut -c 1-10` if ( ${dosuite} == 0 ) then + # grab user defined default sets + if ("${ignoreuserset}" == "false" && -e ~/.cice_set) then + set setsu1 = `cat ~/.cice_set` + # get rid of spaces if they exist! + set setsuser = `echo ${setsu1} | sed 's/ //g'` + if ( ${sets} == "" ) then + set sets = "${setsuser}" + else + set sets = "${setsuser},${sets}" + endif + endif set teststring = "${test} ${grid} ${pesx} ${sets}" if ( $bfbcomp != ${spval} ) then if ( ${sets} == "" ) then diff --git a/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 b/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 index df50dd99e..c3dc83a24 100644 --- a/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 +++ b/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 @@ -35,10 +35,11 @@ module ice_dyn_shared ndte ! number of subcycles: ndte=dt/dte character (len=char_len), public :: & - coriolis ! 'constant', 'zero', or 'latitude' + coriolis , & ! 'constant', 'zero', or 'latitude' + ssh_stress ! 'geostrophic' or 'coupled' logical (kind=log_kind), public :: & - revised_evp ! if true, use revised evp procedure + revised_evp ! if true, use revised evp procedure integer (kind=int_kind), public :: & kevp_kernel ! 0 = 2D org version @@ -475,9 +476,7 @@ subroutine dyn_prep2 (nx_block, ny_block, & integer (kind=int_kind) :: & i, j, ij -#ifdef coupled real (kind=dbl_kind) :: gravit -#endif logical (kind=log_kind), dimension(nx_block,ny_block) :: & iceumask_old ! old-time iceumask @@ -577,12 +576,12 @@ subroutine dyn_prep2 (nx_block, ny_block, & ! Define variables for momentum equation !----------------------------------------------------------------- -#ifdef coupled - call icepack_query_parameters(gravit_out=gravit) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) -#endif + if (trim(ssh_stress) == 'coupled') then + call icepack_query_parameters(gravit_out=gravit) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + endif do ij = 1, icellu i = indxui(ij) @@ -597,14 +596,18 @@ subroutine dyn_prep2 (nx_block, ny_block, & watery(i,j) = vocn(i,j)*cosw + uocn(i,j)*sinw*sign(c1,fm(i,j)) ! combine tilt with wind stress -#ifndef coupled - ! calculate tilt from geostrophic currents if needed - strtltx(i,j) = -fm(i,j)*vocn(i,j) - strtlty(i,j) = fm(i,j)*uocn(i,j) -#else - strtltx(i,j) = -gravit*umass(i,j)*ss_tltx(i,j) - strtlty(i,j) = -gravit*umass(i,j)*ss_tlty(i,j) -#endif + if (trim(ssh_stress) == 'geostrophic') then + ! calculate tilt from geostrophic currents if needed + strtltx(i,j) = -fm(i,j)*vocn(i,j) + strtlty(i,j) = fm(i,j)*uocn(i,j) + elseif (trim(ssh_stress) == 'coupled') then + strtltx(i,j) = -gravit*umass(i,j)*ss_tltx(i,j) + strtlty(i,j) = -gravit*umass(i,j)*ss_tlty(i,j) + else + call abort_ice(subname//' ERROR: unknown ssh_stress='//trim(ssh_stress), & + file=__FILE__, line=__LINE__) + endif + forcex(i,j) = strairx(i,j) + strtltx(i,j) forcey(i,j) = strairy(i,j) + strtlty(i,j) enddo diff --git a/cicecore/cicedynB/general/ice_flux.F90 b/cicecore/cicedynB/general/ice_flux.F90 index 16abbe162..97b726fdb 100644 --- a/cicecore/cicedynB/general/ice_flux.F90 +++ b/cicecore/cicedynB/general/ice_flux.F90 @@ -311,6 +311,11 @@ module ice_flux fresh_da, & ! fresh water flux to ocean due to data assim (kg/m^2/s) fsalt_da ! salt flux to ocean due to data assimilation(kg/m^2/s) + real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & + fswthrun_ai ! per-category fswthru * ai (W/m^2) + + logical (kind=log_kind), public :: send_i2x_per_cat = .false. + !----------------------------------------------------------------- ! internal !----------------------------------------------------------------- @@ -713,6 +718,11 @@ subroutine init_coupler_flux ffep (:,:,:,:)= c0 ffed (:,:,:,:)= c0 + if (send_i2x_per_cat) then + allocate(fswthrun_ai(nx_block,ny_block,ncat,max_blocks)) + fswthrun_ai(:,:,:,:) = c0 + endif + !----------------------------------------------------------------- ! derived or computed fields !----------------------------------------------------------------- @@ -806,6 +816,10 @@ subroutine init_flux_ocn H2_16O_ocn (:,:,:) = c0 H2_18O_ocn (:,:,:) = c0 + if (send_i2x_per_cat) then + fswthrun_ai(:,:,:,:) = c0 + endif + end subroutine init_flux_ocn !======================================================================= diff --git a/cicecore/cicedynB/general/ice_forcing.F90 b/cicecore/cicedynB/general/ice_forcing.F90 index 66a7d9ef3..4c88037ed 100755 --- a/cicecore/cicedynB/general/ice_forcing.F90 +++ b/cicecore/cicedynB/general/ice_forcing.F90 @@ -1,3 +1,6 @@ +#ifdef ncdf +#define USE_NETCDF +#endif !======================================================================= ! ! Reads and interpolates forcing data for atmosphere and ocean quantities. @@ -300,9 +303,6 @@ subroutine init_forcing_ocn(dt) use ice_domain, only: nblocks use ice_domain_size, only: max_blocks use ice_flux, only: sss, sst, Tf -#ifdef ncdf - use netcdf -#endif real (kind=dbl_kind), intent(in) :: & dt ! time step @@ -866,7 +866,6 @@ subroutine read_data_nc (flag, recd, yr, ixm, ixx, ixp, & character(len=*), parameter :: subname = '(read_data_nc)' -#ifdef ncdf integer (kind=int_kind) :: & nrec , & ! record number to read n2, n4 , & ! like ixm and ixp, but @@ -967,9 +966,6 @@ subroutine read_data_nc (flag, recd, yr, ixm, ixx, ixp, & call ice_timer_stop(timer_readwrite) ! reading/writing -#else - field_data = c0 ! to satisfy intent(out) attribute -#endif end subroutine read_data_nc !======================================================================= @@ -1007,7 +1003,6 @@ subroutine read_data_nc_hycom (flag, recd, & intent(out) :: & field_data ! 2 values needed for interpolation -#ifdef ncdf ! local variables integer (kind=int_kind) :: & fid ! file id for netCDF routines @@ -1040,11 +1035,6 @@ subroutine read_data_nc_hycom (flag, recd, & call ice_timer_stop(timer_readwrite) ! reading/writing -#else - field_data = c0 ! to satisfy intent(out) attribute - write(*,*)'ERROR: CICE not compiled with NetCDF' - stop -#endif end subroutine read_data_nc_hycom !======================================================================= @@ -3342,9 +3332,6 @@ subroutine oned_data use ice_flux, only: uatm, vatm, Tair, fsw, fsnow, Qa, rhoa, frain -#ifdef ncdf - use netcdf - ! local parameters character (char_len_long) :: & @@ -3402,7 +3389,7 @@ subroutine oned_data Temp = work Tair(:,:,:) = Temp - if (my_task == master_task) status = nf90_close(fid) + call ice_close_nc(fid) ! hourly solar data beginning Jan 1, 1989, 01:00 met_file = fsw_file @@ -3412,7 +3399,7 @@ subroutine oned_data call ice_read_nc(fid,istep1,fieldname,work,diag) fsw(:,:,:) = work - if (my_task == master_task) status = nf90_close(fid) + call ice_close_nc(fid) ! hourly interpolated monthly data beginning Jan 1, 1989, 01:00 met_file = humid_file @@ -3426,7 +3413,7 @@ subroutine oned_data call ice_read_nc(fid,istep1,fieldname,work,diag) fsnow(:,:,:) = work - if (my_task == master_task) status = nf90_close(fid) + call ice_close_nc(fid) !------------------------------------------------------------------- ! Find specific humidity using Hyland-Wexler formulation @@ -3447,8 +3434,6 @@ subroutine oned_data cldf (:,:,:) = p25 ! cloud fraction frain(:,:,:) = c0 ! this is available in hourlymet_rh file -#endif - end subroutine oned_data !======================================================================= @@ -3648,7 +3633,7 @@ subroutine ocn_data_ncar_init use ice_blocks, only: nx_block, ny_block use ice_domain_size, only: max_blocks -#ifdef ncdf +#ifdef USE_NETCDF use netcdf #endif @@ -3664,7 +3649,6 @@ subroutine ocn_data_ncar_init 'T', 'S', 'hblt', 'U', 'V', & 'dhdx', 'dhdy', 'qdp' / -#ifdef ncdf integer (kind=int_kind) :: & fid , & ! file id dimid ! dimension id @@ -3673,7 +3657,6 @@ subroutine ocn_data_ncar_init status , & ! status flag nlat , & ! number of longitudes of data nlon ! number of latitudes of data -#endif real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: & work1 @@ -3701,7 +3684,7 @@ subroutine ocn_data_ncar_init endif ! master_task if (trim(ocn_data_format) == 'nc') then -#ifdef ncdf +#ifdef USE_NETCDF if (my_task == master_task) then call ice_open_nc(sst_file, fid) @@ -3741,7 +3724,10 @@ subroutine ocn_data_ncar_init enddo ! month loop enddo ! field loop - if (my_task == master_task) status = nf90_close(fid) + if (my_task == master_task) call ice_close_nc(fid) +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined for '//trim(sst_file), & + file=__FILE__, line=__LINE__) #endif else ! binary format @@ -3803,11 +3789,11 @@ subroutine ocn_data_ncar_init_3D use ice_domain_size, only: max_blocks use ice_grid, only: to_ugrid, ANGLET use ice_read_write, only: ice_read_nc_uv -#ifdef ncdf +#ifdef USE_NETCDF use netcdf #endif -#ifdef ncdf +#ifdef USE_NETCDF integer (kind=int_kind) :: & n , & ! field index m , & ! month index @@ -3856,7 +3842,7 @@ subroutine ocn_data_ncar_init_3D endif ! master_task if (trim(ocn_data_format) == 'nc') then -#ifdef ncdf +#ifdef USE_NETCDF if (my_task == master_task) then call ice_open_nc(sst_file, fid) @@ -3902,7 +3888,7 @@ subroutine ocn_data_ncar_init_3D enddo ! month loop enddo ! field loop - if (my_task == master_task) status = nf90_close(fid) + if (my_task == master_task) call ice_close_nc(fid) ! Rotate vector quantities and shift to U-grid do n=4,6,2 @@ -3923,6 +3909,9 @@ subroutine ocn_data_ncar_init_3D enddo ! month loop enddo ! field loop +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) #endif else ! binary format @@ -4327,9 +4316,6 @@ subroutine ocn_data_hycom_init use ice_blocks, only: nx_block, ny_block use ice_domain, only: nblocks use ice_flux, only: sss, sst, Tf -#ifdef ncdf - use netcdf -#endif integer (kind=int_kind) :: & i, j, iblk , & ! horizontal indices @@ -4611,7 +4597,6 @@ subroutine read_data_nc_point (flag, recd, yr, ixm, ixx, ixp, & character(len=*), parameter :: subname = '(read_data_nc_point)' -#ifdef ncdf integer (kind=int_kind) :: & nrec , & ! record number to read n2, n4 , & ! like ixm and ixp, but @@ -4723,9 +4708,6 @@ subroutine read_data_nc_point (flag, recd, yr, ixm, ixx, ixp, & call ice_timer_stop(timer_readwrite) ! reading/writing -#else - field_data = c0 ! to satisfy intent(out) attribute -#endif end subroutine read_data_nc_point !======================================================================= @@ -4779,13 +4761,9 @@ subroutine ISPOL_data ! use ice_flux, only: uatm, vatm, Tair, fsw, Qa, rhoa, & frain, fsnow, flw -#ifdef ncdf - use netcdf -#endif !local parameters -#ifdef ncdf character (char_len_long) :: & met_file, & ! netcdf filename fieldname ! field name in netcdf file @@ -4822,7 +4800,6 @@ subroutine ISPOL_data sec1hr ! number of seconds in 1 hour logical (kind=log_kind) :: read1 -#endif integer (kind=int_kind) :: & recnum , & ! record number @@ -4830,7 +4807,6 @@ subroutine ISPOL_data character(len=*), parameter :: subname = '(ISPOL_data)' -#ifdef ncdf call icepack_query_parameters(secday_out=secday) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -4965,14 +4941,6 @@ subroutine ISPOL_data flw(:,:,:) = c1intp * flw_data_p(1) & + c2intp * flw_data_p(2) endif !nc -#else - - uatm(:,:,:) = c0 !wind velocity (m/s) - vatm(:,:,:) = c0 - fsw(:,:,:) = c0 - fsnow (:,:,:) = c0 - -#endif !flw given cldf and Tair calculated in prepare_forcing @@ -5015,11 +4983,7 @@ subroutine ocn_data_ispol_init ! use ice_gather_scatter use ice_read_write -#ifdef ncdf - use netcdf -#endif -#ifdef ncdf integer (kind=int_kind) :: & n , & ! field index m ! month index @@ -5038,7 +5002,6 @@ subroutine ocn_data_ispol_init integer (kind=int_kind) :: & status ! status flag -#endif character(len=*), parameter :: subname = '(ocn_data_ispol_init)' @@ -5058,7 +5021,6 @@ subroutine ocn_data_ispol_init endif ! master_task if (trim(ocn_data_format) == 'nc') then -#ifdef ncdf if (my_task == master_task) then call ice_open_nc(sst_file, fid) endif ! master_task @@ -5078,8 +5040,7 @@ subroutine ocn_data_ispol_init enddo ! month loop enddo ! field loop - if (my_task == master_task) status = nf90_close(fid) -#endif + if (my_task == master_task) call ice_close_nc(fid) else ! binary format call abort_ice (error_message=subname//'new ocean forcing is netcdf only', & @@ -5188,9 +5149,6 @@ subroutine get_wave_spec use ice_constants, only: c0 use ice_domain_size, only: nfreq use ice_timers, only: ice_timer_start, ice_timer_stop, timer_fsd -#ifdef ncdf - use netcdf -#endif ! local variables integer (kind=int_kind) :: & @@ -5228,16 +5186,19 @@ subroutine get_wave_spec ! read more realistic data from a file if ((trim(wave_spec_type) == 'constant').OR.(trim(wave_spec_type) == 'random')) then if (trim(wave_spec_file(1:4)) == 'unkn') then - call abort_ice (subname//'ERROR: wave_spec_file '//trim(wave_spec_file)) + call abort_ice (subname//'ERROR: wave_spec_file '//trim(wave_spec_file), & + file=__FILE__, line=__LINE__) else -#ifdef ncdf +#ifdef USE_NETCDF call ice_open_nc(wave_spec_file,fid) call ice_read_nc_xyf (fid, 1, 'efreq', wave_spectrum(:,:,:,:), dbug, & field_loc_center, field_type_scalar) call ice_close_nc(fid) #else - write (nu_diag,*) "wave spectrum file not available, requires ncdf" + write (nu_diag,*) "wave spectrum file not available, requires cpp USE_NETCDF" write (nu_diag,*) "wave spectrum file not available, using default profile" + call abort_ice (subname//'ERROR: wave_spec_file '//trim(wave_spec_file), & + file=__FILE__, line=__LINE__) #endif endif endif diff --git a/cicecore/cicedynB/general/ice_forcing_bgc.F90 b/cicecore/cicedynB/general/ice_forcing_bgc.F90 index 4eedcfb80..e5ef851fa 100644 --- a/cicecore/cicedynB/general/ice_forcing_bgc.F90 +++ b/cicecore/cicedynB/general/ice_forcing_bgc.F90 @@ -1,3 +1,6 @@ +#ifdef ncdf +#define USE_NETCDF +#endif !======================================================================= ! ! Reads and interpolates forcing data for biogeochemistry @@ -587,7 +590,6 @@ subroutine faero_data use ice_flux_bgc, only: faero_atm use ice_forcing, only: interp_coeff_monthly, read_clim_data_nc, interpolate_data -#ifdef ncdf ! local parameters real (kind=dbl_kind), dimension(:,:,:,:), allocatable, & @@ -672,7 +674,6 @@ subroutine faero_data where (faero_atm(:,:,:,:) > 1.e20) faero_atm(:,:,:,:) = c0 deallocate( aero1_data, aero2_data, aero3_data ) -#endif end subroutine faero_data @@ -688,7 +689,6 @@ subroutine fzaero_data use ice_flux_bgc, only: faero_atm use ice_forcing, only: interp_coeff_monthly, read_clim_data_nc, interpolate_data -#ifdef ncdf ! local parameters real (kind=dbl_kind), dimension(:,:,:,:), allocatable, & @@ -766,7 +766,6 @@ subroutine fzaero_data where (faero_atm(:,:,nlt_zaero(1),:) > 1.e20) faero_atm(:,:,nlt_zaero(1),:) = c0 deallocate( aero_data ) -#endif end subroutine fzaero_data @@ -780,10 +779,6 @@ subroutine init_bgc_data (fed1,fep1) use ice_read_write, only: ice_open_nc, ice_read_nc, ice_close_nc -#ifdef ncdf - use netcdf -#endif - real (kind=dbl_kind), dimension(nx_block, ny_block, max_blocks), intent(inout) :: & fed1, & ! first dissolved iron pool (nM) fep1 ! first particulate iron pool (nM) @@ -868,7 +863,7 @@ subroutine faero_optics gaer_bc_tab, & ! BC aerosol asymmetry parameter (cos(theta)) bcenh ! BC absorption enhancement facto -#ifdef ncdf +#ifdef USE_NETCDF use netcdf #endif @@ -876,7 +871,6 @@ subroutine faero_optics logical (kind=log_kind) :: modal_aero -#ifdef ncdf integer (kind=int_kind) :: & varid , & ! variable id status , & ! status output from netcdf routines @@ -891,7 +885,6 @@ subroutine faero_optics character (char_len_long) :: & optics_file, & ! netcdf filename fieldname ! field name in netcdf file -#endif character(len=*), parameter :: subname = '(faero_optics)' @@ -968,8 +961,8 @@ subroutine faero_optics if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) -#ifdef ncdf if (modal_aero) then +#ifdef USE_NETCDF optics_file = & '/usr/projects/climate/njeffery/DATA/CAM/snicar/snicar_optics_5bnd_mam_c140303.nc' @@ -1004,12 +997,11 @@ subroutine faero_optics call broadcast_array(bcenh(n,:,k), master_task) enddo enddo - endif ! modal_aero #else - if (modal_aero) then - call abort_ice(subname//'ERROR: netcdf required for modal_aero') - endif + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) #endif + endif ! modal_aero end subroutine faero_optics diff --git a/cicecore/cicedynB/general/ice_init.F90 b/cicecore/cicedynB/general/ice_init.F90 index 91c5d539d..4e1e953de 100644 --- a/cicecore/cicedynB/general/ice_init.F90 +++ b/cicecore/cicedynB/general/ice_init.F90 @@ -59,7 +59,7 @@ subroutine input_data use ice_broadcast, only: broadcast_scalar, broadcast_array use ice_diagnostics, only: diag_file, print_global, print_points, latpnt, lonpnt - use ice_domain, only: close_boundaries, ns_boundary_type + use ice_domain, only: close_boundaries, ns_boundary_type, orca_halogrid use ice_domain_size, only: ncat, nilyr, nslyr, nblyr, nfsd, nfreq, & n_iso, n_aero, n_zaero, n_algae, & n_doc, n_dic, n_don, n_fed, n_fep, & @@ -92,12 +92,13 @@ subroutine input_data use ice_arrays_column, only: bgc_data_dir, fe_data_type use ice_grid, only: grid_file, gridcpl_file, kmt_file, & bathymetry_file, use_bathymetry, & + bathymetry_format, & grid_type, grid_format, & dxrect, dyrect use ice_dyn_shared, only: ndte, kdyn, revised_evp, yield_curve, & kevp_kernel, & basalstress, k1, k2, alphab, threshold_hw, & - Ktens, e_ratio, coriolis, & + Ktens, e_ratio, coriolis, ssh_stress, & kridge, ktransport, brlx, arlx use ice_transport_driver, only: advection, conserv_check use ice_restoring, only: restore_ice @@ -117,7 +118,8 @@ subroutine input_data ahmax, R_ice, R_pnd, R_snw, dT_mlt, rsnw_mlt, emissivity, & mu_rdg, hs0, dpscale, rfracmin, rfracmax, pndaspect, hs1, hp1, & a_rapid_mode, Rac_rapid_mode, aspect_rapid_mode, dSdt_slow_mode, & - phi_c_slow_mode, phi_i_mushy, kalg, atmiter_conv, Pstar, Cstar + phi_c_slow_mode, phi_i_mushy, kalg, atmiter_conv, Pstar, Cstar, & + sw_frac, sw_dtemp integer (kind=int_kind) :: ktherm, kstrength, krdg_partic, krdg_redist, natmiter, & kitd, kcatbound @@ -125,7 +127,8 @@ subroutine input_data character (len=char_len) :: shortwave, albedo_type, conduct, fbot_xfer_type, & tfrz_option, frzpnd, atmbndy, wave_spec_type - logical (kind=log_kind) :: calc_Tsfc, formdrag, highfreq, calc_strair, wave_spec + logical (kind=log_kind) :: calc_Tsfc, formdrag, highfreq, calc_strair, wave_spec, & + sw_redist logical (kind=log_kind) :: tr_iage, tr_FY, tr_lvl, tr_pond logical (kind=log_kind) :: tr_iso, tr_aero, tr_fsd @@ -161,10 +164,10 @@ subroutine input_data namelist /grid_nml/ & grid_format, grid_type, grid_file, kmt_file, & - bathymetry_file, use_bathymetry, nfsd, & + bathymetry_file, use_bathymetry, nfsd, bathymetry_format, & ncat, nilyr, nslyr, nblyr, & kcatbound, gridcpl_file, dxrect, dyrect, & - close_boundaries + close_boundaries, orca_halogrid namelist /tracer_nml/ & tr_iage, restart_age, & @@ -182,12 +185,13 @@ subroutine input_data namelist /thermo_nml/ & kitd, ktherm, conduct, ksno, & a_rapid_mode, Rac_rapid_mode, aspect_rapid_mode, & - dSdt_slow_mode, phi_c_slow_mode, phi_i_mushy + dSdt_slow_mode, phi_c_slow_mode, phi_i_mushy, & + sw_redist, sw_frac, sw_dtemp namelist /dynamics_nml/ & kdyn, ndte, revised_evp, yield_curve, & kevp_kernel, & - brlx, arlx, & + brlx, arlx, ssh_stress, & advection, coriolis, kridge, ktransport, & kstrength, krdg_partic, krdg_redist, mu_rdg, & e_ratio, Ktens, Cf, basalstress, & @@ -213,7 +217,7 @@ subroutine input_data oceanmixed_ice, restore_ice, restore_ocn, trestore, & precip_units, default_season, wave_spec_type,nfreq, & atm_data_type, ocn_data_type, bgc_data_type, fe_data_type, & - ice_data_type, wave_spec_file, & + ice_data_type, wave_spec_file, restart_coszen, & fyear_init, ycycle, & atm_data_dir, ocn_data_dir, bgc_data_dir, & atm_data_format, ocn_data_format, rotate_wind, & @@ -280,8 +284,10 @@ subroutine input_data grid_type = 'rectangular' ! define rectangular grid internally grid_file = 'unknown_grid_file' gridcpl_file = 'unknown_gridcpl_file' - bathymetry_file = 'unknown_bathymetry_file' - use_bathymetry = .false. + orca_halogrid = .false. ! orca haloed grid + bathymetry_file = 'unknown_bathymetry_file' + bathymetry_format = 'default' + use_bathymetry = .false. kmt_file = 'unknown_kmt_file' version_name = 'unknown_version_name' ncat = 0 ! number of ice thickness categories @@ -325,6 +331,7 @@ subroutine input_data ktherm = 1 ! -1 = OFF, 0 = 0-layer, 1 = BL99, 2 = mushy thermo conduct = 'bubbly' ! 'MU71' or 'bubbly' (Pringle et al 2007) coriolis = 'latitude' ! latitude dependent, or 'constant' + ssh_stress = 'geostrophic' ! 'geostrophic' or 'coupled' kridge = 1 ! -1 = off, 1 = on ktransport = 1 ! -1 = off, 1 = on calc_Tsfc = .true. ! calculate surface temperature @@ -436,6 +443,11 @@ subroutine input_data phi_c_slow_mode = 0.05_dbl_kind ! critical liquid fraction porosity cutoff phi_i_mushy = 0.85_dbl_kind ! liquid fraction of congelation ice + ! shortwave redistribution in the thermodynamics + sw_redist = .false. + sw_frac = 0.9_dbl_kind + sw_dtemp = 0.02_dbl_kind + !----------------------------------------------------------------- ! read from input file !----------------------------------------------------------------- @@ -578,7 +590,9 @@ subroutine input_data call broadcast_scalar(grid_type, master_task) call broadcast_scalar(grid_file, master_task) call broadcast_scalar(gridcpl_file, master_task) + call broadcast_scalar(orca_halogrid, master_task) call broadcast_scalar(bathymetry_file, master_task) + call broadcast_scalar(bathymetry_format, master_task) call broadcast_scalar(use_bathymetry, master_task) call broadcast_scalar(kmt_file, master_task) call broadcast_scalar(kitd, master_task) @@ -612,6 +626,7 @@ subroutine input_data call broadcast_scalar(albedo_type, master_task) call broadcast_scalar(ktherm, master_task) call broadcast_scalar(coriolis, master_task) + call broadcast_scalar(ssh_stress, master_task) call broadcast_scalar(kridge, master_task) call broadcast_scalar(ktransport, master_task) call broadcast_scalar(conduct, master_task) @@ -717,6 +732,9 @@ subroutine input_data call broadcast_scalar(dSdt_slow_mode, master_task) call broadcast_scalar(phi_c_slow_mode, master_task) call broadcast_scalar(phi_i_mushy, master_task) + call broadcast_scalar(sw_redist, master_task) + call broadcast_scalar(sw_frac, master_task) + call broadcast_scalar(sw_dtemp, master_task) #ifdef CESMCOUPLED pointer_file = trim(pointer_file) // trim(inst_suffix) @@ -778,16 +796,6 @@ subroutine input_data abort_list = trim(abort_list)//":1" endif -#ifndef ncdf - if (grid_format /= 'bin' .or. atm_data_format /= 'bin' .or. ocn_data_format /= 'bin') then - if (my_task == master_task) then - write(nu_diag,*) subname//' ERROR: ncdf CPP flag unset, data formats must be bin' - write(nu_diag,*) subname//' ERROR: check grid_format, atm_data_format, ocn_data_format or set ncdf CPP' - endif - abort_list = trim(abort_list)//":2" - endif -#endif - if (advection /= 'remap' .and. advection /= 'upwind' .and. advection /= 'none') then if (my_task == master_task) write(nu_diag,*) subname//' ERROR: invalid advection=',trim(advection) abort_list = trim(abort_list)//":3" @@ -970,6 +978,12 @@ subroutine input_data endif endif !tcraig + if (ktherm == 1 .and. .not.sw_redist) then + if (my_task == master_task) then + write(nu_diag,*) subname//' WARNING: ktherm = 1 and sw_redist = ',sw_redist + write(nu_diag,*) subname//' WARNING: For consistency, set sw_redist = .true.' + endif + endif if (formdrag) then if (trim(atmbndy) == 'constant') then @@ -1083,6 +1097,7 @@ subroutine input_data tmpstr2 = ' bathymetric input data is not used' endif write(nu_diag,1012) ' use_bathymetry = ', use_bathymetry,trim(tmpstr2) + write(nu_diag,*) ' bathymetry_format= ', trim(bathymetry_format) endif write(nu_diag,1022) ' nilyr = ', nilyr, ' number of ice layers (equal thickness)' write(nu_diag,1022) ' nslyr = ', nslyr, ' number of snow layers (equal thickness)' @@ -1153,6 +1168,13 @@ subroutine input_data endif write(nu_diag,*) 'coriolis = ',trim(coriolis),trim(tmpstr2) + if (trim(ssh_stress) == 'geostrophic') then + tmpstr2 = ': from ocean velocity' + elseif (trim(ssh_stress) == 'coupled') then + tmpstr2 = ': from coupled sea surface height gradients' + endif + write(nu_diag,*) 'ssh_stress = ',trim(ssh_stress),trim(tmpstr2) + if (ktransport == 1) then tmpstr2 = ' transport enabled' if (trim(advection) == 'remap') then @@ -1177,8 +1199,8 @@ subroutine input_data write(nu_diag,1007) ' k2 = ', k2, ' free parameter for landfast ice' write(nu_diag,1007) ' alphab = ', alphab, ' factor for landfast ice' write(nu_diag,1007) ' threshold_hw = ', threshold_hw, ' max water depth for grounding ice' - write(nu_diag,1007) ' Ktens = ', Ktens, ' tensile strength factor' endif + write(nu_diag,1007) ' Ktens = ', Ktens, ' tensile strength factor' endif ! kdyn enabled write(nu_diag,*) ' ' @@ -1240,6 +1262,9 @@ subroutine input_data write(nu_diag,1007) ' ksno = ', ksno,' snow thermal conductivity' if (ktherm == 1) & write(nu_diag,*) 'conduct = ', trim(conduct),' ice thermal conductivity' + write(nu_diag,1012) ' sw_redist = ', sw_redist,' redistribute internal shortwave to surface' + write(nu_diag,1002) ' sw_frac = ', sw_frac,' fraction redistributed' + write(nu_diag,1002) ' sw_dtemp = ', sw_dtemp,' temperature difference from freezing to redistribute' if (ktherm == 2) then write(nu_diag,1002) ' a_rapid_mode = ', a_rapid_mode,' brine channel diameter' write(nu_diag,1007) ' Rac_rapid_mode = ', Rac_rapid_mode,' critical Rayleigh number' @@ -1291,12 +1316,12 @@ subroutine input_data write(nu_diag,1012) ' calc_strair = ', calc_strair,' calculate wind stress and speed' write(nu_diag,1012) ' rotate_wind = ', rotate_wind,' rotate wind/stress to computational grid' write(nu_diag,1012) ' formdrag = ', formdrag,' use form drag parameterization' - if (trim(atmbndy) == 'constant') then + if (trim(atmbndy) == 'default') then tmpstr2 = ': stability-based boundary layer' write(nu_diag,1012) ' highfreq = ', highfreq,' high-frequency atmospheric coupling' write(nu_diag,1022) ' natmiter = ', natmiter,' number of atmo boundary layer iterations' write(nu_diag,1006) ' atmiter_conv = ', atmiter_conv,' convergence criterion for ustar' - elseif (trim(atmbndy) == 'default') then + elseif (trim(atmbndy) == 'constant') then tmpstr2 = ': boundary layer uses bulk transfer coefficients' endif write(nu_diag,*) 'atmbndy = ', trim(atmbndy),trim(tmpstr2) @@ -1310,6 +1335,11 @@ subroutine input_data tmpstr2 = ' ocean mixed layer calculation (SST) disabled' endif write(nu_diag,1012) ' oceanmixed_ice = ', oceanmixed_ice,trim(tmpstr2) + if (oceanmixed_ice) then + write(nu_diag,*) ' WARNING: ocean mixed layer ON' + write(nu_diag,*) ' WARNING: will impact ocean forcing interaction' + write(nu_diag,*) ' WARNING: coupled forcing will be modified by mixed layer routine' + endif if (trim(tfrz_option) == 'minus1p8') then tmpstr2 = ': constant ocean freezing temperature (-1.8C)' elseif (trim(tfrz_option) == 'linear_salt') then @@ -1486,6 +1516,8 @@ subroutine input_data endif write(nu_diag,1010) ' close_boundaries = ', & close_boundaries + write(nu_diag,1010) ' orca_halogrid = ', & + orca_halogrid write(nu_diag,1010) ' conserv_check = ', conserv_check @@ -1538,17 +1570,6 @@ subroutine input_data if (restore_ice .or. restore_ocn) & write(nu_diag,1020) ' trestore = ', trestore -#ifdef coupled - if( oceanmixed_ice ) then - write(nu_diag,*) subname//' WARNING ** WARNING ** WARNING ** WARNING ' - write(nu_diag,*) subname//' WARNING: coupled CPP and oceanmixed_ice namelist are BOTH ON' - write(nu_diag,*) subname//' WARNING: Ocean data received from coupler will' - write(nu_diag,*) subname//' WARNING: be altered by mixed layer routine!' - write(nu_diag,*) subname//' WARNING ** WARNING ** WARNING ** WARNING ' - write(nu_diag,*) ' ' - endif -#endif - write(nu_diag,*) ' ' write(nu_diag,'(a30,2f8.2)') 'Diagnostic point 1: lat, lon =', & latpnt(1), lonpnt(1) @@ -1630,7 +1651,8 @@ subroutine input_data wave_spec_type_in = wave_spec_type, & wave_spec_in=wave_spec, nfreq_in=nfreq, & tfrz_option_in=tfrz_option, kalg_in=kalg, fbot_xfer_type_in=fbot_xfer_type, & - Pstar_in=Pstar, Cstar_in=Cstar) + Pstar_in=Pstar, Cstar_in=Cstar, & + sw_redist_in=sw_redist, sw_frac_in=sw_frac, sw_dtemp_in=sw_dtemp) call icepack_init_tracer_flags(tr_iage_in=tr_iage, tr_FY_in=tr_FY, & tr_lvl_in=tr_lvl, tr_iso_in=tr_iso, tr_aero_in=tr_aero, & tr_fsd_in=tr_fsd, tr_pond_in=tr_pond, & diff --git a/cicecore/cicedynB/general/ice_step_mod.F90 b/cicecore/cicedynB/general/ice_step_mod.F90 index 333c22cd3..7a2493d58 100644 --- a/cicecore/cicedynB/general/ice_step_mod.F90 +++ b/cicecore/cicedynB/general/ice_step_mod.F90 @@ -177,7 +177,8 @@ subroutine step_therm1 (dt, iblk) flat, fswabs, flwout, evap, evaps, evapi, Tref, Qref, Uref, fresh, fsalt, fhocn, & fswthru, fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & meltt, melts, meltb, congel, snoice, & - flatn_f, fsensn_f, fsurfn_f, fcondtopn_f + flatn_f, fsensn_f, fsurfn_f, fcondtopn_f, & + send_i2x_per_cat, fswthrun_ai use ice_flux_bgc, only: dsnown, faero_atm, faero_ocn, fiso_atm, fiso_ocn, & Qa_iso, Qref_iso, fiso_evap, HDO_ocn, H2_16O_ocn, H2_18O_ocn use ice_grid, only: lmask_n, lmask_s, tmask @@ -310,7 +311,8 @@ subroutine step_therm1 (dt, iblk) enddo endif ! tr_aero - if (tmask(i,j,iblk)) & + if (tmask(i,j,iblk)) then + call icepack_step_therm1(dt=dt, ncat=ncat, & nilyr=nilyr, nslyr=nslyr, & aicen_init = aicen_init (i,j,:,iblk), & @@ -452,6 +454,21 @@ subroutine step_therm1 (dt, iblk) frz_onset = frz_onset (i,j, iblk), & yday=yday, prescribed_ice=prescribed_ice) + !----------------------------------------------------------------- + ! handle per-category i2x fields, no merging + !----------------------------------------------------------------- + + if (send_i2x_per_cat) then + do n = 1, ncat + ! TODO (mvertens, 2018-12-22): do we need to add the band separated quantities + ! for MOM6 here also? + + fswthrun_ai(i,j,n,iblk) = fswthrun(i,j,n,iblk)*aicen_init(i,j,n,iblk) + enddo ! ncat + endif + + endif + if (tr_iso) then do n = 1, ncat if (vicen(i,j,n,iblk) > puny) & diff --git a/cicecore/cicedynB/infrastructure/comm/mpi/ice_communicate.F90 b/cicecore/cicedynB/infrastructure/comm/mpi/ice_communicate.F90 index d574ebdfe..a7d186083 100644 --- a/cicecore/cicedynB/infrastructure/comm/mpi/ice_communicate.F90 +++ b/cicecore/cicedynB/infrastructure/comm/mpi/ice_communicate.F90 @@ -45,6 +45,9 @@ module ice_communicate mpitagHalo = 1, &! MPI tags for various mpitag_gs = 1000 ! communication patterns + logical (log_kind), public :: & + add_mpi_barriers = .false. ! turn on mpi barriers for throttling + !*********************************************************************** contains @@ -98,7 +101,11 @@ subroutine init_communicate(mpicom) master_task = 0 call MPI_COMM_RANK (MPI_COMM_ICE, my_task, ierr) +#if (defined NO_R16) + mpiR16 = MPI_REAL8 +#else mpiR16 = MPI_REAL16 +#endif mpiR8 = MPI_REAL8 mpiR4 = MPI_REAL4 diff --git a/cicecore/cicedynB/infrastructure/comm/mpi/ice_gather_scatter.F90 b/cicecore/cicedynB/infrastructure/comm/mpi/ice_gather_scatter.F90 index ba6476904..010a5c8c4 100644 --- a/cicecore/cicedynB/infrastructure/comm/mpi/ice_gather_scatter.F90 +++ b/cicecore/cicedynB/infrastructure/comm/mpi/ice_gather_scatter.F90 @@ -16,7 +16,8 @@ module ice_gather_scatter use mpi ! MPI Fortran module use ice_kinds_mod - use ice_communicate, only: my_task, mpiR8, mpiR4, mpitag_gs, MPI_COMM_ICE + use ice_communicate, only: my_task, mpiR8, mpiR4, mpitag_gs, MPI_COMM_ICE, & + ice_barrier, add_mpi_barriers use ice_constants, only: spval_dbl, c0, & field_loc_center, field_loc_NEcorner, field_loc_Nface, field_loc_Eface, & field_loc_noupdate, & @@ -233,9 +234,9 @@ subroutine gather_global_dbl(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) endif -#ifdef gather_scatter_barrier - call MPI_BARRIER(MPI_COMM_ICE, ierr) -#endif + if (add_mpi_barriers) then + call ice_barrier() + endif !----------------------------------------------------------------------- @@ -400,9 +401,9 @@ subroutine gather_global_real(ARRAY_G, ARRAY, dst_task, src_dist) endif -#ifdef gather_scatter_barrier - call MPI_BARRIER(MPI_COMM_ICE, ierr) -#endif + if (add_mpi_barriers) then + call ice_barrier() + endif !----------------------------------------------------------------------- @@ -567,9 +568,9 @@ subroutine gather_global_int(ARRAY_G, ARRAY, dst_task, src_dist) endif -#ifdef gather_scatter_barrier - call MPI_BARRIER(MPI_COMM_ICE, ierr) -#endif + if (add_mpi_barriers) then + call ice_barrier() + endif !----------------------------------------------------------------------- @@ -961,9 +962,9 @@ subroutine gather_global_ext_dbl(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) endif -#ifdef gather_scatter_barrier - call MPI_BARRIER(MPI_COMM_ICE, ierr) -#endif + if (add_mpi_barriers) then + call ice_barrier() + endif !----------------------------------------------------------------------- @@ -1284,9 +1285,9 @@ subroutine gather_global_ext_int(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) endif -#ifdef gather_scatter_barrier - call MPI_BARRIER(MPI_COMM_ICE, ierr) -#endif + if (add_mpi_barriers) then + call ice_barrier() + endif !----------------------------------------------------------------------- @@ -1607,9 +1608,9 @@ subroutine gather_global_ext_log(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) endif -#ifdef gather_scatter_barrier - call MPI_BARRIER(MPI_COMM_ICE, ierr) -#endif + if (add_mpi_barriers) then + call ice_barrier() + endif !----------------------------------------------------------------------- @@ -1983,9 +1984,9 @@ subroutine scatter_global_dbl(ARRAY, ARRAY_G, src_task, dst_dist, & enddo endif -#ifdef gather_scatter_barrier - call MPI_BARRIER(MPI_COMM_ICE, ierr) -#endif + if (add_mpi_barriers) then + call ice_barrier() + endif !----------------------------------------------------------------------- @@ -2372,9 +2373,9 @@ subroutine scatter_global_real(ARRAY, ARRAY_G, src_task, dst_dist, & enddo endif -#ifdef gather_scatter_barrier - call MPI_BARRIER(MPI_COMM_ICE, ierr) -#endif + if (add_mpi_barriers) then + call ice_barrier() + endif !----------------------------------------------------------------------- @@ -2761,9 +2762,9 @@ subroutine scatter_global_int(ARRAY, ARRAY_G, src_task, dst_dist, & enddo endif -#ifdef gather_scatter_barrier - call MPI_BARRIER(MPI_COMM_ICE, ierr) -#endif + if (add_mpi_barriers) then + call ice_barrier() + endif !----------------------------------------------------------------------- @@ -3093,9 +3094,9 @@ subroutine scatter_global_ext(ARRAY, ARRAY_G, src_task, dst_dist) deallocate(rcv_request, rcv_status) endif -#ifdef gather_scatter_barrier - call MPI_BARRIER(MPI_COMM_ICE, ierr) -#endif + if (add_mpi_barriers) then + call ice_barrier() + endif !----------------------------------------------------------------------- @@ -3379,9 +3380,9 @@ subroutine scatter_global_stress(ARRAY, ARRAY_G1, ARRAY_G2, & deallocate(rcv_request, rcv_status) endif -#ifdef gather_scatter_barrier - call MPI_BARRIER(MPI_COMM_ICE, ierr) -#endif + if (add_mpi_barriers) then + call ice_barrier() + endif !----------------------------------------------------------------------- diff --git a/cicecore/cicedynB/infrastructure/comm/mpi/ice_reprosum.F90 b/cicecore/cicedynB/infrastructure/comm/mpi/ice_reprosum.F90 index f85109339..27f66f712 100644 --- a/cicecore/cicedynB/infrastructure/comm/mpi/ice_reprosum.F90 +++ b/cicecore/cicedynB/infrastructure/comm/mpi/ice_reprosum.F90 @@ -39,7 +39,7 @@ MODULE ice_reprosum #ifndef SERIAL_REMOVE_MPI use mpi ! MPI Fortran module #endif -#if ( defined noI8 ) +#if defined (NO_I8) ! Workaround for when shr_kind_i8 is not supported. use ice_kinds_mod, only: r8 => dbl_kind, i8 => int_kind #else @@ -1032,7 +1032,7 @@ subroutine ice_reprosum_int (arr, arr_gsum, nsummands, dsummands, nflds, & #ifdef SERIAL_REMOVE_MPI i8_arr_gsum_level = i8_arr_lsum_level #else -#if ( defined noI8 ) +#if defined (NO_I8) ! Workaround for when i8 is not supported. ! if (detailed_timing) call xicex_timer_start("repro_sum_allr_i4") call mpi_allreduce (i8_arr_lsum_level, i8_arr_gsum_level, & diff --git a/cicecore/cicedynB/infrastructure/comm/serial/ice_communicate.F90 b/cicecore/cicedynB/infrastructure/comm/serial/ice_communicate.F90 index 2468f485b..c9df264dd 100644 --- a/cicecore/cicedynB/infrastructure/comm/serial/ice_communicate.F90 +++ b/cicecore/cicedynB/infrastructure/comm/serial/ice_communicate.F90 @@ -27,6 +27,9 @@ module ice_communicate my_task, &! MPI task number for this task master_task ! task number of master task + logical (log_kind), public :: & + add_mpi_barriers = .false. ! turn on mpi barriers for throttling + !*********************************************************************** contains @@ -43,12 +46,6 @@ subroutine init_communicate ! !----------------------------------------------------------------------- -#ifdef coupled - use mpi ! MPI Fortran module - - integer (int_kind) :: ierr ! MPI error flag -#endif - character(len=*), parameter :: subname = '(init_communicate)' !----------------------------------------------------------------------- @@ -58,27 +55,9 @@ subroutine init_communicate ! !----------------------------------------------------------------------- -#ifdef coupled - call MPI_INIT(ierr) - call MPI_COMM_RANK (MPI_COMM_ICE, my_task, ierr) -#else my_task = 0 -#endif - master_task = 0 -#ifdef coupled -!----------------------------------------------------------------------- -! -! On some 64-bit machines where real_kind and dbl_kind are -! identical, the MPI implementation uses MPI_REAL for both. -! In these cases, set MPI_DBL to MPI_REAL. -! -!----------------------------------------------------------------------- - - MPI_DBL = MPI_DOUBLE_PRECISION - -#endif !----------------------------------------------------------------------- end subroutine init_communicate @@ -136,11 +115,6 @@ subroutine create_communicator(new_comm, num_procs) ! this routine should be called from init_domain1 when the ! domain configuration (e.g. nprocs_btrop) has been determined -#ifdef coupled - - use mpi ! MPI Fortran module - -#endif ! !INPUT PARAMETERS: integer (int_kind), intent(in) :: & @@ -151,54 +125,8 @@ subroutine create_communicator(new_comm, num_procs) integer (int_kind), intent(out) :: & new_comm ! new communicator for this distribution -#ifdef coupled -!----------------------------------------------------------------------- -! -! local variables -! -!----------------------------------------------------------------------- - - integer (int_kind) :: & - MPI_GROUP_ICE, &! group of processors assigned to ice - MPI_GROUP_NEW ! group of processors assigned to new dist - - integer (int_kind) :: & - ierr ! error flag for MPI comms - - integer (int_kind), dimension(3) :: & - range ! range of tasks assigned to new dist - ! (assumed 0,num_procs-1) - - character(len=*), parameter :: subname = '(create_communicator)' - -!----------------------------------------------------------------------- -! -! determine group of processes assigned to distribution -! -!----------------------------------------------------------------------- - - call MPI_COMM_GROUP (MPI_COMM_ICE, MPI_GROUP_ICE, ierr) - - range(1) = 0 - range(2) = num_procs-1 - range(3) = 1 - -!----------------------------------------------------------------------- -! -! create subroup and communicator for new distribution -! note: MPI_COMM_CREATE must be called by all procs in MPI_COMM_ICE -! -!----------------------------------------------------------------------- - - call MPI_GROUP_RANGE_INCL(MPI_GROUP_ICE, 1, range, & - MPI_GROUP_NEW, ierr) - - call MPI_COMM_CREATE (MPI_COMM_ICE, MPI_GROUP_NEW, & - new_comm, ierr) - -#else new_comm = MPI_COMM_ICE -#endif + !----------------------------------------------------------------------- end subroutine create_communicator diff --git a/cicecore/cicedynB/infrastructure/comm/serial/ice_reprosum.F90 b/cicecore/cicedynB/infrastructure/comm/serial/ice_reprosum.F90 index ec852e2c3..1e4307535 100644 --- a/cicecore/cicedynB/infrastructure/comm/serial/ice_reprosum.F90 +++ b/cicecore/cicedynB/infrastructure/comm/serial/ice_reprosum.F90 @@ -40,7 +40,7 @@ MODULE ice_reprosum #ifndef SERIAL_REMOVE_MPI use mpi ! MPI Fortran module #endif -#if ( defined noI8 ) +#if defined (NO_I8) ! Workaround for when shr_kind_i8 is not supported. use ice_kinds_mod, only: r8 => dbl_kind, i8 => int_kind #else @@ -1033,7 +1033,7 @@ subroutine ice_reprosum_int (arr, arr_gsum, nsummands, dsummands, nflds, & #ifdef SERIAL_REMOVE_MPI i8_arr_gsum_level = i8_arr_lsum_level #else -#if ( defined noI8 ) +#if defined (NO_I8) ! Workaround for when i8 is not supported. ! if (detailed_timing) call xicex_timer_start("repro_sum_allr_i4") call mpi_allreduce (i8_arr_lsum_level, i8_arr_gsum_level, & diff --git a/cicecore/cicedynB/infrastructure/ice_domain.F90 b/cicecore/cicedynB/infrastructure/ice_domain.F90 index 3916039b5..cc57ea585 100644 --- a/cicecore/cicedynB/infrastructure/ice_domain.F90 +++ b/cicecore/cicedynB/infrastructure/ice_domain.F90 @@ -1,3 +1,6 @@ +#ifdef ncdf +#define USE_NETCDF +#endif !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| module ice_domain @@ -14,7 +17,8 @@ module ice_domain use ice_kinds_mod use ice_constants, only: shlat, nhlat - use ice_communicate, only: my_task, master_task, get_num_procs + use ice_communicate, only: my_task, master_task, get_num_procs, & + add_mpi_barriers use ice_broadcast, only: broadcast_scalar, broadcast_array use ice_blocks, only: block, get_block, create_blocks, nghost, & nblocks_x, nblocks_y, nblocks_tot, nx_block, ny_block @@ -26,7 +30,7 @@ module ice_domain use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_query_parameters -#ifdef ncdf +#ifdef USE_NETCDF use netcdf #endif @@ -58,7 +62,8 @@ module ice_domain logical (kind=log_kind), public :: & maskhalo_dyn , & ! if true, use masked halo updates for dynamics maskhalo_remap , & ! if true, use masked halo updates for transport - maskhalo_bound ! if true, use masked halo updates for bound_state + maskhalo_bound , & ! if true, use masked halo updates for bound_state + orca_halogrid ! if true, input fields are haloed as defined by orca grid !----------------------------------------------------------------------- ! @@ -128,7 +133,8 @@ subroutine init_domain_blocks ns_boundary_type, & maskhalo_dyn, & maskhalo_remap, & - maskhalo_bound + maskhalo_bound, & + add_mpi_barriers !---------------------------------------------------------------------- ! @@ -146,6 +152,7 @@ subroutine init_domain_blocks maskhalo_dyn = .false. ! if true, use masked halos for dynamics maskhalo_remap = .false. ! if true, use masked halos for transport maskhalo_bound = .false. ! if true, use masked halos for bound_state + add_mpi_barriers = .false. ! if true, throttle communication max_blocks = -1 ! max number of blocks per processor block_size_x = -1 ! size of block in first horiz dimension block_size_y = -1 ! size of block in second horiz dimension @@ -182,6 +189,7 @@ subroutine init_domain_blocks call broadcast_scalar(maskhalo_dyn, master_task) call broadcast_scalar(maskhalo_remap, master_task) call broadcast_scalar(maskhalo_bound, master_task) + call broadcast_scalar(add_mpi_barriers, master_task) if (my_task == master_task) then if (max_blocks < 1) then max_blocks=int( & @@ -259,6 +267,7 @@ subroutine init_domain_blocks write(nu_diag,'(a,l6)') ' maskhalo_dyn = ', maskhalo_dyn write(nu_diag,'(a,l6)') ' maskhalo_remap = ', maskhalo_remap write(nu_diag,'(a,l6)') ' maskhalo_bound = ', maskhalo_bound + write(nu_diag,'(a,l6)') ' add_mpi_barriers = ', add_mpi_barriers write(nu_diag,'(a,2i6)') ' block_size_x,_y = ', block_size_x, block_size_y write(nu_diag,'(a,i6)') ' max_blocks = ', max_blocks write(nu_diag,'(a,i6,/)')' Number of ghost cells = ', nghost @@ -303,7 +312,7 @@ subroutine init_domain_distribution(KMTG,ULATG) i,j,n ,&! dummy loop indices ig,jg ,&! global indices work_unit ,&! size of quantized work unit -#ifdef ncdf +#ifdef USE_NETCDF fid ,&! file id varid ,&! var id status ,&! netcdf return code @@ -439,7 +448,7 @@ subroutine init_domain_distribution(KMTG,ULATG) allocate(wght(nx_global,ny_global)) if (my_task == master_task) then ! cannot use ice_read_write due to circular dependency -#ifdef ncdf +#ifdef USE_NETCDF write(nu_diag,*) 'read ',trim(distribution_wght_file),minval(wght),maxval(wght) status = nf90_open(distribution_wght_file, NF90_NOWRITE, fid) if (status /= nf90_noerr) then @@ -449,7 +458,8 @@ subroutine init_domain_distribution(KMTG,ULATG) status = nf90_get_var(fid, varid, wght) status = nf90_close(fid) #else - call abort_ice (subname//'ERROR: distribution_wght file needs ncdf cpp ') + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) #endif endif call broadcast_array(wght, master_task) diff --git a/cicecore/cicedynB/infrastructure/ice_grid.F90 b/cicecore/cicedynB/infrastructure/ice_grid.F90 index f4b5fef6e..34b37cf29 100644 --- a/cicecore/cicedynB/infrastructure/ice_grid.F90 +++ b/cicecore/cicedynB/infrastructure/ice_grid.F90 @@ -1,3 +1,6 @@ +#ifdef ncdf +#define USE_NETCDF +#endif !======================================================================= ! Spatial grids, masks, and boundary conditions @@ -45,6 +48,7 @@ module ice_grid grid_file , & ! input file for POP grid info kmt_file , & ! input file for POP grid info bathymetry_file, & ! input bathymetry for basalstress + bathymetry_format, & ! bathymetry file format (default or pop) grid_spacing , & ! default of 30.e3m or set by user in namelist grid_type ! current options are rectangular (default), ! displaced_pole, tripole, regional @@ -541,11 +545,14 @@ subroutine init_grid2 ! bathymetry !----------------------------------------------------------------- -#ifdef RASM_MODS - call get_bathymetry_popfile -#else - call get_bathymetry -#endif + if (trim(bathymetry_format) == 'default') then + call get_bathymetry + elseif (trim(bathymetry_format) == 'pop') then + call get_bathymetry_popfile + else + call abort_ice(subname//'ERROR: bathymetry_format value must be default or pop', & + file=__FILE__, line=__LINE__) + endif !---------------------------------------------------------------- ! Corner coordinates for CF compliant history files @@ -713,13 +720,14 @@ end subroutine popgrid subroutine popgrid_nc -#ifdef ncdf use ice_blocks, only: nx_block, ny_block use ice_constants, only: c0, c1, & field_loc_center, field_loc_NEcorner, & field_type_scalar, field_type_angle use ice_domain_size, only: max_blocks +#ifdef USE_NETCDF use netcdf +#endif integer (kind=int_kind) :: & i, j, iblk, & @@ -752,6 +760,7 @@ subroutine popgrid_nc character(len=*), parameter :: subname = '(popgrid_nc)' +#ifdef USE_NETCDF call icepack_query_parameters(pi_out=pi) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -866,7 +875,11 @@ subroutine popgrid_nc call ice_close_nc(fid_grid) call ice_close_nc(fid_kmt) endif +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) #endif + end subroutine popgrid_nc #ifdef CESMCOUPLED @@ -879,13 +892,14 @@ end subroutine popgrid_nc subroutine latlongrid -#ifdef ncdf ! use ice_boundary use ice_domain_size use ice_scam, only : scmlat, scmlon, single_column use ice_constants, only: c0, c1, p5, p25, & field_loc_center, field_type_scalar, radius +#ifdef USE_NETCDF use netcdf +#endif integer (kind=int_kind) :: & i, j, iblk @@ -927,6 +941,7 @@ subroutine latlongrid character(len=*), parameter :: subname = '(lonlatgrid)' +#ifdef USE_NETCDF !----------------------------------------------------------------- ! - kmt file is actually clm fractional land file ! - Determine consistency of dimensions @@ -1139,6 +1154,9 @@ subroutine latlongrid !$OMP END PARALLEL DO call makemask +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) #endif end subroutine latlongrid @@ -2510,11 +2528,9 @@ subroutine read_basalstress_bathy character(len=*), parameter :: subname = '(read_basalstress_bathy)' if (my_task == master_task) then - write (nu_diag,*) ' ' write (nu_diag,*) 'Bathymetry file: ', trim(bathymetry_file) call icepack_warnings_flush(nu_diag) - endif call ice_open_nc(bathymetry_file,fid_init) diff --git a/cicecore/cicedynB/infrastructure/ice_read_write.F90 b/cicecore/cicedynB/infrastructure/ice_read_write.F90 index f497db49b..87d0813cc 100644 --- a/cicecore/cicedynB/infrastructure/ice_read_write.F90 +++ b/cicecore/cicedynB/infrastructure/ice_read_write.F90 @@ -1,3 +1,6 @@ +#ifdef ncdf +#define USE_NETCDF +#endif !======================================================================= ! Routines for opening, reading and writing external files @@ -15,13 +18,13 @@ module ice_read_write field_loc_noupdate, field_type_noupdate use ice_communicate, only: my_task, master_task use ice_broadcast, only: broadcast_scalar - use ice_domain, only: distrb_info + use ice_domain, only: distrb_info, orca_halogrid use ice_domain_size, only: max_blocks, nx_global, ny_global, ncat use ice_blocks, only: nx_block, ny_block, nghost use ice_exit, only: abort_ice use ice_fileunits, only: nu_diag -#ifdef ncdf +#ifdef USE_NETCDF use netcdf #endif @@ -1044,7 +1047,7 @@ subroutine ice_open_nc(filename, fid) character(len=*), parameter :: subname = '(ice_open_nc)' -#ifdef ncdf +#ifdef USE_NETCDF integer (kind=int_kind) :: & status ! status variable from netCDF routine @@ -1058,6 +1061,8 @@ subroutine ice_open_nc(filename, fid) endif ! my_task = master_task #else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined for '//trim(filename), & + file=__FILE__, line=__LINE__) fid = -999 ! to satisfy intent(out) attribute #endif end subroutine ice_open_nc @@ -1101,7 +1106,7 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & character(len=*), parameter :: subname = '(ice_read_nc_xy)' -#ifdef ncdf +#ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & varid , & ! variable id @@ -1121,18 +1126,17 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & integer (kind=int_kind) :: nx, ny -#ifdef ORCA_GRID real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g2 - if (.not. present(restart_ext)) then + if (orca_halogrid .and. .not. present(restart_ext)) then if (my_task == master_task) then allocate(work_g2(nx_global+2,ny_global+1)) else allocate(work_g2(1,1)) ! to save memory endif + work_g2(:,:) = c0 endif -#endif nx = nx_global ny = ny_global @@ -1166,22 +1170,16 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & ! Read global array !-------------------------------------------------------------- -#ifndef ORCA_GRID - status = nf90_get_var( fid, varid, work_g1, & - start=(/1,1,nrec/), & - count=(/nx,ny,1/) ) -#else - if (.not. present(restart_ext)) then + if (orca_halogrid .and. .not. present(restart_ext)) then status = nf90_get_var( fid, varid, work_g2, & start=(/1,1,nrec/), & count=(/nx_global+2,ny_global+1,1/) ) work_g1 = work_g2(2:nx_global+1,1:ny_global) else status = nf90_get_var( fid, varid, work_g1, & - start=(/1,1,nrec/), & - count=(/nx,ny,1/) ) + start=(/1,1,nrec/), & + count=(/nx,ny,1/) ) endif -#endif endif ! my_task = master_task @@ -1225,11 +1223,11 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & endif deallocate(work_g1) -#ifdef ORCA_GRID - if (.not. present(restart_ext)) deallocate(work_g2) -#endif + if (orca_halogrid .and. .not. present(restart_ext)) deallocate(work_g2) #else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) work = c0 ! to satisfy intent(out) attribute #endif end subroutine ice_read_nc_xy @@ -1273,7 +1271,7 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & character(len=*), parameter :: subname = '(ice_read_nc_xyz)' -#ifdef ncdf +#ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & n, & ! ncat index @@ -1294,18 +1292,17 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & integer (kind=int_kind) :: nx, ny -#ifdef ORCA_GRID real (kind=dbl_kind), dimension(:,:,:), allocatable :: & work_g2 - if (.not. present(restart_ext)) then + if (orca_halogrid .and. .not. present(restart_ext)) then if (my_task == master_task) then allocate(work_g2(nx_global+2,ny_global+1,ncat)) else allocate(work_g2(1,1,ncat)) ! to save memory endif + work_g2(:,:,:) = c0 endif -#endif nx = nx_global ny = ny_global @@ -1339,12 +1336,7 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & ! Read global array !-------------------------------------------------------------- -#ifndef ORCA_GRID - status = nf90_get_var( fid, varid, work_g1, & - start=(/1,1,1,nrec/), & - count=(/nx,ny,ncat,1/) ) -#else - if (.not. present(restart_ext)) then + if (orca_halogrid .and. .not. present(restart_ext)) then status = nf90_get_var( fid, varid, work_g2, & start=(/1,1,1,nrec/), & count=(/nx_global+2,ny_global+1,ncat,1/) ) @@ -1354,7 +1346,6 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & start=(/1,1,1,nrec/), & count=(/nx,ny,ncat,1/) ) endif -#endif endif ! my_task = master_task @@ -1407,11 +1398,11 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & endif deallocate(work_g1) -#ifdef ORCA_GRID - if (.not. present(restart_ext)) deallocate(work_g2) -#endif + if (orca_halogrid .and. .not. present(restart_ext)) deallocate(work_g2) #else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) work = c0 ! to satisfy intent(out) attribute #endif end subroutine ice_read_nc_xyz @@ -1458,7 +1449,6 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & ! local variables -#ifdef ncdf ! netCDF file diagnostics: integer (kind=int_kind) :: & varid, & ! variable id @@ -1480,18 +1470,20 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & integer (kind=int_kind) :: nx, ny -#ifdef ORCA_GRID + character(len=*), parameter :: subname = '(ice_read_nc_xyf)' + +#ifdef USE_NETCDF real (kind=dbl_kind), dimension(:,:,:), allocatable :: & work_g2 - if (.not. present(restart_ext)) then + if (orca_halogrid .and. .not. present(restart_ext)) then if (my_task == master_task) then allocate(work_g2(nx_global+2,ny_global+1,nfreq)) else allocate(work_g2(1,1,nfreq)) ! to save memory endif + work_g2(:,:,:) = c0 endif -#endif nx = nx_global ny = ny_global @@ -1526,13 +1518,7 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & ! Read global array !-------------------------------------------------------------- -#ifndef ORCA_GRID - status = nf90_get_var( fid, varid, work_g1, & - start=(/1,1,1,nrec/), & - count=(/nx,ny,nfreq,1/) ) -#else - print *, 'restart_ext',restart_ext - if (.not. present(restart_ext)) then + if (orca_halogrid .and. .not. present(restart_ext)) then status = nf90_get_var( fid, varid, work_g2, & start=(/1,1,1,nrec/), & count=(/nx_global+2,ny_global+1,nfreq,1/) ) @@ -1542,8 +1528,6 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & start=(/1,1,1,nrec/), & count=(/nx,ny,nfreq,1/) ) endif - print *, 'fid',fid ,' varid',varid -#endif status = nf90_get_att(fid, varid, "missing_value", missingvalue) endif ! my_task = master_task @@ -1601,11 +1585,11 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & where (work > 1.0e+30_dbl_kind) work = c0 deallocate(work_g1) -#ifdef ORCA_GRID - if (.not. present(restart_ext)) deallocate(work_g2) -#endif + if (orca_halogrid .and. .not. present(restart_ext)) deallocate(work_g2) #else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) work = c0 ! to satisfy intent(out) attribute #endif @@ -1640,7 +1624,7 @@ subroutine ice_read_nc_point(fid, nrec, varname, work, diag, & character(len=*), parameter :: subname = '(ice_read_nc_point)' -#ifdef ncdf +#ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & varid, & ! netcdf id for field @@ -1699,6 +1683,8 @@ subroutine ice_read_nc_point(fid, nrec, varname, work, diag, & work = workg(1) #else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) work = c0 ! to satisfy intent(out) attribute #endif end subroutine ice_read_nc_point @@ -1731,7 +1717,7 @@ subroutine ice_read_nc_z(fid, nrec, varname, work, diag, & ! local variables -#ifdef ncdf +#ifdef USE_NETCDF real (kind=dbl_kind), dimension(:), allocatable :: & work_z @@ -1749,7 +1735,7 @@ subroutine ice_read_nc_z(fid, nrec, varname, work, diag, & character(len=*), parameter :: subname = '(ice_read_nc_z)' -#ifdef ncdf +#ifdef USE_NETCDF allocate(work_z(nilyr)) @@ -1795,6 +1781,8 @@ subroutine ice_read_nc_z(fid, nrec, varname, work, diag, & deallocate(work_z) #else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) work = c0 ! to satisfy intent(out) attribute #endif end subroutine ice_read_nc_z @@ -1831,7 +1819,7 @@ subroutine ice_write_nc_xy(fid, nrec, varid, work, diag, & character(len=*), parameter :: subname = '(ice_read_nc_xy)' -#ifdef ncdf +#ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & status ! status output from netcdf routines @@ -1915,7 +1903,11 @@ subroutine ice_write_nc_xy(fid, nrec, varid, work, diag, & deallocate(work_g1) +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) #endif + end subroutine ice_write_nc_xy !======================================================================= @@ -1950,7 +1942,7 @@ subroutine ice_write_nc_xyz(fid, nrec, varid, work, diag, & character(len=*), parameter :: subname = '(ice_read_nc_xyz)' -#ifdef ncdf +#ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & n, & ! ncat index @@ -2045,7 +2037,11 @@ subroutine ice_write_nc_xyz(fid, nrec, varid, work, diag, & deallocate(work_g1) +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) #endif + end subroutine ice_write_nc_xyz !======================================================================= @@ -2076,7 +2072,7 @@ subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) character(len=*), parameter :: subname = '(ice_read_global_nc)' -#ifdef ncdf +#ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & varid, & ! netcdf id for field @@ -2091,18 +2087,18 @@ subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) ! character (char_len) :: & ! dimname ! dimension name ! -#ifdef ORCA_GRID real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g3 - if (my_task == master_task) then - allocate(work_g3(nx_global+2,ny_global+1)) - else - allocate(work_g3(1,1)) ! to save memory - endif + if (orca_halogrid) then + if (my_task == master_task) then + allocate(work_g3(nx_global+2,ny_global+1)) + else + allocate(work_g3(1,1)) ! to save memory + endif + work_g3(:,:) = c0 + endif - work_g3(:,:) = c0 -#endif work_g(:,:) = c0 if (my_task == master_task) then @@ -2121,16 +2117,16 @@ subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) ! Read global array !-------------------------------------------------------------- -#ifndef ORCA_GRID - status = nf90_get_var( fid, varid, work_g, & - start=(/1,1,nrec/), & - count=(/nx_global,ny_global,1/) ) -#else - status = nf90_get_var( fid, varid, work_g3, & - start=(/1,1,nrec/), & - count=(/nx_global+2,ny_global+1,1/) ) - work_g=work_g3(2:nx_global+1,1:ny_global) -#endif + if (orca_halogrid) then + status = nf90_get_var( fid, varid, work_g3, & + start=(/1,1,nrec/), & + count=(/nx_global+2,ny_global+1,1/) ) + work_g=work_g3(2:nx_global+1,1:ny_global) + else + status = nf90_get_var( fid, varid, work_g, & + start=(/1,1,nrec/), & + count=(/nx_global,ny_global,1/) ) + endif endif ! my_task = master_task !------------------------------------------------------------------- @@ -2153,13 +2149,14 @@ subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) write(nu_diag,*) 'min, max, sum = ', amin, amax, asum, trim(varname) endif -#ifdef ORCA_GRID - deallocate(work_g3) -#endif + if (orca_halogrid) deallocate(work_g3) #else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) work_g = c0 ! to satisfy intent(out) attribute #endif + end subroutine ice_read_global_nc !======================================================================= @@ -2176,13 +2173,16 @@ subroutine ice_close_nc(fid) character(len=*), parameter :: subname = '(ice_close_nc)' -#ifdef ncdf +#ifdef USE_NETCDF integer (kind=int_kind) :: & status ! status variable from netCDF routine if (my_task == master_task) then status = nf90_close(fid) endif +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) #endif end subroutine ice_close_nc @@ -2227,7 +2227,7 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & character(len=*), parameter :: subname = '(ice_read_nc_uv)' -#ifdef ncdf +#ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & varid , & ! variable id @@ -2318,8 +2318,11 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & deallocate(work_g1) #else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) work = c0 ! to satisfy intent(out) attribute #endif + end subroutine ice_read_nc_uv !======================================================================= @@ -2350,7 +2353,7 @@ subroutine ice_read_vec_nc (fid, nrec, varname, work_g, diag) character(len=*), parameter :: subname = '(ice_read_vec_nc)' -#ifdef ncdf +#ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & varid, & ! netcdf id for field @@ -2393,9 +2396,11 @@ subroutine ice_read_vec_nc (fid, nrec, varname, work_g, diag) endif #else - write(*,*) 'ERROR: ncdf not defined during compilation' + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) work_g = c0 ! to satisfy intent(out) attribute #endif + end subroutine ice_read_vec_nc !======================================================================= @@ -2411,7 +2416,7 @@ subroutine ice_get_ncvarsize(fid,varname,recsize) ! local variables -#ifdef ncdf +#ifdef USE_NETCDF integer (kind=int_kind) :: & ndims, i, status character (char_len) :: & @@ -2419,7 +2424,7 @@ subroutine ice_get_ncvarsize(fid,varname,recsize) #endif character(len=*), parameter :: subname = '(ice_get_ncvarsize)' -#ifdef ncdf +#ifdef USE_NETCDF if (my_task == master_task) then status=nf90_inquire(fid, nDimensions = nDims) if (status /= nf90_noerr) then @@ -2437,9 +2442,11 @@ subroutine ice_get_ncvarsize(fid,varname,recsize) endif endif #else - write(*,*) 'ERROR: ncdf not defined during compilation' + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) recsize = 0 ! to satisfy intent(out) attribute #endif + end subroutine ice_get_ncvarsize !======================================================================= diff --git a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_history_write.F90 b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_history_write.F90 index 5b6aa0dd8..b3024302e 100644 --- a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_history_write.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_history_write.F90 @@ -1,3 +1,6 @@ +#ifdef ncdf +#define USE_NETCDF +#endif !======================================================================= ! ! Writes history in netCDF format @@ -41,7 +44,6 @@ module ice_history_write subroutine ice_write_hist (ns) use ice_kinds_mod -#ifdef ncdf use ice_arrays_column, only: hin_max, floe_rad_c use ice_blocks, only: nx_block, ny_block use ice_broadcast, only: broadcast_scalar @@ -56,6 +58,7 @@ subroutine ice_write_hist (ns) lont_bounds, latt_bounds, lonu_bounds, latu_bounds use ice_history_shared use ice_restart_shared, only: runid, lcdf64 +#ifdef USE_NETCDF use netcdf #endif @@ -63,7 +66,6 @@ subroutine ice_write_hist (ns) ! local variables -#ifdef ncdf real (kind=dbl_kind), dimension(:,:), allocatable :: work_g1 real (kind=real_kind), dimension(:,:), allocatable :: work_gr real (kind=real_kind), dimension(:,:,:), allocatable :: work_gr3 @@ -120,6 +122,7 @@ subroutine ice_write_hist (ns) character(len=*), parameter :: subname = '(ice_write_hist)' +#ifdef USE_NETCDF call icepack_query_parameters(secday_out=secday, rad_to_deg_out=rad_to_deg) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -1571,6 +1574,10 @@ subroutine ice_write_hist (ns) write(nu_diag,*) ' ' write(nu_diag,*) 'Finished writing ',trim(ncfile(ns)) endif + +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) #endif end subroutine ice_write_hist diff --git a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 index 8bb09398e..53c7dac60 100644 --- a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 @@ -1,3 +1,6 @@ +#ifdef ncdf +#define USE_NETCDF +#endif !======================================================================= ! Read and write ice model restart files using netCDF or binary @@ -8,7 +11,9 @@ module ice_restart use ice_broadcast use ice_kinds_mod +#ifdef USE_NETCDF use netcdf +#endif use ice_restart_shared, only: & restart_ext, restart_dir, restart_file, pointer_file, & runid, use_restart_time, lcdf64, lenstr, restart_coszen @@ -52,6 +57,7 @@ subroutine init_restart_read(ice_ic) character(len=*), parameter :: subname = '(init_restart_read)' +#ifdef USE_NETCDF if (present(ice_ic)) then filename = trim(ice_ic) else @@ -97,6 +103,10 @@ subroutine init_restart_read(ice_ic) if (trim(runid) == 'bering') then npt = npt - istep0 endif +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined for '//trim(ice_ic), & + file=__FILE__, line=__LINE__) +#endif end subroutine init_restart_read @@ -153,6 +163,7 @@ subroutine init_restart_write(filename_spec) character(len=*), parameter :: subname = '(init_restart_write)' +#ifdef USE_NETCDF call icepack_query_parameters( & solve_zsal_out=solve_zsal, skl_bgc_out=skl_bgc, z_tracers_out=z_tracers) call icepack_query_tracer_sizes( & @@ -619,6 +630,11 @@ subroutine init_restart_write(filename_spec) write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif ! master_task +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined for '//trim(filename_spec), & + file=__FILE__, line=__LINE__) +#endif + end subroutine init_restart_write !======================================================================= @@ -661,6 +677,7 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3, & character(len=*), parameter :: subname = '(read_restart_field)' +#ifdef USE_NETCDF if (present(field_loc)) then if (ndim3 == ncat) then if (restart_ext) then @@ -699,6 +716,11 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3, & endif endif +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) +#endif + end subroutine read_restart_field !======================================================================= @@ -740,6 +762,7 @@ subroutine write_restart_field(nu,nrec,work,atype,vname,ndim3,diag) character(len=*), parameter :: subname = '(write_restart_field)' +#ifdef USE_NETCDF status = nf90_inq_varid(ncid,trim(vname),varid) if (ndim3 == ncat) then if (restart_ext) then @@ -758,6 +781,11 @@ subroutine write_restart_field(nu,nrec,work,atype,vname,ndim3,diag) write(nu_diag,*) 'ndim3 not supported',ndim3 endif +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) +#endif + end subroutine write_restart_field !======================================================================= @@ -774,11 +802,17 @@ subroutine final_restart() character(len=*), parameter :: subname = '(final_restart)' +#ifdef USE_NETCDF status = nf90_close(ncid) if (my_task == master_task) & write(nu_diag,*) 'Restart read/written ',istep1,time,time_forc +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) +#endif + end subroutine final_restart !======================================================================= @@ -799,7 +833,12 @@ subroutine define_rest_field(ncid, vname, dims) character(len=*), parameter :: subname = '(define_rest_field)' +#ifdef USE_NETCDF status = nf90_def_var(ncid,trim(vname),nf90_double,dims,varid) +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) +#endif end subroutine define_rest_field diff --git a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 index d030b439b..7e16f2591 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 @@ -39,7 +39,6 @@ module ice_history_write subroutine ice_write_hist (ns) -#ifdef ncdf use ice_blocks, only: nx_block, ny_block use ice_broadcast, only: broadcast_scalar use ice_calendar, only: time, sec, idate, idate0, write_ic, & @@ -55,8 +54,6 @@ subroutine ice_write_hist (ns) use ice_history_shared use ice_arrays_column, only: hin_max, floe_rad_c use ice_restart_shared, only: runid, lcdf64 - use netcdf -#endif use ice_pio use pio @@ -64,7 +61,6 @@ subroutine ice_write_hist (ns) ! local variables -#ifdef ncdf integer (kind=int_kind) :: i,j,k,ic,n,nn, & ncid,status,imtid,jmtid,kmtidi,kmtids,kmtidb, cmtid,timid, & length,nvertexid,ivertex,kmtida,fmtid @@ -1300,8 +1296,6 @@ subroutine ice_write_hist (ns) write(nu_diag,*) 'Finished writing ',trim(ncfile(ns)) endif -#endif - end subroutine ice_write_hist !======================================================================= diff --git a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 index b11dcf0d0..eb703abcd 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 @@ -662,7 +662,7 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3,diag, & use ice_global_reductions, only: global_minval, global_maxval, global_sum integer (kind=int_kind), intent(in) :: & - nu , & ! unit number (not used for netcdf) + nu , & ! unit number ndim3 , & ! third dimension nrec ! record number (0 for sequential access) diff --git a/cicecore/drivers/direct/hadgem3/CICE.F90 b/cicecore/drivers/direct/hadgem3/CICE.F90 index b38c1aa29..72bf1b747 100644 --- a/cicecore/drivers/direct/hadgem3/CICE.F90 +++ b/cicecore/drivers/direct/hadgem3/CICE.F90 @@ -17,7 +17,6 @@ ! https://github.com/CICE-Consortium ! !======================================================================= -#ifndef popcice ! ! Main driver routine for CICE. Initializes and steps through the model. ! This program should be compiled if CICE is run as a separate executable, @@ -56,7 +55,6 @@ program icemodel end program icemodel -#endif !======================================================================= ! ! Wrapper for the print_state debugging routine. diff --git a/cicecore/drivers/direct/hadgem3/CICE_FinalMod.F90 b/cicecore/drivers/direct/hadgem3/CICE_FinalMod.F90 index 6b5a53abe..397950023 100644 --- a/cicecore/drivers/direct/hadgem3/CICE_FinalMod.F90 +++ b/cicecore/drivers/direct/hadgem3/CICE_FinalMod.F90 @@ -58,9 +58,8 @@ subroutine CICE_Finalize ! quit MPI !------------------------------------------------------------------- -#ifndef coupled - call end_run ! quit MPI -#endif +! standalone +! call end_run ! quit MPI end subroutine CICE_Finalize diff --git a/cicecore/drivers/direct/hadgem3/CICE_InitMod.F90 b/cicecore/drivers/direct/hadgem3/CICE_InitMod.F90 index b208bcbef..dc41ff9fd 100644 --- a/cicecore/drivers/direct/hadgem3/CICE_InitMod.F90 +++ b/cicecore/drivers/direct/hadgem3/CICE_InitMod.F90 @@ -87,9 +87,6 @@ subroutine cice_init use ice_restoring, only: ice_HaloRestore_init use ice_timers, only: timer_total, init_ice_timers, ice_timer_start use ice_transport_driver, only: init_transport -#ifdef popcice - use drv_forcing, only: sst_sss -#endif logical(kind=log_kind) :: tr_aero, tr_zaero, skl_bgc, z_tracers, & tr_fsd, wave_spec @@ -131,9 +128,6 @@ subroutine cice_init endif call init_coupler_flux ! initialize fluxes exchanged with coupler -#ifdef popcice - call sst_sss ! POP data for CICE initialization -#endif call init_thermo_vertical ! initialize vertical thermodynamics call icepack_init_itd(ncat=ncat, hin_max=hin_max) ! ice thickness distribution @@ -202,19 +196,17 @@ subroutine cice_init call init_forcing_atmo ! initialize atmospheric forcing (standalone) #endif -#ifndef coupled -#ifndef CESMCOUPLED - if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice - call get_forcing_atmo ! atmospheric forcing from data - call get_forcing_ocn(dt) ! ocean forcing from data - - ! aerosols - ! if (tr_aero) call faero_data ! data file - ! if (tr_zaero) call fzaero_data ! data file (gx1) - if (tr_aero .or. tr_zaero) call faero_default ! default values - if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry -#endif -#endif +! standalone +! if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice +! call get_forcing_atmo ! atmospheric forcing from data +! call get_forcing_ocn(dt) ! ocean forcing from data + +! ! aerosols +! ! if (tr_aero) call faero_data ! data file +! ! if (tr_zaero) call fzaero_data ! data file (gx1) +! if (tr_aero .or. tr_zaero) call faero_default ! default values +! if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry + if (z_tracers) call get_atm_bgc ! biogeochemistry if (runtype == 'initial' .and. .not. restart) & diff --git a/cicecore/drivers/direct/hadgem3/CICE_RunMod.F90 b/cicecore/drivers/direct/hadgem3/CICE_RunMod.F90 index 90af92122..e43b4a24d 100644 --- a/cicecore/drivers/direct/hadgem3/CICE_RunMod.F90 +++ b/cicecore/drivers/direct/hadgem3/CICE_RunMod.F90 @@ -92,21 +92,19 @@ subroutine CICE_Run call ice_timer_start(timer_couple) ! atm/ocn coupling -#ifndef coupled -#ifndef CESMCOUPLED +! standalone ! for now, wave_spectrum is constant in time ! if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice - call get_forcing_atmo ! atmospheric forcing from data - call get_forcing_ocn(dt) ! ocean forcing from data +! call get_forcing_atmo ! atmospheric forcing from data +! call get_forcing_ocn(dt) ! ocean forcing from data - ! aerosols - ! if (tr_aero) call faero_data ! data file - ! if (tr_zaero) call fzaero_data ! data file (gx1) - if (tr_aero .or. tr_zaero) call faero_default ! default values +! ! aerosols +! ! if (tr_aero) call faero_data ! data file +! ! if (tr_zaero) call fzaero_data ! data file (gx1) +! if (tr_aero .or. tr_zaero) call faero_default ! default values + +! if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry - if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry -#endif -#endif if (z_tracers) call get_atm_bgc ! biogeochemistry call init_flux_atm ! initialize atmosphere fluxes sent to coupler diff --git a/cicecore/drivers/mct/cesm1/CICE_FinalMod.F90 b/cicecore/drivers/mct/cesm1/CICE_FinalMod.F90 index c2331e4e5..943787498 100644 --- a/cicecore/drivers/mct/cesm1/CICE_FinalMod.F90 +++ b/cicecore/drivers/mct/cesm1/CICE_FinalMod.F90 @@ -55,9 +55,8 @@ subroutine CICE_Finalize ! quit MPI !------------------------------------------------------------------- -#ifndef coupled - call end_run ! quit MPI -#endif +! standalone +! call end_run ! quit MPI end subroutine CICE_Finalize diff --git a/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 b/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 index b72745e30..80bb2570e 100644 --- a/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 +++ b/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 @@ -87,9 +87,6 @@ subroutine cice_init(mpicom_ice) use ice_restoring, only: ice_HaloRestore_init use ice_timers, only: timer_total, init_ice_timers, ice_timer_start use ice_transport_driver, only: init_transport -#ifdef popcice - use drv_forcing, only: sst_sss -#endif integer (kind=int_kind), optional, intent(in) :: & mpicom_ice ! communicator for sequential ccsm @@ -134,9 +131,6 @@ subroutine cice_init(mpicom_ice) call init_coupler_flux ! initialize fluxes exchanged with coupler -#ifdef popcice - call sst_sss ! POP data for CICE initialization -#endif call init_thermo_vertical ! initialize vertical thermodynamics call icepack_init_itd(ncat=ncat, hin_max=hin_max) ! ice thickness distribution @@ -206,21 +200,19 @@ subroutine cice_init(mpicom_ice) call init_forcing_atmo ! initialize atmospheric forcing (standalone) -#ifndef coupled -#ifndef CESMCOUPLED - if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice - call get_forcing_atmo ! atmospheric forcing from data - call get_forcing_ocn(dt) ! ocean forcing from data +! for standalone +! if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice +! call get_forcing_atmo ! atmospheric forcing from data +! call get_forcing_ocn(dt) ! ocean forcing from data + +! ! isotopes +! if (tr_iso) call fiso_default ! default values +! ! aerosols +! ! if (tr_aero) call faero_data ! data file +! ! if (tr_zaero) call fzaero_data ! data file (gx1) +! if (tr_aero .or. tr_zaero) call faero_default ! default values +! if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry - ! isotopes - if (tr_iso) call fiso_default ! default values - ! aerosols - ! if (tr_aero) call faero_data ! data file - ! if (tr_zaero) call fzaero_data ! data file (gx1) - if (tr_aero .or. tr_zaero) call faero_default ! default values - if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry -#endif -#endif if (z_tracers) call get_atm_bgc ! biogeochemistry if (runtype == 'initial' .and. .not. restart) & diff --git a/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 b/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 index f5e7de02f..ee217712b 100644 --- a/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 +++ b/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 @@ -89,23 +89,20 @@ subroutine CICE_Run call ice_timer_start(timer_couple) ! atm/ocn coupling -#ifndef coupled -#ifndef CESMCOUPLED +! for standalone ! for now, wave_spectrum is constant in time ! if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice - call get_forcing_atmo ! atmospheric forcing from data - call get_forcing_ocn(dt) ! ocean forcing from data +! call get_forcing_atmo ! atmospheric forcing from data +! call get_forcing_ocn(dt) ! ocean forcing from data - ! isotopes - if (tr_iso) call fiso_default ! default values - ! aerosols - ! if (tr_aero) call faero_data ! data file - ! if (tr_zaero) call fzaero_data ! data file (gx1) - if (tr_aero .or. tr_zaero) call faero_default ! default values +! ! isotopes +! if (tr_iso) call fiso_default ! default values +! ! aerosols +! ! if (tr_aero) call faero_data ! data file +! ! if (tr_zaero) call fzaero_data ! data file (gx1) +! if (tr_aero .or. tr_zaero) call faero_default ! default values +! if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry - if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry -#endif -#endif if (z_tracers) call get_atm_bgc ! biogeochemistry call init_flux_atm ! Initialize atmosphere fluxes sent to coupler diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index 29af8e941..01b309034 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -14,9 +14,7 @@ module ice_import_export use ice_flux , only : alvdr, alidr, alvdf, alidf, Tref, Qref, Uref use ice_flux , only : flat, fsens, flwout, evap, fswabs, fhocn, fswthru use ice_flux , only : fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf -#if (defined NEWCODE) use ice_flux , only : send_i2x_per_cat, fswthrun_ai -#endif use ice_flux_bgc , only : faero_atm, faero_ocn use ice_flux_bgc , only : fiso_atm, fiso_ocn, fiso_evap use ice_flux_bgc , only : Qa_iso, Qref_iso, HDO_ocn, H2_18O_ocn, H2_16O_ocn @@ -35,7 +33,6 @@ module ice_import_export use icepack_intfc , only : icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc , only : icepack_query_parameters, icepack_query_tracer_flags use icepack_intfc , only : icepack_liquidus_temperature - use icepack_intfc , only : icepack_sea_freezing_temperature use cice_wrapper_mod , only : t_startf, t_stopf, t_barrierf #ifdef CESMCOUPLED use shr_frz_mod , only : shr_frz_freezetemp @@ -88,7 +85,7 @@ module ice_import_export type (fld_list_type) :: fldsFrIce(fldsMax) type(ESMF_GeomType_Flag) :: geomtype - integer , parameter :: io_dbug = 10 ! i/o debug messages + integer , parameter :: dbug = 10 ! i/o debug messages character(*), parameter :: u_FILE_u = & __FILE__ @@ -116,7 +113,7 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (io_dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! Determine if the following attributes are sent by the driver and if so read them in flds_wiso = .false. @@ -127,7 +124,6 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call ESMF_LogWrite('flds_wiso = '// trim(cvalue), ESMF_LOGMSG_INFO) end if -#if (defined NEWCODE) flds_i2o_per_cat = .false. call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -135,7 +131,6 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam read(cvalue,*) send_i2x_per_cat call ESMF_LogWrite('flds_i2o_per_cat = '// trim(cvalue), ESMF_LOGMSG_INFO) end if -#endif !----------------- ! advertise import fields @@ -208,14 +203,12 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_vis_dif_albedo' ) call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_ir_dif_albedo' ) -#if (defined NEWCODE) ! the following are advertised but might not be connected if they are not present ! in the cmeps esmFldsExchange_xxx_mod.F90 that is model specific if (send_i2x_per_cat) then call fldlist_add(fldsFrIce_num, fldsFrIce, 'ice_fraction_n', & ungridded_lbound=1, ungridded_ubound=ncat) end if -#endif ! ice/atm fluxes computed by ice call fldlist_add(fldsFrIce_num, fldsFrIce, 'stress_on_air_ice_zonal' ) @@ -234,12 +227,10 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_sw_pen_to_ocn_ir_dir_flx' ) call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_sw_pen_to_ocn_ir_dif_flx' ) -#if (defined NEWCODE) if (send_i2x_per_cat) then call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_sw_pen_to_ocn_ifrac_n', & ungridded_lbound=1, ungridded_ubound=ncat) end if -#endif call fldlist_add(fldsFrIce_num , fldsFrIce, 'mean_fresh_water_to_ocean_rate' ) call fldlist_add(fldsFrIce_num , fldsFrIce, 'mean_salt_rate' ) call fldlist_add(fldsFrIce_num , fldsFrIce, 'stress_on_ocn_ice_zonal' ) @@ -254,8 +245,8 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam if (flds_wiso) then call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_fresh_water_to_ocean_rate_wiso', & ungridded_lbound=1, ungridded_ubound=3) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_evap_rate_atm_into_ice_wiso', & - ungridded_lbound=1, ungridded_ubound=3) + !call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_evap_rate_atm_into_ice_wiso', & + ! ungridded_lbound=1, ungridded_ubound=3) call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_qref_wiso', & ungridded_lbound=1, ungridded_ubound=3) end if @@ -266,7 +257,7 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam if (ChkErr(rc,__LINE__,u_FILE_u)) return enddo - if (io_dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine ice_advertise_fields @@ -362,22 +353,12 @@ subroutine ice_import( importState, rc ) real (kind=dbl_kind),allocatable :: aflds(:,:,:,:) real (kind=dbl_kind) :: workx, worky real (kind=dbl_kind) :: MIN_RAIN_TEMP, MAX_SNOW_TEMP - real (kind=dbl_kind) :: Tffresh + real (kind=dbl_kind) :: tffresh real (kind=dbl_kind) :: inst_pres_height_lowest - character(len=char_len) :: tfrz_option - integer(int_kind) :: ktherm character(len=*), parameter :: subname = 'ice_import' - character(len=1024) :: msgString !----------------------------------------------------- call icepack_query_parameters(Tffresh_out=Tffresh) - call icepack_query_parameters(tfrz_option_out=tfrz_option) - call icepack_query_parameters(ktherm_out=ktherm) - if (io_dbug > 5) then - write(msgString,'(A,i8)')trim(subname)//' tfrz_option = ' & - // trim(tfrz_option)//', ktherm = ',ktherm - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - end if ! call icepack_query_parameters(tfrz_option_out=tfrz_option, & ! modal_aero_out=modal_aero, z_tracers_out=z_tracers, skl_bgc_out=skl_bgc, & ! Tffresh_out=Tffresh) @@ -631,13 +612,6 @@ subroutine ice_import( importState, rc ) call state_getimport(importState, 'inst_spec_humid_height_lowest_wiso', output=Qa_iso, index=3, ungridded_index=2, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call state_getimport(importState, 'mean_prec_rate_wiso', output=fiso_rain, index=1, ungridded_index=3, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call state_getimport(importState, 'mean_prec_rate_wiso', output=fiso_rain, index=2, ungridded_index=1, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call state_getimport(importState, 'mean_prec_rate_wiso', output=fiso_rain, index=3, ungridded_index=2, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_fprec_rate_wiso', output=fiso_atm, index=1, ungridded_index=3, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_getimport(importState, 'mean_fprec_rate_wiso', output=fiso_atm, index=2, ungridded_index=1, rc=rc) @@ -704,7 +678,8 @@ subroutine ice_import( importState, rc ) do iblk = 1, nblocks do j = 1,ny_block do i = 1,nx_block - Tf(i,j,iblk) = icepack_sea_freezing_temperature(sss(i,j,iblk)) + !TODO: tcx should this be icepack_sea_freezing_temperature? + Tf (i,j,iblk) = icepack_liquidus_temperature(sss(i,j,iblk)) end do end do end do @@ -779,12 +754,12 @@ subroutine ice_export( exportState, rc ) real (kind=dbl_kind) :: tauyo (nx_block,ny_block,max_blocks) ! ice/ocean stress real (kind=dbl_kind) :: ailohi(nx_block,ny_block,max_blocks) ! fractional ice area real (kind=dbl_kind), allocatable :: tempfld(:,:,:) - real (kind=dbl_kind) :: Tffresh + real (kind=dbl_kind) :: tffresh character(len=*),parameter :: subname = 'ice_export' !----------------------------------------------------- rc = ESMF_SUCCESS - if (io_dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) call icepack_query_parameters(Tffresh_out=Tffresh) ! call icepack_query_parameters(tfrz_option_out=tfrz_option, & @@ -913,6 +888,7 @@ subroutine ice_export( exportState, rc ) ! ---- ! surface temperature of ice covered portion (degK) + !call state_setexport(exportState, 'sea_ice_temperature', input=Tsrf , lmask=tmask, ifrac=ailohi, rc=rc) call state_setexport(exportState, 'sea_ice_surface_temperature', input=Tsrf , lmask=tmask, ifrac=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1116,7 +1092,6 @@ subroutine ice_export( exportState, rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif -#if (defined NEWCODE) ! ------ ! optional short wave penetration to ocean ice category ! ------ @@ -1137,7 +1112,6 @@ subroutine ice_export( exportState, rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do end if -#endif end subroutine ice_export diff --git a/cicecore/drivers/nuopc/dmi/CICE.F90 b/cicecore/drivers/nuopc/dmi/CICE.F90 index 56dffc6b7..ec1963d38 100644 --- a/cicecore/drivers/nuopc/dmi/CICE.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE.F90 @@ -17,7 +17,6 @@ ! https://github.com/CICE-Consortium ! !======================================================================= -#ifndef popcice ! ! Main driver routine for CICE. Initializes and steps through the model. ! This program should be compiled if CICE is run as a separate executable, @@ -57,7 +56,6 @@ program icemodel end program icemodel -#endif !======================================================================= ! ! Wrapper for the print_state debugging routine. diff --git a/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 b/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 index adafb3d36..4e236bb11 100644 --- a/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 @@ -92,9 +92,6 @@ subroutine cice_init(mpi_comm) use ice_restoring, only: ice_HaloRestore_init use ice_timers, only: timer_total, init_ice_timers, ice_timer_start use ice_transport_driver, only: init_transport -#ifdef popcice - use drv_forcing, only: sst_sss -#endif integer (kind=int_kind), optional, intent(in) :: & mpi_comm ! communicator for sequential ccsm @@ -146,9 +143,6 @@ subroutine cice_init(mpi_comm) call init_coupler_flux ! initialize fluxes exchanged with coupler -#ifdef popcice - call sst_sss ! POP data for CICE initialization -#endif call init_thermo_vertical ! initialize vertical thermodynamics call icepack_init_itd(ncat=ncat, hin_max=hin_max) ! ice thickness distribution diff --git a/cicecore/drivers/standalone/cice/CICE.F90 b/cicecore/drivers/standalone/cice/CICE.F90 index 56dffc6b7..ec1963d38 100644 --- a/cicecore/drivers/standalone/cice/CICE.F90 +++ b/cicecore/drivers/standalone/cice/CICE.F90 @@ -17,7 +17,6 @@ ! https://github.com/CICE-Consortium ! !======================================================================= -#ifndef popcice ! ! Main driver routine for CICE. Initializes and steps through the model. ! This program should be compiled if CICE is run as a separate executable, @@ -57,7 +56,6 @@ program icemodel end program icemodel -#endif !======================================================================= ! ! Wrapper for the print_state debugging routine. diff --git a/cicecore/drivers/standalone/cice/CICE_FinalMod.F90 b/cicecore/drivers/standalone/cice/CICE_FinalMod.F90 index 0cd1ff177..dd0ca0b20 100644 --- a/cicecore/drivers/standalone/cice/CICE_FinalMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_FinalMod.F90 @@ -65,9 +65,7 @@ subroutine CICE_Finalize ! quit MPI !------------------------------------------------------------------- -#ifndef coupled call end_run ! quit MPI -#endif end subroutine CICE_Finalize diff --git a/cicecore/drivers/standalone/cice/CICE_InitMod.F90 b/cicecore/drivers/standalone/cice/CICE_InitMod.F90 index 59bbca31c..0a8614eb2 100644 --- a/cicecore/drivers/standalone/cice/CICE_InitMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_InitMod.F90 @@ -87,9 +87,6 @@ subroutine cice_init use ice_restoring, only: ice_HaloRestore_init use ice_timers, only: timer_total, init_ice_timers, ice_timer_start use ice_transport_driver, only: init_transport -#ifdef popcice - use drv_forcing, only: sst_sss -#endif logical(kind=log_kind) :: tr_aero, tr_zaero, skl_bgc, z_tracers, & tr_iso, tr_fsd, wave_spec @@ -134,9 +131,6 @@ subroutine cice_init call init_coupler_flux ! initialize fluxes exchanged with coupler -#ifdef popcice - call sst_sss ! POP data for CICE initialization -#endif call init_thermo_vertical ! initialize vertical thermodynamics call icepack_init_itd(ncat=ncat, hin_max=hin_max) ! ice thickness distribution @@ -206,8 +200,6 @@ subroutine cice_init call init_forcing_atmo ! initialize atmospheric forcing (standalone) -#ifndef coupled -#ifndef CESMCOUPLED if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice call get_forcing_atmo ! atmospheric forcing from data call get_forcing_ocn(dt) ! ocean forcing from data @@ -219,8 +211,6 @@ subroutine cice_init ! if (tr_zaero) call fzaero_data ! data file (gx1) if (tr_aero .or. tr_zaero) call faero_default ! default values if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry -#endif -#endif if (z_tracers) call get_atm_bgc ! biogeochemistry if (runtype == 'initial' .and. .not. restart) & diff --git a/cicecore/drivers/standalone/cice/CICE_RunMod.F90 b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 index 363749e8f..b45db2514 100644 --- a/cicecore/drivers/standalone/cice/CICE_RunMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 @@ -94,8 +94,6 @@ subroutine CICE_Run call ice_timer_start(timer_couple) ! atm/ocn coupling -#ifndef coupled -#ifndef CESMCOUPLED ! for now, wave_spectrum is constant in time ! if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice call get_forcing_atmo ! atmospheric forcing from data @@ -109,8 +107,6 @@ subroutine CICE_Run if (tr_aero .or. tr_zaero) call faero_default ! default values if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry -#endif -#endif if (z_tracers) call get_atm_bgc ! biogeochemistry call init_flux_atm ! Initialize atmosphere fluxes sent to coupler diff --git a/cicecore/drivers/standalone/cice/CICE_RunMod.F90_debug b/cicecore/drivers/standalone/cice/CICE_RunMod.F90_debug index 7ca555433..c7ae7601f 100644 --- a/cicecore/drivers/standalone/cice/CICE_RunMod.F90_debug +++ b/cicecore/drivers/standalone/cice/CICE_RunMod.F90_debug @@ -94,8 +94,6 @@ call ice_timer_start(timer_couple) ! atm/ocn coupling -#ifndef coupled -#ifndef CESMCOUPLED ! for now, wave_spectrum is constant in time ! if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice call get_forcing_atmo ! atmospheric forcing from data @@ -109,8 +107,6 @@ if (tr_aero .or. tr_zaero) call faero_default ! default values if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry -#endif -#endif if (z_tracers) call get_atm_bgc ! biogeochemistry call init_flux_atm ! Initialize atmosphere fluxes sent to coupler diff --git a/configuration/scripts/cice.build b/configuration/scripts/cice.build index b51484201..b9aed44fe 100755 --- a/configuration/scripts/cice.build +++ b/configuration/scripts/cice.build @@ -117,10 +117,10 @@ cd ${ICE_OBJDIR} if (${ICE_IOTYPE} == 'netcdf') then set IODIR = io_netcdf - setenv ICE_CPPDEFS "${ICE_CPPDEFS} -Dncdf" + setenv ICE_CPPDEFS "${ICE_CPPDEFS} -DUSE_NETCDF" else if (${ICE_IOTYPE} =~ pio*) then set IODIR = io_pio2 - setenv ICE_CPPDEFS "${ICE_CPPDEFS} -Dncdf" + setenv ICE_CPPDEFS "${ICE_CPPDEFS} -DUSE_NETCDF" else set IODIR = io_binary endif diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index 54663f86c..87946ebc5 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -53,6 +53,7 @@ grid_file = 'grid' kmt_file = 'kmt' bathymetry_file = 'unknown_bathymetry_file' + bathymetry_format = 'default' use_bathymetry = .false. gridcpl_file = 'unknown_gridcpl_file' kcatbound = 0 @@ -64,6 +65,7 @@ nilyr = 7 nslyr = 1 nblyr = 7 + orca_halogrid = .false. / &tracer_nml @@ -107,6 +109,9 @@ dSdt_slow_mode = -5.0e-8 phi_c_slow_mode = 0.05 phi_i_mushy = 0.85 + sw_redist = .false. + sw_frac = 0.9d0 + sw_dtemp = 0.02d0 / &dynamics_nml @@ -134,6 +139,7 @@ coriolis = 'latitude' kridge = 1 ktransport = 1 + ssh_stress = 'geostrophic' / &shortwave_nml @@ -182,6 +188,7 @@ wave_spec_type = 'none' wave_spec_file = 'unknown_wave_spec_file' nfreq = 25 + restart_coszen = .false. restore_ice = .false. restore_ocn = .false. trestore = 90 @@ -217,6 +224,7 @@ maskhalo_dyn = .false. maskhalo_remap = .false. maskhalo_bound = .false. + add_mpi_barriers = .false. / &zbgc_nml diff --git a/configuration/scripts/options/set_nml.alt03 b/configuration/scripts/options/set_nml.alt03 index 43681ab9d..f82491d9d 100644 --- a/configuration/scripts/options/set_nml.alt03 +++ b/configuration/scripts/options/set_nml.alt03 @@ -14,6 +14,9 @@ tr_aero = .true. calc_Tsfc = .false. kdyn = 2 ktherm = 1 +sw_redist = .true. +sw_frac = 0.9d0 +sw_dtemp = 0.02d0 tfrz_option = 'linear_salt' revised_evp = .false. Ktens = 0. diff --git a/configuration/scripts/options/set_nml.alt04 b/configuration/scripts/options/set_nml.alt04 index 786decae6..937704294 100644 --- a/configuration/scripts/options/set_nml.alt04 +++ b/configuration/scripts/options/set_nml.alt04 @@ -13,6 +13,9 @@ tr_pond_lvl = .true. tr_aero = .true. kitd = 0 ktherm = 1 +sw_redist = .true. +sw_frac = 0.9d0 +sw_dtemp = 0.02d0 conduct = 'MU71' kdyn = 1 kevp_kernel = 102 diff --git a/configuration/scripts/parse_namelist.sh b/configuration/scripts/parse_namelist.sh index c94420f6e..ea539a2d0 100755 --- a/configuration/scripts/parse_namelist.sh +++ b/configuration/scripts/parse_namelist.sh @@ -5,12 +5,15 @@ if [[ "$#" -ne 2 ]]; then exit -1 fi +scriptname=`basename "$0"` filename=$1 filemods=$2 #echo "$0 $1 $2" echo "running parse_namelist.sh" foundstring="FoundSTRING" +vnamearray=() +valuearray=() while read -r line do @@ -24,17 +27,39 @@ do value=`echo $line | sed "s|^[[:space:]]*\([^[:space:]]*\)[[:space:]]*=[[:space:]]*\([^[:space:]]*\).*$|\2|g"` # echo "$line $vname $value" + found=${foundstring} + for i in "${!vnamearray[@]}"; do + if [[ "${found}" == "${foundstring}" ]]; then + vn=${vnamearray[$i]} + vv=${valuearray[$i]} +# echo "names/values $i ${vname} ${vn} ${value} ${vv}" + if [[ "$vname" == "$vn" ]]; then + found=$i + if [[ "$value" != "${vv}" ]]; then +# echo "names/values $i ${vname} ${vn} ${value} ${vv}" + echo "${scriptname} WARNING: re-overriding $vname from ${vv} to ${value}" + fi + fi + fi + done + #sed -i 's|\(^\s*'"$vname"'\s*\=\s*\)\(.*$\)|\1'"$value"'|g' $filename cp ${filename} ${filename}.check sed -i.sedbak -e 's|\(^[[:space:]]*'"$vname"'[[:space:]]*=[[:space:]]*\)\(.*$\)|\1'"$foundstring"'|g' ${filename}.check grep -q ${foundstring} ${filename}.check if [ $? -eq 0 ]; then sed -i.sedbak -e 's|\(^[[:space:]]*'"$vname"'[[:space:]]*=[[:space:]]*\)\(.*$\)|\1'"$value"'|g' ${filename} + if [[ "${found}" == "${foundstring}" ]]; then + vnamearray+=($vname) + valuearray+=($value) + else + valuearray[$found]=${value} + fi if [[ -e "${filename}.sedbak" ]]; then rm ${filename}.sedbak fi else - echo "$0 ERROR: parsing error for ${vname}" + echo "${scriptname} ERROR: parsing error for ${vname}" exit -99 fi rm ${filename}.check ${filename}.check.sedbak diff --git a/configuration/scripts/parse_settings.sh b/configuration/scripts/parse_settings.sh index f797dbebe..d6ed31c15 100755 --- a/configuration/scripts/parse_settings.sh +++ b/configuration/scripts/parse_settings.sh @@ -5,11 +5,15 @@ if [[ "$#" -ne 2 ]]; then exit -1 fi +scriptname=`basename "$0"` filename=$1 filemods=$2 #echo "$0 $1 $2" echo "running parse_settings.sh" +foundstring="FoundSTRING" +vnamearray=() +valuearray=() while read -r line do @@ -23,8 +27,32 @@ do value=`echo $line | sed "s|\(^[[:space:]]*set[^[:space:]]*\)[[:space:]][[:space:]]*\([^[:space:]]*\)[[:space:]][[:space:]]*\([^[:space:]]*\).*$|\3|g"` # echo "$line $vname $value" + found=${foundstring} + for i in "${!vnamearray[@]}"; do + if [[ "${found}" == "${foundstring}" ]]; then + vn=${vnamearray[$i]} + vv=${valuearray[$i]} +# echo "names/values $i ${vname} ${vn} ${value} ${vv}" + if [[ "$vname" == "$vn" ]]; then + found=$i + if [[ "$value" != "${vv}" ]]; then +# echo "names/values $i ${vname} ${vn} ${value} ${vv}" + echo "${scriptname} WARNING: re-overriding $vname from ${vv} to ${value}" + fi + fi + fi + done + #sed -i 's|\(^\s*set.* '"$vname"' \)[^#]*\(#*.*$\)|\1 '"$value"' \2|g' $filename sed -i.sedbak -e 's|\(^[[:space:]]*set.* '"$vname"' \)[^#]*\(#*.*$\)|\1 '"$value"' \2|g' $filename + + if [[ "${found}" == "${foundstring}" ]]; then + vnamearray+=($vname) + valuearray+=($value) + else + valuearray[$found]=${value} + fi + if [[ -e "${filename}.sedbak" ]]; then rm ${filename}.sedbak fi diff --git a/configuration/scripts/tests/cice.lcov.csh b/configuration/scripts/tests/cice.lcov.csh index 8107778d9..5772833d1 100644 --- a/configuration/scripts/tests/cice.lcov.csh +++ b/configuration/scripts/tests/cice.lcov.csh @@ -9,7 +9,7 @@ set lcovhtmldir = lcov_cice_${report_name} genhtml -o ./${lcovhtmldir} --precision 2 -t "${report_name}" total.info rm -r -f ${lcovrepo} -git clone https://github.com/apcraig/${lcovrepo} +git clone --depth=1 https://github.com/apcraig/${lcovrepo} cp -p -r ${lcovhtmldir} ${lcovrepo}/ cd ${lcovrepo} diff --git a/configuration/scripts/tests/cice_test_codecov.csh b/configuration/scripts/tests/cice_test_codecov.csh index be9399f1b..d9a69e898 100755 --- a/configuration/scripts/tests/cice_test_codecov.csh +++ b/configuration/scripts/tests/cice_test_codecov.csh @@ -29,7 +29,7 @@ cd ${testdir} # Check out current cice master echo " " echo "*** checkout current cice master ***" -git clone https://github.com/cice-consortium/cice cice.master.${date} --recursive +git clone --depth=1 https://github.com/cice-consortium/cice cice.master.${date} --recursive cd cice.master.${date} set hash = `git rev-parse --short HEAD ` cd ../ @@ -40,7 +40,7 @@ cd ../ # This also copies in all dot file at the root that do not start with .g (ie. .git*) echo " " echo "*** checkout current test_cice_master ***" -git clone https://github.com/apcraig/test_cice_icepack test_cice_icepack.${date} +git clone --depth=1 https://github.com/apcraig/test_cice_icepack test_cice_icepack.${date} cd test_cice_icepack.${date} echo " " echo "*** remove current files and copy in cice master files ***" diff --git a/configuration/scripts/tests/io_suite.ts b/configuration/scripts/tests/io_suite.ts index c1edec292..3e98642e9 100755 --- a/configuration/scripts/tests/io_suite.ts +++ b/configuration/scripts/tests/io_suite.ts @@ -1,8 +1,9 @@ # Test Grid PEs Sets BFB-compare +# some iobinary configurations fail due to bathymetry netcdf file requirement, remove them restart gx3 8x4 debug,histall,iobinary,precision8 -restart gx3 12x2 alt01,histall,iobinary +#restart gx3 12x2 alt01,histall,iobinary restart gx3 16x2 alt02,histall,iobinary,precision8 -restart gx3 4x2 alt03,histall,iobinary +#restart gx3 4x2 alt03,histall,iobinary restart gx3 8x4 alt04,histall,iobinary,precision8 restart gx3 4x4 alt05,histall,iobinary restart gx3 32x1 bgcz,histall,iobinary,precision8 diff --git a/configuration/scripts/tests/report_results.csh b/configuration/scripts/tests/report_results.csh index e3f8eed70..2eb3731d5 100755 --- a/configuration/scripts/tests/report_results.csh +++ b/configuration/scripts/tests/report_results.csh @@ -25,7 +25,7 @@ set wikirepo = "https://github.com/CICE-Consortium/Test-Results.wiki.git" set wikiname = Test-Results.wiki rm -r -f ${wikiname} -git clone ${wikirepo} ${wikiname} +git clone --depth=1 ${wikirepo} ${wikiname} if ($status != 0) then echo " " echo "${0}: ERROR git clone failed" diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index 2bbf4e231..229fa92d5 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -29,6 +29,7 @@ either Celsius or Kelvin units). "a4Df", "history field accumulations, 4D categories, fsd", "" "a_min", "minimum area concentration for computing velocity", "0.001" "a_rapid_mode", ":math:`{\bullet}` brine channel diameter", "" + "add_mpi_barriers", ":math:`\bullet` turns on MPI barriers for communication throttling", "" "advection", ":math:`\bullet` type of advection algorithm used (‘remap’ or ‘upwind’)", "remap" "afsd(n)", "floe size distribution (in category n)", "" "ahmax", ":math:`\bullet` thickness above which ice albedo is constant", "0.3m" diff --git a/doc/source/intro/citing.rst b/doc/source/intro/citing.rst index 8f4e142c8..c128bc4e6 100644 --- a/doc/source/intro/citing.rst +++ b/doc/source/intro/citing.rst @@ -5,14 +5,26 @@ Citing the CICE code ==================== -If you use the CICE code, please cite the version you are using with the CICE -Digital Object Identifier (DOI): +Each individual release has its own Digital Object Identifier (DOI), +e.g. CICE v6.1.2 has DOI 10.5281/zenodo.3888653. All versions of +this lineage (e.g. CICE6) can be cited by using the DOI +10.5281/zenodo.1205674 (https://zenodo.org/record/1205674). This DOI +represents all v6 releases, and will always resolve to the latest one. +More information can be found by following the DOI link to zenodo. -DOI:10.5281/zenodo.1205674 (https://zenodo.org/record/1205674) +If you use CICE, please cite the version number of the code you +are using or modifying. -This DOI can be used to cite all CICE versions and the URL will default to the most recent version. -However, each released version of CICE will also receive its own, unique DOI that can be -used for citations as well. +If using code from the CICE-Consortium repository ``master`` branch +that includes modifications +that have not yet been released with a version number, then in +addition to the most recent version number, the hash at time of +download can be cited, determined by executing the command ``git log`` +in your clone. -Please also make the CICE Consortium aware of any publications and model use. +A hash can also be cited for your own modifications, once they have +been committed to a repository branch. + +Please also make the CICE Consortium aware of any publications and +model use. diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 5512841a2..f4596a07b 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -8,7 +8,51 @@ Case Settings There are two important files that define the case, **cice.settings** and **ice_in**. **cice.settings** is a list of env variables that define many values used to setup, build and run the case. **ice_in** is the input namelist file -for CICE. Variables in both files are described below. +for CICE. Variables in both files are described below. In addition, the first +table lists available preprocessor macros to activate or deactivate various +features when compiling. + +.. _tabcpps: + +Table of C Preprocessor (CPP) Macros +--------------------------------------------------- + +The CICE model supports a number of C Preprocessor (CPP) Macros. These +can be turned on during compilation to activate different pieces of source +code. The main purpose is to introduce build-time code modifications to +include or exclude certain libraries or Fortran language features. More information +can be found in :ref:`cicecpps`. The following CPPs are available. + +.. csv-table:: **CPP Macros** + :header: "CPP name", "description" + :widths: 15, 60 + + "","" + "**General Macros**", "" + "CESM1_PIO", "Provide backwards compatible support for PIO interfaces/version released with CESM1 in about 2010" + "ESMF_INTERFACE", "Turns on ESMF support in a subset of driver code. Also USE_ESMF_LIB and USE_ESMF_METADATA" + "FORTRANUNDERSCORE", "Used in ice_shr_reprosum86.c to support Fortran-C interfaces. This should generally be turned on at all times. There are other CPPs (FORTRANDOUBULEUNDERSCORE, FORTRANCAPS, etc) in ice_shr_reprosum.c that are generally not used in CICE but could be useful if problems arise in the Fortran-C interfaces" + "GPTL", "Turns on GPTL initialization if needed for PIO" + "key_oasis3", "Leverages Oasis CPPs to define the local MPI communicator" + "key_oasis3mct", "Leverages Oasis CPPs to define the local MPI communicator" + "key_oasis4", "Leverages Oasis CPPs to define the local MPI communicator" + "key_iomput", "Leverages Oasis CPPs to define the local MPI communicator" + "NO_F2003", "Turns off some Fortran 2003 features" + "NO_I8", "Converts integer*8 to integer*4. This could have adverse affects for certain algorithms including the ddpdd implementation associated with the ``bfbflag``" + "NO_R16", "Converts real*16 to real*8. This could have adverse affects for certain algorithms including the lsum16 implementation associated with the ``bfbflag``" + "USE_NETCDF", "Turns on netcdf code. This is normally on and is needed for released configurations. An older value, ncdf, is still supported" + "","" + "**Application Macros**", "" + "CESMCOUPLED", "Turns on code changes for the CESM coupled application " + "CICE_IN_NEMO", "Turns on code changes for coupling in the NEMO ocean model" + "CICE_DMI", "Turns on code changes for the DMI coupled model application" + "ICE_DA", "Turns on code changes in the hadgem driver" + "RASM_MODS", "Turns on code changes for the RASM coupled application" + "","" + "**Library Macros**", "" + "_OPENMP", "Automatically defined when compiling with OpenMP " + "_OPENACC", "Automatically defined when compiling with OpenACC " + .. _tabsettings: @@ -37,7 +81,7 @@ can be modified as needed. "ICE_RSTDIR", "string", "unused", "${ICE_RUNDIR}/restart" "ICE_HSTDIR", "string", "unused", "${ICE_RUNDIR}/history" "ICE_LOGDIR", "string", "log directory", "${ICE_CASEDIR}/logs" - "ICE_DRVOPT", "string", "unused", "cice" + "ICE_DRVOPT", "string", "unused", "standalone/cice" "ICE_IOTYPE", "string", "I/O format", "set by cice.setup" " ", "netcdf", "serial netCDF" " ", "pio", "parallel netCDF" @@ -126,7 +170,7 @@ setup_nml "``histfreq_n``", "integer array", "frequency history output is written with ``histfreq``", "1,1,1,1,1" "``history_dir``", "string", "path to history output directory", "'./'" "``history_file``", "string", "output file for history", "'iceh'" - "``history_format``", "``default``", "read/write restart files in default format", "``default``" + "``history_format``", "``default``", "read/write history files in default format", "``default``" "", "``pio_pnetcdf``", "read/write restart files with pnetcdf in pio", "" "``history_precision``", "integer", "history file precision: 4 or 8 byte", "4" "``ice_ic``", "``default``", "latitude and sst dependent initial condition", "``default``" @@ -171,6 +215,8 @@ grid_nml "", "", "", "" "``bathymetry_file``", "string", "name of bathymetry file to be read", "‘unknown_bathymetry_file’" + "``bathymetry_format``", "``default``", "NetCDF depth field", "‘default’" + "", "``pop``", "pop thickness file in cm in ascii format", "" "``close_boundaries``", "logical", "set land on edges of grid", "``.false.``" "``dxrect``", "real", "x-direction grid spacing for rectangular grid in cm", "0.0" "``dyrect``", "real", "y-direction grid spacing for rectangular grid in cm", "0.0" @@ -193,6 +239,7 @@ grid_nml "``nfsd``", "integer", "number of floe size categories", "1" "``nilyr``", "integer", "number of vertical layers in ice", "0" "``nslyr``", "integer", "number of vertical layers in snow", "0" + "``orca_halogrid``", "logical", "use orca haloed grid for data/grid read", "``.false.``" "``use_bathymetry``", "logical", "use read in bathymetry file for basalstress option", "``.false.``" "", "", "", "" @@ -204,6 +251,7 @@ domain_nml :widths: 15, 15, 30, 15 "", "", "", "" + "``add_mpi_barriers``", "logical", "throttle communication", "``.false.``" "``block_size_x``", "integer", "block size in x direction", "-1" "``block_size_y``", "integer", "block size in y direction", "-1" "``distribution_type``", "``cartesian``", "2D cartesian block distribution method", "``cartesian``" @@ -297,6 +345,9 @@ thermo_nml "``phi_c_slow_mode``", ":math:`0<\phi_c < 1`", "critical liquid fraction", "0.05" "``phi_i_mushy``", ":math:`0<\phi_i < 1`", "solid fraction at lower boundary", "0.85" "``Rac_rapid_mode``", "real", "critical Rayleigh number", "10.0" + "``sw_redist``", "logical", "redistribute internal shortwave to surface", "``.false.``" + "``sw_frac``", "real", "fraction redistributed", "0.9" + "``sw_dtemp``", "real", "temperature difference from melt to start redistributing", "0.02" "", "", "", "" dynamics_nml @@ -315,9 +366,9 @@ dynamics_nml "``basalstress``", "logical", "use basal stress parameterization for landfast ice", "``.false.``" "``Cf``", "real", "ratio of ridging work to PE change in ridging", "17.0" "``coriolis``", "``constant``", "constant coriolis value = 1.46e-4", "``latitude``" - "``Cstar``", "real", "constant in Hibler strength formula", "20" "", "``latitude``", "coriolis variable by latitude", "" "", "``zero``", "zero coriolis", "" + "``Cstar``", "real", "constant in Hibler strength formula", "20" "``e_ratio``", "real", "EVP ellipse aspect ratio", "2.0" "``kdyn``", "``-1``", "dynamics algorithm OFF", "1" "", "``0``", "dynamics OFF", "" @@ -342,6 +393,8 @@ dynamics_nml "``ndte``", "integer", "number of EVP subcycles", "120" "``Pstar``", "real", "constant in Hibler strength formula (N/m\ :math:`^2`)", "2.75e4" "``revised_evp``", "logical", "use revised EVP formulation", "``.false.``" + "``ssh_stress``", "``coupled``", "computed from coupled sea surface height gradient", "``geostrophic``" + "", "``geostropic``", "computed from ocean velocity", "" "``threshold_hw``", "real", "Max water depth for grounding (see :cite:`Amundrud04`)", "30." "``yield_curve``", "``ellipse``", "elliptical yield curve", "``ellipse``" "", "", "", "" @@ -452,6 +505,7 @@ forcing_nml "", "``mm_per_month``", "", "" "", "``mm_per_sec``", "(same as MKS units)", "" "", "``m_per_sec``", "", "" + "``restart_coszen``", "logical", "read/write coszen in restart files", "``.false.``" "``restore_ocn``", "logical", "restore sst to data", "``.false.``" "``restore_ice``", "logical", "restore ice state along lateral boundaries", "``.false.``" "``tfrz_option``", "``linear_salt``", "linear functino of salinity (ktherm=1)", "``mushy``" @@ -651,5 +705,3 @@ icefields_nml "", "``md``", "*e.g.,* write both monthly and daily files", "" "", "", "", "" - - diff --git a/doc/source/user_guide/ug_implementation.rst b/doc/source/user_guide/ug_implementation.rst index 44d4ef1d6..cbfe37b0c 100644 --- a/doc/source/user_guide/ug_implementation.rst +++ b/doc/source/user_guide/ug_implementation.rst @@ -181,6 +181,12 @@ that prints out the variable ``blkmask`` to the history file and which labels the blocks in the grid decomposition according to ``blkmask = my_task + iblk/100``. +The namelist ``add_mpi_barriers`` can be set to ``.true.`` to help +throttle communication for communication intensive configurations. This +may slow the code down a bit. These barriers have been added to +a few select locations, but it's possible others may be needed. As a general +rule, ``add_mpi_barriers`` should be ``.false.``. + ************* Tripole grids ************* diff --git a/doc/source/user_guide/ug_running.rst b/doc/source/user_guide/ug_running.rst index 8befee9cb..957cfc4fc 100644 --- a/doc/source/user_guide/ug_running.rst +++ b/doc/source/user_guide/ug_running.rst @@ -14,9 +14,10 @@ Software Requirements To run stand-alone, CICE requires +- bash and csh - gmake (GNU Make) - Fortran and C compilers (Intel, PGI, GNU, Cray, and NAG have been tested) -- NetCDF +- NetCDF (this is actually optional but required to test out of the box configurations) - MPI (this is actually optional but without it you can only run on 1 processor) Below are lists of software versions that the Consortium has tested at some point. There is no @@ -202,7 +203,10 @@ specifies the compilation environment associated with the machine. This should specifies the grid. This is a string and for the current CICE driver, gx1, gx3, and tx1 are supported. (default = gx3) ``--set``, ``-s`` SET1,SET2,SET3 - specifies the optional settings for the case. The settings for ``--suite`` are defined in the suite file. Multiple settings can be specified by providing a comma deliminated set of values without spaces between settings. The available settings are in **configurations/scripts/options** and ``cice.setup --help`` will also list them. These settings files can change either the namelist values or overall case settings (such as the debug flag). + specifies the optional settings for the case. The settings for ``--suite`` are defined in the suite file. Multiple settings can be specified by providing a comma deliminated set of values without spaces between settings. The available settings are in **configurations/scripts/options** and ``cice.setup --help`` will also list them. These settings files can change either the namelist values or overall case settings (such as the debug flag). For cases and tests (not suites), settings defined in **~/.cice_set** (if it exists) will be included in the --set options. This behaviour can be overridden with the `--ignore-user-set`` command line option. + +``--ignore-user-set`` + ignores settings defined in **~/.cice.set** (if it exists) for cases and tests. **~/.cice_set** is always ignored for test suites. For CICE, when setting up cases, the ``--case`` and ``--mach`` must be specified. It's also recommended that ``--env`` be set explicitly as well. @@ -228,7 +232,13 @@ settings (options), the set_env.setting and set_nml.setting will be used to change the defaults. This is done as part of the ``cice.setup`` and the modifications are resolved in the **cice.settings** and **ice_in** file placed in the case directory. If multiple options are chosen that conflict, then the last -option chosen takes precedent. Not all options are compatible with each other. +option chosen takes precedence. Not all options are compatible with each other. + +Settings defined in **~/.cice_set** (if it exists) will be included in the ``--set`` +options. This behaviour can be overridden with the `--ignore-user-set`` command +line option. The format of the **~/.cice_set** file is a identical to the +``--set`` option, a single comma-delimited line of options. Settings on the +command line will take precedence over settings defined in **~/.cice_set**. Some of the options are @@ -350,6 +360,25 @@ automatically clean the prior build. If incremental builds are desired to save time during development, the ``ICE_CLEANBUILD`` setting in **cice.settings** should be modified. +.. _cicecpps: + +C Preprocessor (CPP) Macros +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +There are a number of C Preprocessing Macros supported in the CICE model. These +allow certain coding features like NetCDF, MPI, or specific Fortran features to be +excluded or included during the compile. + +The CPPs are defined by the `CPPDEFS` variable in the Makefile. They are defined +by passing the -D[CPP] to the C and Fortran compilers (ie. -DUSE_NETCDF) and this +is what needs to be set in the `CPPDEFS` variable. The value of `ICE_CPPDEFS` in +**cice.settings** is copied into the Makefile `CPPDEFS` variable as are settings +hardwired into the **Macros.[machine]_[environment]** file. + +In general, ``-DFORTRANUNDERSCORE`` should always be set to support the Fortran/C +interfaces in **ice_shr_reprosum.c**. In addition, if NetCDF is used, ``-DUSE_NETCDF`` +should also be defined. A list of available CPPs can be found in +:ref:`tabcpps`. .. _porting: @@ -453,7 +482,7 @@ the **env.[machine]** file. The easiest way to change a user's default is to create a file in your home directory called **.cice\_proj** and add your preferred account name to the first line. There is also an option (``--acct``) in **cice.setup** to define the account number. -The order of precedent is **cice.setup** command line option, +The order of precedence is **cice.setup** command line option, **.cice\_proj** setting, and then value in the **env.[machine]** file. .. _queue: diff --git a/doc/source/user_guide/ug_testing.rst b/doc/source/user_guide/ug_testing.rst index 8f8fe9441..5369efe5f 100644 --- a/doc/source/user_guide/ug_testing.rst +++ b/doc/source/user_guide/ug_testing.rst @@ -56,6 +56,8 @@ For individual tests, the following command line options can be set ``--set`` SET1,SET2,SET3 (see :ref:`case_options`) +``--ignore-user-set`` (see :ref:`case_options`) + ``--acct`` ACCOUNT (see :ref:`case_options`) ``--grid`` GRID (see :ref:`case_options`) @@ -312,7 +314,7 @@ If a user adds ``--set`` to the suite, all tests in that suite will add that opt ./cice.setup --suite base_suite,decomp_suite --mach wolf --env gnu --testid myid -s debug -The option settings defined in the suite have precendent over the command line +The option settings defined in the suite have precendence over the command line values if there are conflicts. The predefined test suites are defined under **configuration/scripts/tests** and @@ -459,7 +461,7 @@ Test Suite Examples ./results.csh If there are conflicts between the ``--set`` options in the suite and on the command line, - the suite will take precedent. + the suite will take precedence. 5) **Multiple test suites from a single command line** diff --git a/icepack b/icepack index b1e41d9f1..4c42a82e3 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit b1e41d9f12a59390aacdb933889c3c4a87c9e8d2 +Subproject commit 4c42a82e3d92f191a9c52bca3831e8d242e2e4c0 From b52362ec877ace5601784c3d2f64a32a51a8f0d2 Mon Sep 17 00:00:00 2001 From: David Bailey Date: Mon, 10 Aug 2020 16:45:41 -0600 Subject: [PATCH 23/51] Fix some merge problems --- cicecore/cicedynB/general/ice_init.F90 | 3 +-- configuration/scripts/ice_in | 1 - doc/source/user_guide/ug_case_settings.rst | 1 - 3 files changed, 1 insertion(+), 4 deletions(-) diff --git a/cicecore/cicedynB/general/ice_init.F90 b/cicecore/cicedynB/general/ice_init.F90 index 4e1e953de..d3b096eb3 100644 --- a/cicecore/cicedynB/general/ice_init.F90 +++ b/cicecore/cicedynB/general/ice_init.F90 @@ -152,8 +152,7 @@ subroutine input_data dt, npt, ndtd, numin, & runtype, runid, bfbflag, numax, & ice_ic, restart, restart_dir, restart_file, & - restart_ext, restart_coszen, use_restart_time, restart_format, & - lcdf64, & + restart_ext, use_restart_time, restart_format, lcdf64, & pointer_file, dumpfreq, dumpfreq_n, dump_last, & diagfreq, diag_type, diag_file, history_format,& print_global, print_points, latpnt, lonpnt, & diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index 87946ebc5..a26579df1 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -10,7 +10,6 @@ ice_ic = './restart/iced_gx3_v5.nc' restart = .true. restart_ext = .false. - restart_coszen = .false. use_restart_time = .true. restart_format = 'default' lcdf64 = .false. diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index f4596a07b..550162515 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -192,7 +192,6 @@ setup_nml "``restart``", "logical", "initialize using restart file", "``.false.``" "``restart_dir``", "string", "path to restart directory", "'./'" "``restart_ext``", "logical", "read/write halo cells in restart files", "``.false.``" - "``restart_coszen``", "logical", "read/write coszen in restart files", "``.false.``" "``restart_file``", "string", "output file prefix for restart dump", "'iced'" "``restart_format``", "``default``", "read/write restart file with default format", "``default``" "", "``pio_pnetcdf``", "read/write restart files with pnetcdf in pio", "" From f106591321eeafd50ccb53a42891847f96a5158f Mon Sep 17 00:00:00 2001 From: David Bailey Date: Mon, 10 Aug 2020 17:01:50 -0600 Subject: [PATCH 24/51] Fix dbug variable --- cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index 6aada7b21..da3d95369 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -86,7 +86,7 @@ module ice_comp_nuopc character(len=*),parameter :: shr_cal_noleap = 'NO_LEAP' character(len=*),parameter :: shr_cal_gregorian = 'GREGORIAN' - integer , parameter :: dbug = 0 + integer :: dbug = 0 integer , parameter :: debug_import = 0 ! internal debug level integer , parameter :: debug_export = 0 ! internal debug level character(*), parameter :: modName = "(ice_comp_nuopc)" From 64c5569f4256310afa2034c975fe047d7ef70444 Mon Sep 17 00:00:00 2001 From: David Bailey Date: Wed, 12 Aug 2020 09:27:04 -0600 Subject: [PATCH 25/51] Manual merge of UFS changes --- .../drivers/nuopc/cmeps/ice_import_export.F90 | 38 +++++++++++++------ 1 file changed, 27 insertions(+), 11 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index 01b309034..b32085143 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -33,6 +33,7 @@ module ice_import_export use icepack_intfc , only : icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc , only : icepack_query_parameters, icepack_query_tracer_flags use icepack_intfc , only : icepack_liquidus_temperature + use icepack_intfc , only : icepack_sea_freezing_temperature use cice_wrapper_mod , only : t_startf, t_stopf, t_barrierf #ifdef CESMCOUPLED use shr_frz_mod , only : shr_frz_freezetemp @@ -85,7 +86,7 @@ module ice_import_export type (fld_list_type) :: fldsFrIce(fldsMax) type(ESMF_GeomType_Flag) :: geomtype - integer , parameter :: dbug = 10 ! i/o debug messages + integer , parameter :: io_dbug = 10 ! i/o debug messages character(*), parameter :: u_FILE_u = & __FILE__ @@ -113,7 +114,7 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + if (io_dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! Determine if the following attributes are sent by the driver and if so read them in flds_wiso = .false. @@ -245,8 +246,8 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam if (flds_wiso) then call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_fresh_water_to_ocean_rate_wiso', & ungridded_lbound=1, ungridded_ubound=3) - !call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_evap_rate_atm_into_ice_wiso', & - ! ungridded_lbound=1, ungridded_ubound=3) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_evap_rate_atm_into_ice_wiso', & + ungridded_lbound=1, ungridded_ubound=3) call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_qref_wiso', & ungridded_lbound=1, ungridded_ubound=3) end if @@ -257,7 +258,7 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam if (ChkErr(rc,__LINE__,u_FILE_u)) return enddo - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + if (io_dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine ice_advertise_fields @@ -353,12 +354,22 @@ subroutine ice_import( importState, rc ) real (kind=dbl_kind),allocatable :: aflds(:,:,:,:) real (kind=dbl_kind) :: workx, worky real (kind=dbl_kind) :: MIN_RAIN_TEMP, MAX_SNOW_TEMP - real (kind=dbl_kind) :: tffresh + real (kind=dbl_kind) :: Tffresh real (kind=dbl_kind) :: inst_pres_height_lowest + character(len=char_len) :: tfrz_option + integer(int_kind) :: ktherm character(len=*), parameter :: subname = 'ice_import' + character(len=1024) :: msgString !----------------------------------------------------- call icepack_query_parameters(Tffresh_out=Tffresh) + call icepack_query_parameters(tfrz_option_out=tfrz_option) + call icepack_query_parameters(ktherm_out=ktherm) + if (io_dbug > 5) then + write(msgString,'(A,i8)')trim(subname)//' tfrz_option = ' & + // trim(tfrz_option)//', ktherm = ',ktherm + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + end if ! call icepack_query_parameters(tfrz_option_out=tfrz_option, & ! modal_aero_out=modal_aero, z_tracers_out=z_tracers, skl_bgc_out=skl_bgc, & ! Tffresh_out=Tffresh) @@ -612,6 +623,13 @@ subroutine ice_import( importState, rc ) call state_getimport(importState, 'inst_spec_humid_height_lowest_wiso', output=Qa_iso, index=3, ungridded_index=2, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call state_getimport(importState, 'mean_prec_rate_wiso', output=fiso_rain, index=1, ungridded_index=3, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call state_getimport(importState, 'mean_prec_rate_wiso', output=fiso_rain, index=2, ungridded_index=1, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call state_getimport(importState, 'mean_prec_rate_wiso', output=fiso_rain, index=3, ungridded_index=2, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'mean_fprec_rate_wiso', output=fiso_atm, index=1, ungridded_index=3, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_getimport(importState, 'mean_fprec_rate_wiso', output=fiso_atm, index=2, ungridded_index=1, rc=rc) @@ -678,8 +696,7 @@ subroutine ice_import( importState, rc ) do iblk = 1, nblocks do j = 1,ny_block do i = 1,nx_block - !TODO: tcx should this be icepack_sea_freezing_temperature? - Tf (i,j,iblk) = icepack_liquidus_temperature(sss(i,j,iblk)) + Tf(i,j,iblk) = icepack_sea_freezing_temperature(sss(i,j,iblk)) end do end do end do @@ -754,12 +771,12 @@ subroutine ice_export( exportState, rc ) real (kind=dbl_kind) :: tauyo (nx_block,ny_block,max_blocks) ! ice/ocean stress real (kind=dbl_kind) :: ailohi(nx_block,ny_block,max_blocks) ! fractional ice area real (kind=dbl_kind), allocatable :: tempfld(:,:,:) - real (kind=dbl_kind) :: tffresh + real (kind=dbl_kind) :: Tffresh character(len=*),parameter :: subname = 'ice_export' !----------------------------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + if (io_dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) call icepack_query_parameters(Tffresh_out=Tffresh) ! call icepack_query_parameters(tfrz_option_out=tfrz_option, & @@ -888,7 +905,6 @@ subroutine ice_export( exportState, rc ) ! ---- ! surface temperature of ice covered portion (degK) - !call state_setexport(exportState, 'sea_ice_temperature', input=Tsrf , lmask=tmask, ifrac=ailohi, rc=rc) call state_setexport(exportState, 'sea_ice_surface_temperature', input=Tsrf , lmask=tmask, ifrac=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From c360dc212de1fbfa3f53b06ed61cdf26f171c12a Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 4 Oct 2020 17:04:50 -0600 Subject: [PATCH 26/51] fixes to get CESM B1850 compset working --- .../drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 266 +++++++++--------- .../drivers/nuopc/cmeps/ice_import_export.F90 | 21 +- 2 files changed, 146 insertions(+), 141 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index da3d95369..061114cbc 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -17,16 +17,12 @@ module ice_comp_nuopc use NUOPC_Model , only : NUOPC_ModelGet, SetVM use ice_constants , only : ice_init_constants use ice_shr_methods , only : chkerr, state_setscalar, state_getscalar, state_diagnose, alarmInit - use ice_shr_methods , only : set_component_logging, get_component_instance - use ice_shr_methods , only : state_flddebug - use ice_import_export , only : ice_import, ice_export - use ice_import_export , only : ice_advertise_fields, ice_realize_fields + use ice_shr_methods , only : set_component_logging, get_component_instance, state_flddebug + use ice_import_export , only : ice_import, ice_export, ice_advertise_fields, ice_realize_fields use ice_domain_size , only : nx_global, ny_global use ice_domain , only : nblocks, blocks_ice, distrb_info use ice_blocks , only : block, get_block, nx_block, ny_block, nblocks_x, nblocks_y - use ice_blocks , only : nblocks_tot, get_block_parameter - use ice_distribution , only : ice_distributiongetblockloc - use ice_grid , only : tlon, tlat, hm, tarea, ULON, ULAT + use ice_grid , only : tlon, tlat use ice_communicate , only : init_communicate, my_task, master_task, mpi_comm_ice use ice_calendar , only : force_restart_now, write_ic use ice_calendar , only : idate, mday, time, month, daycal, time2sec, year_init @@ -37,6 +33,7 @@ module ice_comp_nuopc use ice_fileunits , only : inst_suffix, release_all_fileunits, flush_fileunit use ice_restart_shared , only : runid, runtype, restart_dir, restart_file use ice_history , only : accum_hist + use ice_flux , only : send_i2x_per_cat use CICE_InitMod , only : cice_init use CICE_RunMod , only : cice_run use ice_exit , only : abort_ice @@ -86,6 +83,8 @@ module ice_comp_nuopc character(len=*),parameter :: shr_cal_noleap = 'NO_LEAP' character(len=*),parameter :: shr_cal_gregorian = 'GREGORIAN' + type(ESMF_Mesh) :: Emesh + integer :: dbug = 0 integer , parameter :: debug_import = 0 ! internal debug level integer , parameter :: debug_export = 0 ! internal debug level @@ -181,6 +180,64 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) character(len=char_len_long) :: cvalue character(len=char_len_long) :: logmsg logical :: isPresent, isSet + real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp + type(ESMF_DistGrid) :: distGrid + type(ESMF_Mesh) :: EmeshTemp + integer :: spatialDim + integer :: numOwnedElements + real(dbl_kind), pointer :: ownedElemCoords(:) + real(dbl_kind), pointer :: lat(:), latMesh(:) + real(dbl_kind), pointer :: lon(:), lonMesh(:) + integer , allocatable :: gindex_ice(:) + integer , allocatable :: gindex_elim(:) + integer , allocatable :: gindex(:) + integer :: globalID + character(len=char_len) :: tfrz_option + type(ESMF_VM) :: vm + type(ESMF_Time) :: currTime ! Current time + type(ESMF_Time) :: startTime ! Start time + type(ESMF_Time) :: stopTime ! Stop time + type(ESMF_Time) :: refTime ! Ref time + type(ESMF_TimeInterval) :: timeStep ! Model timestep + type(ESMF_Calendar) :: esmf_calendar ! esmf calendar + type(ESMF_CalKind_Flag) :: esmf_caltype ! esmf calendar type + integer :: start_ymd ! Start date (YYYYMMDD) + integer :: start_tod ! start time of day (s) + integer :: curr_ymd ! Current date (YYYYMMDD) + integer :: curr_tod ! Current time of day (s) + integer :: stop_ymd ! stop date (YYYYMMDD) + integer :: stop_tod ! stop time of day (sec) + integer :: ref_ymd ! Reference date (YYYYMMDD) + integer :: ref_tod ! reference time of day (s) + integer :: yy,mm,dd ! Temporaries for time query + integer :: iyear ! yyyy + integer :: dtime ! time step + integer :: lmpicom + integer :: shrlogunit ! original log unit + character(len=char_len) :: starttype ! infodata start type + integer :: lsize ! local size of coupling array + integer :: localPet + integer :: n,c,g,i,j,m ! indices + integer :: iblk, jblk ! indices + integer :: ig, jg ! indices + integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain + type(block) :: this_block ! block information for current block + integer :: compid ! component id + character(len=char_len_long) :: tempc1,tempc2 + real(dbl_kind) :: diff_lon + integer :: npes + integer :: num_elim_global + integer :: num_elim_local + integer :: num_elim + integer :: num_ice + integer :: num_elim_gcells ! local number of eliminated gridcells + integer :: num_elim_blocks ! local number of eliminated blocks + integer :: num_total_blocks + integer :: my_elim_start, my_elim_end + real(dbl_kind) :: rad_to_deg + integer(int_kind) :: ktherm + logical :: mastertask + character(len=char_len_long) :: diag_filename = 'unset' character(len=*), parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !-------------------------------- @@ -244,91 +301,13 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) write(logmsg,'(i6)') dbug call ESMF_LogWrite('CICE_cap: dbug = '//trim(logmsg), ESMF_LOGMSG_INFO) - call ice_advertise_fields(gcomp, importState, exportState, flds_scalar_name, rc) + send_i2x_per_cat = .false. + call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - end subroutine InitializeAdvertise - - !=============================================================================== - - subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) - - ! Arguments - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState - type(ESMF_State) :: exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - ! Local variables - real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp - type(ESMF_DistGrid) :: distGrid - type(ESMF_Mesh) :: Emesh, EmeshTemp - integer :: spatialDim - integer :: numOwnedElements - real(dbl_kind), pointer :: ownedElemCoords(:) - real(dbl_kind), pointer :: lat(:), latMesh(:) - real(dbl_kind), pointer :: lon(:), lonMesh(:) - integer , allocatable :: gindex_ice(:) - integer , allocatable :: gindex_elim(:) - integer , allocatable :: gindex(:) - integer :: globalID - character(ESMF_MAXSTR) :: cvalue - character(len=char_len) :: tfrz_option - character(ESMF_MAXSTR) :: convCIM, purpComp - type(ESMF_VM) :: vm - type(ESMF_Time) :: currTime ! Current time - type(ESMF_Time) :: startTime ! Start time - type(ESMF_Time) :: stopTime ! Stop time - type(ESMF_Time) :: refTime ! Ref time - type(ESMF_TimeInterval) :: timeStep ! Model timestep - type(ESMF_Calendar) :: esmf_calendar ! esmf calendar - type(ESMF_CalKind_Flag) :: esmf_caltype ! esmf calendar type - integer :: start_ymd ! Start date (YYYYMMDD) - integer :: start_tod ! start time of day (s) - integer :: curr_ymd ! Current date (YYYYMMDD) - integer :: curr_tod ! Current time of day (s) - integer :: stop_ymd ! stop date (YYYYMMDD) - integer :: stop_tod ! stop time of day (sec) - integer :: ref_ymd ! Reference date (YYYYMMDD) - integer :: ref_tod ! reference time of day (s) - integer :: yy,mm,dd ! Temporaries for time query - integer :: iyear ! yyyy - integer :: dtime ! time step - integer :: lmpicom - integer :: shrlogunit ! original log unit - character(len=char_len) :: starttype ! infodata start type - integer :: lsize ! local size of coupling array - logical :: isPresent - logical :: isSet - integer :: localPet - integer :: n,c,g,i,j,m ! indices - integer :: iblk, jblk ! indices - integer :: ig, jg ! indices - integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain - type(block) :: this_block ! block information for current block - integer :: compid ! component id - character(len=char_len_long) :: tempc1,tempc2 - real(dbl_kind) :: diff_lon - integer :: npes - integer :: num_elim_global - integer :: num_elim_local - integer :: num_elim - integer :: num_ice - integer :: num_elim_gcells ! local number of eliminated gridcells - integer :: num_elim_blocks ! local number of eliminated blocks - integer :: num_total_blocks - integer :: my_elim_start, my_elim_end - real(dbl_kind) :: rad_to_deg - integer(int_kind) :: ktherm - logical :: mastertask - character(len=char_len_long) :: diag_filename = 'unset' - character(len=*), parameter :: F00 = "('(ice_comp_nuopc) ',2a,1x,d21.14)" - character(len=*), parameter :: subname=trim(modName)//':(InitializeRealize) ' - !-------------------------------- - - rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + if (isPresent .and. isSet) then + read(cvalue,*) send_i2x_per_cat + call ESMF_LogWrite('send_i2x_per_cat = '// trim(cvalue), ESMF_LOGMSG_INFO) + end if !---------------------------------------------------------------------------- ! generate local mpi comm @@ -554,14 +533,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Now write output to nu_diag - this must happen AFTER call to cice_init if (mastertask) then - write(nu_diag,F00) trim(subname),' cice init nextsw_cday = ',nextsw_cday - write(nu_diag,*) trim(subname),' tfrz_option = ',trim(tfrz_option) + write(nu_diag,'(a,d21.14)') trim(subname)//' cice init nextsw_cday = ',nextsw_cday + write(nu_diag,'(a)') trim(subname)//' tfrz_option = '//trim(tfrz_option) if (ktherm == 2 .and. trim(tfrz_option) /= 'mushy') then write(nu_diag,*) trim(subname),' Warning: Using ktherm = 2 and tfrz_option = ', trim(tfrz_option) endif - write(nu_diag,*) trim(subname),' inst_name = ',trim(inst_name) - write(nu_diag,*) trim(subname),' inst_index = ',inst_index - write(nu_diag,*) trim(subname),' inst_suffix = ',trim(inst_suffix) + write(nu_diag,'(a )') trim(subname)//' inst_name = '//trim(inst_name) + write(nu_diag,'(a,i8 )') trim(subname)//' inst_index = ',inst_index + write(nu_diag,'(a )') trim(subname)//' inst_suffix = ',trim(inst_suffix) endif !--------------------------------------------------------------------------- @@ -835,10 +814,60 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end if end do + !----------------------------------------------------------------- + ! Prescribed ice initialization + !----------------------------------------------------------------- + + call NUOPC_CompAttributeGet(gcomp, name='MCTID', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) compid ! convert from string to integer + else + compid = 0 + end if + call ice_prescribed_init(lmpicom, compid, gindex_ice) + + !----------------------------------------------------------------- + ! Advertise fields + !----------------------------------------------------------------- + + ! NOTE: the advertise phase needs to be called after the ice + ! initialization since the number of ice categories is needed for + ! ice_fraction_n and mean_sw_pen_to_ocn_ifrac_n + call ice_advertise_fields(gcomp, importState, exportState, flds_scalar_name, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !----------------------------------------------------------------- ! deallocate memory + !----------------------------------------------------------------- + deallocate(ownedElemCoords) deallocate(lon, lonMesh) deallocate(lat, latMesh) + deallocate(gindex_ice) + deallocate(gindex) + + call t_stopf ('cice_init_total') + + end subroutine InitializeAdvertise + + !=============================================================================== + + subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + + ! Arguments + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! Local variables + character(len=*), parameter :: subname=trim(modName)//':(InitializeRealize) ' + !-------------------------------- + + rc = ESMF_SUCCESS + if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) !----------------------------------------------------------------- ! Realize the actively coupled fields @@ -848,19 +877,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_name=flds_scalar_name, flds_scalar_num=flds_scalar_num, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !----------------------------------------------------------------- - ! Prescribed ice initialization - first get compid - !----------------------------------------------------------------- - - call NUOPC_CompAttributeGet(gcomp, name='MCTID', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) compid ! convert from string to integer - else - compid = 0 - end if - call ice_prescribed_init(lmpicom, compid, gindex_ice) - !----------------------------------------------------------------- ! Create cice export state !----------------------------------------------------------------- @@ -875,16 +891,16 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_name, flds_scalar_num, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + !-------------------------------- + ! diagnostics + !-------------------------------- + ! TODO (mvertens, 2018-12-21): fill in iceberg_prognostic as .false. if (debug_export > 0 .and. my_task==master_task) then call State_fldDebug(exportState, flds_scalar_name, 'cice_export:', & idate, sec, nu_diag, rc=rc) end if - !-------------------------------- - ! diagnostics - !-------------------------------- - if (dbug > 0) then call state_diagnose(exportState,subname//':ES',rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -892,11 +908,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) - call t_stopf ('cice_init_total') - - deallocate(gindex_ice) - deallocate(gindex) - call flush_fileunit(nu_diag) end subroutine InitializeRealize @@ -939,7 +950,6 @@ subroutine ModelAdvance(gcomp, rc) character(char_len_long) :: restart_date character(char_len_long) :: restart_filename logical :: isPresent, isSet - character(*) , parameter :: F00 = "('(ice_comp_nuopc) ',2a,i8,d21.14)" character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' character(char_len_long) :: msgString !-------------------------------- @@ -1005,7 +1015,7 @@ subroutine ModelAdvance(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if (my_task == master_task) then - write(nu_diag,F00) trim(subname),' cice istep, nextsw_cday = ',istep, nextsw_cday + write(nu_diag,'(a,2x,i8,2x,d24.14)') trim(subname)//' cice istep, nextsw_cday = ',istep, nextsw_cday end if !-------------------------------- @@ -1283,28 +1293,26 @@ end subroutine ModelSetRunClock !=============================================================================== subroutine ModelFinalize(gcomp, rc) + + !-------------------------------- + ! Finalize routine + !-------------------------------- + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc ! local variables - character(*), parameter :: F00 = "('(ice_comp_nuopc) ',8a)" - character(*), parameter :: F91 = "('(ice_comp_nuopc) ',73('-'))" + character(*), parameter :: F91 = "('(ice_comp_nuopc) ',73('-'))" character(len=*),parameter :: subname=trim(modName)//':(ModelFinalize) ' !-------------------------------- - !-------------------------------- - ! Finalize routine - !-------------------------------- - rc = ESMF_SUCCESS if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - if (my_task == master_task) then write(nu_diag,F91) - write(nu_diag,F00) 'CICE: end of main integration loop' + write(nu_diag,'(a)') 'CICE: end of main integration loop' write(nu_diag,F91) end if - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine ModelFinalize diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index b32085143..a1537a1d8 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -108,7 +108,6 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam character(char_len) :: stdname character(char_len) :: cvalue logical :: flds_wiso ! use case - logical :: flds_i2o_per_cat ! .true. => select per ice thickness category logical :: isPresent, isSet character(len=*), parameter :: subname='(ice_import_export:ice_advertise_fields)' !------------------------------------------------------------------------------- @@ -125,14 +124,6 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call ESMF_LogWrite('flds_wiso = '// trim(cvalue), ESMF_LOGMSG_INFO) end if - flds_i2o_per_cat = .false. - call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) send_i2x_per_cat - call ESMF_LogWrite('flds_i2o_per_cat = '// trim(cvalue), ESMF_LOGMSG_INFO) - end if - !----------------- ! advertise import fields !----------------- @@ -1187,6 +1178,7 @@ subroutine fldlist_realize(state, fldList, numflds, flds_scalar_name, flds_scala integer :: n type(ESMF_Field) :: field character(len=80) :: stdname + character(ESMF_MAXSTR) :: msg character(len=*),parameter :: subname='(ice_import_export:fld_list_realize)' ! ---------------------------------------------- @@ -1203,8 +1195,6 @@ subroutine fldlist_realize(state, fldList, numflds, flds_scalar_name, flds_scala if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (present(mesh)) then - call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected using mesh", & - ESMF_LOGMSG_INFO) ! Create the field if (fldlist(n)%ungridded_lbound > 0 .and. fldlist(n)%ungridded_ubound > 0) then field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, & @@ -1212,9 +1202,16 @@ subroutine fldlist_realize(state, fldList, numflds, flds_scalar_name, flds_scala ungriddedUbound=(/fldlist(n)%ungridded_ubound/), & gridToFieldMap=(/2/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(msg, '(a,i4,2x,i4)') trim(subname)//trim(tag)//" Field = "//trim(stdname)//& + " is connected using mesh with lbound, ubound = ",& + fldlist(n)%ungridded_lbound,fldlist(n)%ungridded_ubound + call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO) else field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(msg, '(a,i4,a,i4)') trim(subname)//trim(tag)//" Field = "//trim(stdname)//& + " is connected using mesh without ungridded dimension" + call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO) end if else if (present(grid)) then call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected using grid", & @@ -1812,7 +1809,7 @@ subroutine State_GetFldPtr_2d(State, fldname, fldptr, rc) call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine State_GetFldPtr_2d From 1a32f3e17fb96b0d9b87730ea553ad81cff83a7f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 5 Oct 2020 14:16:16 -0600 Subject: [PATCH 27/51] refactored ice_prescribed_mod.F90 to work with cdeps rather than the mct data models --- .../drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 8 +- .../nuopc/cmeps/ice_prescribed_mod.F90 | 563 +++++++----------- 2 files changed, 220 insertions(+), 351 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index 061114cbc..becd7fa4e 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -818,14 +818,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Prescribed ice initialization !----------------------------------------------------------------- - call NUOPC_CompAttributeGet(gcomp, name='MCTID', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + call ice_prescribed_init(clock, Emesh, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) compid ! convert from string to integer - else - compid = 0 - end if - call ice_prescribed_init(lmpicom, compid, gindex_ice) !----------------------------------------------------------------- ! Advertise fields diff --git a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 index 78ea39b4e..3ea3704a8 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 @@ -7,39 +7,33 @@ module ice_prescribed_mod ! Ice/ocean fluxes are set to zero, and ice dynamics are not calculated. ! Regridding and data cycling capabilities are included. + use ESMF + #ifndef CESMCOUPLED use ice_kinds_mod - implicit none private ! except - public :: ice_prescribed_init ! initialize input data stream logical(kind=log_kind), parameter, public :: prescribed_ice = .false. ! true if prescribed ice - contains ! This is a stub routine for now - subroutine ice_prescribed_init(mpicom, compid, gindex) - integer(kind=int_kind), intent(in) :: mpicom - integer(kind=int_kind), intent(in) :: compid - integer(kind=int_kind), intent(in) :: gindex(:) + subroutine ice_prescribed_init(clock, mesh, rc) + type(ESMF_Clock) , intent(in) :: clock + type(ESMF_Mesh) , intent(in) :: mesh + integer , intent(out) :: rc ! do nothing end subroutine ice_prescribed_init -#else - - use shr_nl_mod , only : shr_nl_find_group_name - use shr_strdata_mod - use shr_dmodel_mod - use shr_string_mod - use shr_ncread_mod - use shr_sys_mod - use shr_mct_mod - use mct_mod - use pio +#else + + use ice_kinds_mod + use shr_nl_mod , only : shr_nl_find_group_name + use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_print + use dshr_strdata_mod , only : shr_strdata_init_from_inline, shr_strdata_advance + use dshr_methods_mod , only : dshr_fldbun_getfldptr use ice_broadcast use ice_communicate , only : my_task, master_task, MPI_COMM_ICE - use ice_kinds_mod use ice_fileunits use ice_exit , only : abort_ice use ice_domain_size , only : nx_global, ny_global, ncat, nilyr, nslyr, max_blocks @@ -54,306 +48,285 @@ end subroutine ice_prescribed_init use icepack_intfc , only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc , only: icepack_query_tracer_indices, icepack_query_tracer_sizes use icepack_intfc , only: icepack_query_parameters + use ice_shr_methods , only: chkerr implicit none private ! except - ! MEMBER FUNCTIONS: - public :: ice_prescribed_init ! initialize input data stream - public :: ice_prescribed_run ! get time slices and time interp - public :: ice_prescribed_phys ! set prescribed ice state and fluxes - - ! !PUBLIC DATA MEMBERS: - logical(kind=log_kind), public :: prescribed_ice ! true if prescribed ice - integer(kind=int_kind),parameter :: nFilesMaximum = 400 ! max number of files - integer(kind=int_kind) :: stream_year_first ! first year in stream to use - integer(kind=int_kind) :: stream_year_last ! last year in stream to use - integer(kind=int_kind) :: model_year_align ! align stream_year_first with this model year - character(len=char_len_long) :: stream_fldVarName - character(len=char_len_long) :: stream_fldFileName(nFilesMaximum) - character(len=char_len_long) :: stream_domTvarName - character(len=char_len_long) :: stream_domXvarName - character(len=char_len_long) :: stream_domYvarName - character(len=char_len_long) :: stream_domAreaName - character(len=char_len_long) :: stream_domMaskName - character(len=char_len_long) :: stream_domFileName - character(len=char_len_long) :: stream_mapread - logical(kind=log_kind) :: prescribed_ice_fill ! true if data fill required - type(shr_strdata_type) :: sdat ! prescribed data stream - character(len=char_len_long) :: fldList ! list of fields in data stream - real(kind=dbl_kind),allocatable :: ice_cov(:,:,:) ! ice cover + ! public member functions: + public :: ice_prescribed_init ! initialize input data stream + public :: ice_prescribed_run ! get time slices and time interp + public :: ice_prescribed_phys ! set prescribed ice state and fluxes -contains + ! public data members: + logical(kind=log_kind), public :: prescribed_ice ! true if prescribed ice - subroutine ice_prescribed_init(mpicom, compid, gindex) + ! private data members: + type(shr_strdata_type) :: sdat ! prescribed data stream + real(kind=dbl_kind),allocatable :: ice_cov(:,:,:) ! ice cover - ! Prescribed ice initialization - needed to - ! work with new shr_strdata module derived type + character(*), parameter :: u_FILE_u = & + __FILE__ - use shr_pio_mod, only : shr_pio_getiotype, shr_pio_getiosys, shr_pio_getioformat +!======================================================================= +contains +!=============================================================================== + + subroutine ice_prescribed_init(clock, mesh, rc) + + ! Prescribed ice initialization - implicit none include 'mpif.h' - ! !nput/output parameters: - integer(kind=int_kind), intent(in) :: mpicom - integer(kind=int_kind), intent(in) :: compid - integer(kind=int_kind), intent(in) :: gindex(:) + ! input/output parameters + type(ESMF_Clock) , intent(in) :: clock + type(ESMF_Mesh) , intent(in) :: mesh + integer , intent(out) :: rc + + ! local parameters + integer(kind=int_kind),parameter :: nFilesMaximum = 400 ! max number of files + integer(kind=int_kind) :: n, nFile, ierr + integer(kind=int_kind) :: nml_error ! namelist i/o error flag + character(len=char_len_long) :: stream_meshFile + character(len=char_len_long) :: stream_dataFiles(nFilesMaximum) + character(len=char_len_long) :: stream_varname + character(len=char_len_long) :: stream_mapalgo + integer(kind=int_kind) :: stream_yearfirst ! first year in stream to use + integer(kind=int_kind) :: stream_yearlast ! last year in stream to use + integer(kind=int_kind) :: stream_yearalign ! align stream_year_first + integer(kind=int_kind) :: nu_nml + logical :: prescribed_ice_mode + character(*),parameter :: subName = "('ice_prescribed_init')" + character(*),parameter :: F00 = "('(ice_prescribed_init) ',4a)" + character(*),parameter :: F01 = "('(ice_prescribed_init) ',a,i0)" + character(*),parameter :: F02 = "('(ice_prescribed_init) ',2a,i0,)" + !-------------------------------- - !----- Local ------ - type(mct_gsMap) :: gsmap_ice - type(mct_gGrid) :: dom_ice - integer(kind=int_kind) :: lsize - integer(kind=int_kind) :: gsize - integer(kind=int_kind) :: nml_error ! namelist i/o error flag - integer(kind=int_kind) :: n, nFile, ierr - character(len=8) :: fillalgo - character(*),parameter :: subName = '(ice_prescribed_init)' - - namelist /ice_prescribed_nml/ & - prescribed_ice, & - model_year_align, & - stream_year_first , & - stream_year_last , & - stream_fldVarName , & - stream_fldFileName, & - stream_domTvarName, & - stream_domXvarName, & - stream_domYvarName, & - stream_domAreaName, & - stream_domMaskName, & - stream_domFileName, & - stream_mapread, & - prescribed_ice_fill + namelist /ice_prescribed_nml/ & + prescribed_ice_mode, & + stream_meshfile, & + stream_varname , & + stream_datafiles, & + stream_mapalgo, & + stream_yearalign, & + stream_yearfirst , & + stream_yearlast + + rc = ESMF_SUCCESS ! default values for namelist - prescribed_ice = .false. ! if true, prescribe ice - stream_year_first = 1 ! first year in pice stream to use - stream_year_last = 1 ! last year in pice stream to use - model_year_align = 1 ! align stream_year_first with this model year - stream_fldVarName = 'ice_cov' - stream_fldFileName(:) = ' ' - stream_domTvarName = 'time' - stream_domXvarName = 'lon' - stream_domYvarName = 'lat' - stream_domAreaName = 'area' - stream_domMaskName = 'mask' - stream_domFileName = ' ' - stream_mapread = 'NOT_SET' - prescribed_ice_fill = .false. ! true if pice data fill required - - ! read from input file - call get_fileunit(nu_nml) + prescribed_ice_mode = .false. ! if true, prescribe ice + stream_yearfirst = 1 ! first year in pice stream to use + stream_yearlast = 1 ! last year in pice stream to use + stream_yearalign = 1 ! align stream_year_first with this model year + stream_varname = 'ice_cov' + stream_meshfile = ' ' + stream_datafiles(:) = ' ' + stream_mapalgo = 'bilinear' + + ! read namelist on master task if (my_task == master_task) then - open (nu_nml, file=nml_filename, status='old',iostat=nml_error) + open (newunit=nu_nml, file=nml_filename, status='old',iostat=nml_error) call shr_nl_find_group_name(nu_nml, 'ice_prescribed_nml', status=nml_error) - if (nml_error == 0) then - read(nu_nml, ice_prescribed_nml, iostat=nml_error) - if (nml_error > 0) then - call shr_sys_abort( 'problem on read of ice_prescribed namelist in ice_prescribed_mod' ) - endif + if (nml_error /= 0) then + write(nu_diag,F00) "ERROR: problem on read of ice_prescribed_nml namelist" + call abort_ice(subName) endif + read(nu_nml, ice_prescribed_nml, iostat=nml_error) + close(nu_nml) end if - call release_fileunit(nu_nml) - call broadcast_scalar(prescribed_ice, master_task) - - ! *** If not prescribed ice then return *** - if (.not. prescribed_ice) RETURN - - call broadcast_scalar(model_year_align,master_task) - call broadcast_scalar(stream_year_first,master_task) - call broadcast_scalar(stream_year_last,master_task) - call broadcast_scalar(stream_fldVarName,master_task) - call broadcast_scalar(stream_domTvarName,master_task) - call broadcast_scalar(stream_domXvarName,master_task) - call broadcast_scalar(stream_domYvarName,master_task) - call broadcast_scalar(stream_domAreaName,master_task) - call broadcast_scalar(stream_domMaskName,master_task) - call broadcast_scalar(stream_domFileName,master_task) - call broadcast_scalar(stream_mapread,master_task) - call broadcast_scalar(prescribed_ice_fill,master_task) - call mpi_bcast(stream_fldFileName, len(stream_fldFileName(1))*NFilesMaximum, & - MPI_CHARACTER, 0, MPI_COMM_ICE, ierr) - - nFile = 0 - do n=1,nFilesMaximum - if (stream_fldFileName(n) /= ' ') nFile = nFile + 1 - end do - ! Read shr_strdata_nml namelist - if (prescribed_ice_fill) then - fillalgo='nn' - else - fillalgo='none' - endif + ! broadcast namelist input + call broadcast_scalar(prescribed_ice_mode, master_task) - if (my_task == master_task) then - write(nu_diag,*) ' ' - write(nu_diag,*) 'This is the prescribed ice coverage option.' - write(nu_diag,*) ' stream_year_first = ',stream_year_first - write(nu_diag,*) ' stream_year_last = ',stream_year_last - write(nu_diag,*) ' model_year_align = ',model_year_align - write(nu_diag,*) ' stream_fldVarName = ',trim(stream_fldVarName) - do n = 1,nFile - write(nu_diag,*) ' stream_fldFileName = ',trim(stream_fldFileName(n)),n - end do - write(nu_diag,*) ' stream_domTvarName = ',trim(stream_domTvarName) - write(nu_diag,*) ' stream_domXvarName = ',trim(stream_domXvarName) - write(nu_diag,*) ' stream_domYvarName = ',trim(stream_domYvarName) - write(nu_diag,*) ' stream_domFileName = ',trim(stream_domFileName) - write(nu_diag,*) ' stream_mapread = ',trim(stream_mapread) - write(nu_diag,*) ' stream_fillalgo = ',trim(fillalgo) - write(nu_diag,*) ' ' - endif - - gsize = nx_global*ny_global - lsize = size(gindex) - call mct_gsMap_init( gsmap_ice, gindex, MPI_COMM_ICE, compid, lsize, gsize) - call ice_prescribed_set_domain( lsize, MPI_COMM_ICE, gsmap_ice, dom_ice ) - - call shr_strdata_create(sdat,name="prescribed_ice", & - mpicom=MPI_COMM_ICE, compid=compid, & - gsmap=gsmap_ice, ggrid=dom_ice, & - nxg=nx_global,nyg=ny_global, & - yearFirst=stream_year_first, & - yearLast=stream_year_last, & - yearAlign=model_year_align, & - offset=0, & - domFilePath='', & - domFileName=trim(stream_domFileName), & - domTvarName=stream_domTvarName, & - domXvarName=stream_domXvarName, & - domYvarName=stream_domYvarName, & - domAreaName=stream_domAreaName, & - domMaskName=stream_domMaskName, & - filePath='', & - filename=stream_fldFileName(1:nFile), & - fldListFile=stream_fldVarName, & - fldListModel=stream_fldVarName, & - fillalgo=trim(fillalgo), & - calendar=trim(calendar_type), & - mapread=trim(stream_mapread)) + ! set module variable 'prescribed_ice' + prescribed_ice = prescribed_ice_mode - if (my_task == master_task) then - call shr_strdata_print(sdat,'SPRESICE data') - endif + ! -------------------------------------------------- + ! only do the following if prescribed ice mode is on + ! -------------------------------------------------- - !----------------------------------------------------------------- - ! For one ice category, set hin_max(1) to something big - !----------------------------------------------------------------- - if (ncat == 1) then - hin_max(1) = 999._dbl_kind - end if - end subroutine ice_prescribed_init + if (prescribed_ice_mode) then - !======================================================================= - subroutine ice_prescribed_run(mDateIn, secIn) + call broadcast_scalar(stream_yearalign , master_task) + call broadcast_scalar(stream_yearfirst , master_task) + call broadcast_scalar(stream_yearlast , master_task) + call broadcast_scalar(stream_meshfile , master_task) + call broadcast_scalar(stream_mapalgo , master_task) + call broadcast_scalar(stream_varname , master_task) + call mpi_bcast(stream_dataFiles, len(stream_datafiles(1))*NFilesMaximum, MPI_CHARACTER, 0, MPI_COMM_ICE, ierr) + + nFile = 0 + do n = 1,nFilesMaximum + if (stream_datafiles(n) /= ' ') nFile = nFile + 1 + end do - ! !DESCRIPTION: - ! Finds two time slices bounding current model time, remaps if necessary + if (my_task == master_task) then + write(nu_diag,*) ' ' + write(nu_diag,F00) 'This is the prescribed ice coverage option.' + write(nu_diag,F01) ' stream_yearfirst = ',stream_yearfirst + write(nu_diag,F01) ' stream_yearlast = ',stream_yearlast + write(nu_diag,F01) ' stream_yearalign = ',stream_yearalign + write(nu_diag,F00) ' stream_meshfile = ',trim(stream_meshfile) + write(nu_diag,F00) ' stream_varname = ',trim(stream_varname) + write(nu_diag,F00) ' stream_mapalgo = ',trim(stream_mapalgo) + do n = 1,nFile + write(nu_diag,F00) ' stream_datafiles = ',trim(stream_dataFiles(n)) + end do + write(nu_diag,*) ' ' + endif + + ! initialize sdat + call shr_strdata_init_from_inline(sdat, & + my_task = my_task, & + logunit = nu_diag, & + compname = 'ICE', & + model_clock = clock, & + model_mesh = mesh, & + stream_meshfile = stream_meshfile, & + stream_lev_dimname = 'null', & + stream_mapalgo = trim(stream_mapalgo), & + stream_filenames = stream_datafiles(1:nfile), & + stream_fldlistFile = (/'ice_cov'/), & + stream_fldListModel = (/'ice_cov'/), & + stream_yearFirst = stream_yearFirst, & + stream_yearLast = stream_yearLast, & + stream_yearAlign = stream_yearAlign , & + stream_offset = 0, & + stream_taxmode = 'cycle', & + stream_dtlimit = 1.5_dbl_kind, & + stream_tintalgo = 'linear', & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! print out sdat info + if (my_task == master_task) then + call shr_strdata_print(sdat,'ice coverage prescribed data') + endif - implicit none + ! For one ice category, set hin_max(1) to something big + if (ncat == 1) then + hin_max(1) = 999._dbl_kind + end if - ! !INPUT/OUTPUT PARAMETERS: - integer(kind=int_kind), intent(in) :: mDateIn ! Current model date (yyyymmdd) - integer(kind=int_kind), intent(in) :: secIn ! Elapsed seconds on model date + end if ! end of if prescribed ice mode - ! local varaibles - integer(kind=int_kind) :: i,j,n,iblk ! loop indices and counter - integer(kind=int_kind) :: ilo,ihi,jlo,jhi ! beginning and end of physical domain - type (block) :: this_block - real(kind=dbl_kind) :: aice_max ! maximun ice concentration - logical, save :: first_time = .true. - character(*),parameter :: subName = '(ice_prescribed_run)' - character(*),parameter :: F00 = "(a,2g20.13)" + end subroutine ice_prescribed_init - !------------------------------------------------------------------------ + !======================================================================= + subroutine ice_prescribed_run(mDateIn, secIn) + + ! Finds two time slices bounding current model time, remaps if necessary ! Interpolate to new ice coverage + + ! input/output parameters: + integer(kind=int_kind), intent(in) :: mDateIn ! Current model date (yyyymmdd) + integer(kind=int_kind), intent(in) :: secIn ! Elapsed seconds on model date + + ! local variables + integer(kind=int_kind) :: i,j,n,iblk ! loop indices and counter + integer(kind=int_kind) :: ilo,ihi,jlo,jhi ! beginning and end of physical domain + type (block) :: this_block + real(kind=dbl_kind) :: aice_max ! maximun ice concentration + real(kind=dbl_kind), pointer :: dataptr(:) + integer :: rc ! ESMF return code + character(*),parameter :: subName = "('ice_prescribed_run')" + character(*),parameter :: F00 = "('(ice_prescribed_run) ',a,2g20.13)" + logical :: first_time = .true. !------------------------------------------------------------------------ - call shr_strdata_advance(sdat,mDateIn,SecIn,MPI_COMM_ICE,'cice_pice') + rc = ESMF_SUCCESS - if (first_time) then - allocate(ice_cov(nx_block,ny_block,max_blocks)) - endif + ! Advance sdat stream + call shr_strdata_advance(sdat, ymd=mDateIn, tod=SecIn, logunit=nu_diag, istr='cice_pice', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if - ice_cov(:,:,:) = c0 ! This initializes ghost cells as well + ! Get pointer for stream data that is time and spatially interpolate to model time and grid + call dshr_fldbun_getFldPtr(sdat%pstrm(1)%fldbun_model, 'ice_cov', dataptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if - n=0 + ! Fill in module ice_cov array + ice_cov(:,:,:) = c0 ! This initializes ghost cells as well + n = 0 do iblk = 1, nblocks this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo jhi = this_block%jhi - do j = jlo, jhi do i = ilo, ihi n = n+1 - ice_cov(i,j,iblk) = sdat%avs(1)%rAttr(1,n) + ice_cov(i,j,iblk) = dataptr(n) end do end do end do - !-------------------------------------------------------------------- ! Check to see that ice concentration is in fraction, not percent - !-------------------------------------------------------------------- if (first_time) then aice_max = maxval(ice_cov) - if (aice_max > c10) then - write(nu_diag,F00) subname//" ERROR: Ice conc data must be in fraction, aice_max= ",& - aice_max - call abort_ice(subName) + write(nu_diag,F00) "ERROR: Ice conc data must be in fraction, aice_max= ", aice_max + rc = ESMF_FAILURE + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if end if first_time = .false. end if - !----------------------------------------------------------------- ! Set prescribed ice state and fluxes - !----------------------------------------------------------------- - call ice_prescribed_phys() end subroutine ice_prescribed_run - !=============================================================================== - subroutine ice_prescribed_phys + !======================================================================= + subroutine ice_prescribed_phys() ! Set prescribed ice state using input ice concentration; ! set surface ice temperature to atmospheric value; use ! linear temperature gradient in ice to ocean temperature. - ! !USES: use ice_flux use ice_state use icepack_intfc, only : icepack_aggregate use ice_dyn_evp - implicit none !----- Local ------ integer(kind=int_kind) :: layer ! level index integer(kind=int_kind) :: nc ! ice category index integer(kind=int_kind) :: i,j,k ! longitude, latitude and level indices integer(kind=int_kind) :: iblk - integer(kind=int_kind) :: nt_Tsfc, nt_sice, nt_qice, nt_qsno, ntrcr - - real(kind=dbl_kind) :: slope ! diff in underlying ocean tmp and ice surface tmp - real(kind=dbl_kind) :: Ti ! ice level temperature - real(kind=dbl_kind) :: Tmlt ! ice level melt temperature - real(kind=dbl_kind) :: qin_save(nilyr) - real(kind=dbl_kind) :: qsn_save(nslyr) - real(kind=dbl_kind) :: hi ! ice prescribed (hemispheric) ice thickness - real(kind=dbl_kind) :: hs ! snow thickness - real(kind=dbl_kind) :: zn ! normalized ice thickness - real(kind=dbl_kind) :: salin(nilyr) ! salinity (ppt) - real(kind=dbl_kind) :: rad_to_deg, pi, puny - real(kind=dbl_kind) :: rhoi, rhos, cp_ice, cp_ocn, lfresh, depressT - + integer(kind=int_kind) :: nt_Tsfc + integer(kind=int_kind) :: nt_sice + integer(kind=int_kind) :: nt_qice + integer(kind=int_kind) :: nt_qsno + integer(kind=int_kind) :: ntrcr + real(kind=dbl_kind) :: slope ! diff in underlying ocean tmp and ice surface tmp + real(kind=dbl_kind) :: Ti ! ice level temperature + real(kind=dbl_kind) :: Tmlt ! ice level melt temperature + real(kind=dbl_kind) :: qin_save(nilyr) + real(kind=dbl_kind) :: qsn_save(nslyr) + real(kind=dbl_kind) :: hi ! ice prescribed (hemispheric) ice thickness + real(kind=dbl_kind) :: hs ! snow thickness + real(kind=dbl_kind) :: zn ! normalized ice thickness + real(kind=dbl_kind) :: salin(nilyr) ! salinity (ppt) + real(kind=dbl_kind) :: rad_to_deg, pi, puny + real(kind=dbl_kind) :: rhoi + real(kind=dbl_kind) :: rhos + real(kind=dbl_kind) :: cp_ice + real(kind=dbl_kind) :: cp_ocn + real(kind=dbl_kind) :: lfresh + real(kind=dbl_kind) :: depressT real(kind=dbl_kind), parameter :: nsal = 0.407_dbl_kind real(kind=dbl_kind), parameter :: msal = 0.573_dbl_kind real(kind=dbl_kind), parameter :: saltmax = 3.2_dbl_kind ! max salinity at ice base (ppm) character(*),parameter :: subName = '(ice_prescribed_phys)' + !----------------------------------------------------------------- call icepack_query_tracer_indices(nt_Tsfc_out=nt_Tsfc, nt_sice_out=nt_sice, & nt_qice_out=nt_qice, nt_qsno_out=nt_qsno) @@ -458,7 +431,7 @@ subroutine ice_prescribed_phys trcrn(i,j,nt_sice:nt_sice+nilyr-1,:,iblk) = c0 trcrn(i,j,nt_qice:nt_qice+nilyr-1,:,iblk) = c0 trcrn(i,j,nt_qsno:nt_qsno+nslyr-1,:,iblk) = c0 - end if ! ice_cov >= eps04 + end if ! ice_cov >= eps04 !-------------------------------------------------------------------- ! compute aggregate ice state and open water area @@ -478,10 +451,11 @@ subroutine ice_prescribed_phys trcr_base = trcr_base(1:ntrcr,:), & n_trcr_strata = n_trcr_strata(1:ntrcr), & nt_strata = nt_strata(1:ntrcr,:)) - end if ! tmask - enddo ! i - enddo ! j - enddo ! iblk + + end if ! tmask + enddo ! i + enddo ! j + enddo ! iblk do iblk = 1, nblocks do j = 1, ny_block @@ -509,105 +483,6 @@ subroutine ice_prescribed_phys end subroutine ice_prescribed_phys - !=============================================================================== - subroutine ice_prescribed_set_domain( lsize, mpicom, gsmap_i, dom_i ) - - ! Arguments - integer , intent(in) :: lsize - integer , intent(in) :: mpicom - type(mct_gsMap), intent(in) :: gsMap_i - type(mct_ggrid), intent(inout) :: dom_i - - ! Local Variables - integer :: i, j, iblk, n ! indices - integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain - real(dbl_kind), pointer :: data1(:) ! temporary - real(dbl_kind), pointer :: data2(:) ! temporary - real(dbl_kind), pointer :: data3(:) ! temporary - real(dbl_kind), pointer :: data4(:) ! temporary - real(dbl_kind), pointer :: data5(:) ! temporary - real(dbl_kind), pointer :: data6(:) ! temporary - integer , pointer :: idata(:) ! temporary - real(kind=dbl_kind) :: rad_to_deg - type(block) :: this_block ! block information for current block - character(*),parameter :: subName = '(ice_prescribed_set_domain)' - !-------------------------------- - - call icepack_query_parameters(rad_to_deg_out=rad_to_deg) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - - ! Initialize mct domain type - call mct_gGrid_init(GGrid=dom_i, & - CoordChars='lat:lon:hgt', OtherChars='area:aream:mask:frac', lsize=lsize ) - call mct_aVect_zero(dom_i%data) - - ! Determine global gridpoint number attribute, GlobGridNum, which is set automatically by MCT - call mct_gsMap_orderedPoints(gsMap_i, my_task, idata) - call mct_gGrid_importIAttr(dom_i,'GlobGridNum',idata,lsize) - deallocate(idata) - - ! Determine domain (numbering scheme is: West to East and South to North to South pole) - ! Initialize attribute vector with special value - - allocate(data1(lsize)) - allocate(data2(lsize)) - allocate(data3(lsize)) - allocate(data4(lsize)) - allocate(data5(lsize)) - allocate(data6(lsize)) - - data1(:) = -9999.0_dbl_kind - data2(:) = -9999.0_dbl_kind - data3(:) = -9999.0_dbl_kind - data4(:) = -9999.0_dbl_kind - call mct_gGrid_importRAttr(dom_i,"lat" ,data1,lsize) - call mct_gGrid_importRAttr(dom_i,"lon" ,data2,lsize) - call mct_gGrid_importRAttr(dom_i,"area" ,data3,lsize) - call mct_gGrid_importRAttr(dom_i,"aream",data4,lsize) - data5(:) = 0.0_dbl_kind - data6(:) = 0.0_dbl_kind - call mct_gGrid_importRAttr(dom_i,"mask" ,data5,lsize) - call mct_gGrid_importRAttr(dom_i,"frac" ,data6,lsize) - - ! Fill in correct values for domain components - ! lat/lon in degrees, area in radians^2, mask is 1 (ocean), 0 (non-ocean) - n=0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - do j = jlo, jhi - do i = ilo, ihi - n = n+1 - - data1(n) = TLON(i,j,iblk)*rad_to_deg - data2(n) = TLAT(i,j,iblk)*rad_to_deg - data3(n) = tarea(i,j,iblk)/(radius*radius) - - data5(n) = real(nint(hm(i,j,iblk)),kind=dbl_kind) - if (trim(grid_type) == 'latlon') then - data6(n) = ocn_gridcell_frac(i,j,iblk) - else - data6(n) = real(nint(hm(i,j,iblk)),kind=dbl_kind) - end if - - enddo !i - enddo !j - enddo !iblk - call mct_gGrid_importRattr(dom_i,"lon" ,data1,lsize) - call mct_gGrid_importRattr(dom_i,"lat" ,data2,lsize) - call mct_gGrid_importRattr(dom_i,"area",data3,lsize) - call mct_gGrid_importRattr(dom_i,"mask",data5,lsize) - call mct_gGrid_importRattr(dom_i,"frac",data6,lsize) - - deallocate(data1, data2, data3, data4, data5, data6) - - end subroutine ice_prescribed_set_domain - #endif end module ice_prescribed_mod From e48dd386d858f26a760bbfbe95d2bb4e0673800c Mon Sep 17 00:00:00 2001 From: David Bailey Date: Tue, 26 Jan 2021 09:56:41 -0700 Subject: [PATCH 28/51] Fix use_restart_time --- cicecore/cicedynB/general/ice_init.F90 | 4 ++-- cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 6 +++++- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/cicecore/cicedynB/general/ice_init.F90 b/cicecore/cicedynB/general/ice_init.F90 index d3b096eb3..bde2829da 100644 --- a/cicecore/cicedynB/general/ice_init.F90 +++ b/cicecore/cicedynB/general/ice_init.F90 @@ -269,12 +269,10 @@ subroutine input_data dumpfreq='y' ! restart frequency option dumpfreq_n = 1 ! restart frequency dump_last = .false. ! write restart on last time step - restart = .false. ! if true, read restart files for initialization restart_dir = './' ! write to executable dir for default restart_file = 'iced' ! restart file name prefix restart_ext = .false. ! if true, read/write ghost cells restart_coszen = .false. ! if true, read/write coszen - use_restart_time = .true. ! if true, use time info written in file pointer_file = 'ice.restart_file' restart_format = 'default' ! restart file format lcdf64 = .false. ! 64 bit offset for netCDF @@ -402,6 +400,8 @@ subroutine input_data #ifndef CESMCOUPLED runid = 'unknown' ! run ID used in CESM and for machine 'bering' runtype = 'initial' ! run type: 'initial', 'continue' + restart = .false. ! if true, read restart files for initialization + use_restart_time = .true. ! if true, use time info written in file #endif ! extra tracers diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index becd7fa4e..b70e3417b 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -31,7 +31,7 @@ module ice_comp_nuopc use ice_scam , only : scmlat, scmlon, single_column use ice_fileunits , only : nu_diag, nu_diag_set, inst_index, inst_name use ice_fileunits , only : inst_suffix, release_all_fileunits, flush_fileunit - use ice_restart_shared , only : runid, runtype, restart_dir, restart_file + use ice_restart_shared , only : runid, runtype, restart, use_restart_time, restart_dir, restart_file use ice_history , only : accum_hist use ice_flux , only : send_i2x_per_cat use CICE_InitMod , only : cice_init @@ -401,8 +401,12 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) runtype = "initial" else if (trim(starttype) == trim('continue') ) then runtype = "continue" + restart = .true. + use_restart_time = .true. else if (trim(starttype) == trim('branch')) then runtype = "continue" + restart = .true. + use_restart_time = .true. else call abort_ice( subname//' ERROR: unknown starttype' ) end if From f59b5c3d6846787f5c72938a83b77b78fa032dea Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 28 Jan 2021 11:41:28 -0700 Subject: [PATCH 29/51] changes for creating masks at runtime --- cicecore/cicedynB/general/ice_init.F90 | 2 +- cicecore/cicedynB/infrastructure/ice_grid.F90 | 285 ------ cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 | 844 +++++++++--------- .../drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 315 ++----- 4 files changed, 484 insertions(+), 962 deletions(-) diff --git a/cicecore/cicedynB/general/ice_init.F90 b/cicecore/cicedynB/general/ice_init.F90 index bde2829da..3a5a8ee03 100644 --- a/cicecore/cicedynB/general/ice_init.F90 +++ b/cicecore/cicedynB/general/ice_init.F90 @@ -1604,7 +1604,7 @@ subroutine input_data grid_type /= 'rectangular' .and. & grid_type /= 'cpom_grid' .and. & grid_type /= 'regional' .and. & - grid_type /= 'latlon' ) then + grid_type /= 'setmask' ) then if (my_task == master_task) write(nu_diag,*) subname//' ERROR: unknown grid_type=',trim(grid_type) abort_list = trim(abort_list)//":20" endif diff --git a/cicecore/cicedynB/infrastructure/ice_grid.F90 b/cicecore/cicedynB/infrastructure/ice_grid.F90 index 34b37cf29..ce1af48d8 100644 --- a/cicecore/cicedynB/infrastructure/ice_grid.F90 +++ b/cicecore/cicedynB/infrastructure/ice_grid.F90 @@ -368,11 +368,6 @@ subroutine init_grid2 else call popgrid ! read POP grid lengths directly endif -#ifdef CESMCOUPLED - elseif (trim(grid_type) == 'latlon') then - call latlongrid ! lat lon grid for sequential CESM (CAM mode) - return -#endif elseif (trim(grid_type) == 'cpom_grid') then call cpomgrid ! cpom model orca1 type grid else @@ -882,286 +877,6 @@ subroutine popgrid_nc end subroutine popgrid_nc -#ifdef CESMCOUPLED -!======================================================================= - -! Read in kmt file that matches CAM lat-lon grid and has single column -! functionality -! author: Mariana Vertenstein -! 2007: Elizabeth Hunke upgraded to netcdf90 and cice ncdf calls - - subroutine latlongrid - -! use ice_boundary - use ice_domain_size - use ice_scam, only : scmlat, scmlon, single_column - use ice_constants, only: c0, c1, p5, p25, & - field_loc_center, field_type_scalar, radius -#ifdef USE_NETCDF - use netcdf -#endif - - integer (kind=int_kind) :: & - i, j, iblk - - integer (kind=int_kind) :: & - ni, nj, ncid, dimid, varid, ier - - type (block) :: & - this_block ! block information for current block - - integer (kind=int_kind) :: & - ilo,ihi,jlo,jhi ! beginning and end of physical domain - - real (kind=dbl_kind) :: & - closelat, & ! Single-column latitude value - closelon, & ! Single-column longitude value - closelatidx, & ! Single-column latitude index to retrieve - closelonidx ! Single-column longitude index to retrieve - - integer (kind=int_kind) :: & - start(2), & ! Start index to read in - count(2) ! Number of points to read in - - integer (kind=int_kind) :: & - start3(3), & ! Start index to read in - count3(3) ! Number of points to read in - - integer (kind=int_kind) :: & - status ! status flag - - real (kind=dbl_kind), allocatable :: & - lats(:),lons(:),pos_lons(:), glob_grid(:,:) ! temporaries - - real (kind=dbl_kind) :: & - pos_scmlon,& ! temporary - pi, & - puny, & - scamdata ! temporary - - character(len=*), parameter :: subname = '(lonlatgrid)' - -#ifdef USE_NETCDF - !----------------------------------------------------------------- - ! - kmt file is actually clm fractional land file - ! - Determine consistency of dimensions - ! - Read in lon/lat centers in degrees from kmt file - ! - Read in ocean from "kmt" file (1 for ocean, 0 for land) - !----------------------------------------------------------------- - - call icepack_query_parameters(pi_out=pi, puny_out=puny) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - - ! Determine dimension of domain file and check for consistency - - if (my_task == master_task) then - call ice_open_nc(kmt_file, ncid) - - status = nf90_inq_dimid (ncid, 'ni', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=ni) - status = nf90_inq_dimid (ncid, 'nj', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=nj) - end if - - ! Determine start/count to read in for either single column or global lat-lon grid - ! If single_column, then assume that only master_task is used since there is only one task - - if (single_column) then - ! Check for consistency - if (my_task == master_task) then - if ((nx_global /= 1).or. (ny_global /= 1)) then - write(nu_diag,*) 'Because you have selected the column model flag' - write(nu_diag,*) 'Please set nx_global=ny_global=1 in file' - write(nu_diag,*) 'ice_domain_size.F and recompile' - call abort_ice (subname//'ERROR: check nx_global, ny_global') - endif - end if - - ! Read in domain file for single column - allocate(lats(nj)) - allocate(lons(ni)) - allocate(pos_lons(ni)) - allocate(glob_grid(ni,nj)) - - start3=(/1,1,1/) - count3=(/ni,nj,1/) - status = nf90_inq_varid(ncid, 'xc' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid xc') - status = nf90_get_var(ncid, varid, glob_grid, start3, count3) - if (status /= nf90_noerr) call abort_ice (subname//' get_var xc') - do i = 1,ni - lons(i) = glob_grid(i,1) - end do - - status = nf90_inq_varid(ncid, 'yc' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid yc') - status = nf90_get_var(ncid, varid, glob_grid, start3, count3) - if (status /= nf90_noerr) call abort_ice (subname//' get_var yc') - do j = 1,nj - lats(j) = glob_grid(1,j) - end do - - ! convert lons array and scmlon to 0,360 and find index of value closest to 0 - ! and obtain single-column longitude/latitude indices to retrieve - - pos_lons(:)= mod(lons(:) + 360._dbl_kind,360._dbl_kind) - pos_scmlon = mod(scmlon + 360._dbl_kind,360._dbl_kind) - start(1) = (MINLOC(abs(pos_lons-pos_scmlon),dim=1)) - start(2) = (MINLOC(abs(lats -scmlat ),dim=1)) - - deallocate(lats) - deallocate(lons) - deallocate(pos_lons) - deallocate(glob_grid) - - status = nf90_inq_varid(ncid, 'xc' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid xc') - status = nf90_get_var(ncid, varid, scamdata, start) - if (status /= nf90_noerr) call abort_ice (subname//' get_var xc') - TLON = scamdata - status = nf90_inq_varid(ncid, 'yc' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid yc') - status = nf90_get_var(ncid, varid, scamdata, start) - if (status /= nf90_noerr) call abort_ice (subname//' get_var yc') - TLAT = scamdata - status = nf90_inq_varid(ncid, 'area' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid area') - status = nf90_get_var(ncid, varid, scamdata, start) - if (status /= nf90_noerr) call abort_ice (subname//' get_var are') - tarea = scamdata - status = nf90_inq_varid(ncid, 'mask' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid mask') - status = nf90_get_var(ncid, varid, scamdata, start) - if (status /= nf90_noerr) call abort_ice (subname//' get_var mask') - hm = scamdata - status = nf90_inq_varid(ncid, 'frac' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid frac') - status = nf90_get_var(ncid, varid, scamdata, start) - if (status /= nf90_noerr) call abort_ice (subname//' get_var frac') - ocn_gridcell_frac = scamdata - else - ! Check for consistency - if (my_task == master_task) then - if (nx_global /= ni .and. ny_global /= nj) then - write(nu_diag,*) 'latlongrid: ni,nj = ',ni,nj - write(nu_diag,*) 'latlongrid: nx_g,ny_g = ',nx_global, ny_global - call abort_ice (subname//'ERROR: ni,nj not equal to nx_global,ny_global') - end if - end if - - ! Read in domain file for global lat-lon grid - call ice_read_nc(ncid, 1, 'xc' , TLON , diag=.true.) - call ice_read_nc(ncid, 1, 'yc' , TLAT , diag=.true.) - call ice_read_nc(ncid, 1, 'area', tarea , diag=.true., & - field_loc=field_loc_center,field_type=field_type_scalar) - call ice_read_nc(ncid, 1, 'mask', hm , diag=.true.) - call ice_read_nc(ncid, 1, 'frac', ocn_gridcell_frac, diag=.true.) - end if - - if (my_task == master_task) then - call ice_close_nc(ncid) - end if - - !$OMP PARALLEL DO PRIVATE(iblk,this_block,ilo,ihi,jlo,jhi,i,j) - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - - do j = jlo, jhi - do i = ilo, ihi - ! Convert from degrees to radians - TLON(i,j,iblk) = pi*TLON(i,j,iblk)/180._dbl_kind - - ! Convert from degrees to radians - TLAT(i,j,iblk) = pi*TLAT(i,j,iblk)/180._dbl_kind - - ! Convert from radians^2 to m^2 - ! (area in domain file is in radians^2 and tarea is in m^2) - tarea(i,j,iblk) = tarea(i,j,iblk) * (radius*radius) - end do - end do - end do - !$OMP END PARALLEL DO - - !----------------------------------------------------------------- - ! Calculate various geometric 2d arrays - ! The U grid (velocity) is not used when run with sequential CAM - ! because we only use thermodynamic sea ice. However, ULAT is used - ! in the default initialization of CICE so we calculate it here as - ! a "dummy" so that CICE will initialize with ice. If a no ice - ! initialization is OK (or desired) this can be commented out and - ! ULAT will remain 0 as specified above. ULAT is located at the - ! NE corner of the grid cell, TLAT at the center, so here ULAT is - ! hacked by adding half the latitudinal spacing (in radians) to - ! TLAT. - !----------------------------------------------------------------- - - !$OMP PARALLEL DO PRIVATE(iblk,this_block,ilo,ihi,jlo,jhi,i,j) - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - - do j = jlo, jhi - do i = ilo, ihi - - if (ny_global == 1) then - uarea(i,j,iblk) = tarea(i,j, iblk) - else - uarea(i,j,iblk) = p25* & - (tarea(i,j, iblk) + tarea(i+1,j, iblk) & - + tarea(i,j+1,iblk) + tarea(i+1,j+1,iblk)) - endif - tarear(i,j,iblk) = c1/tarea(i,j,iblk) - uarear(i,j,iblk) = c1/uarea(i,j,iblk) - tinyarea(i,j,iblk) = puny*tarea(i,j,iblk) - - if (single_column) then - ULAT (i,j,iblk) = TLAT(i,j,iblk)+(pi/nj) - else - if (ny_global == 1) then - ULAT (i,j,iblk) = TLAT(i,j,iblk) - else - ULAT (i,j,iblk) = TLAT(i,j,iblk)+(pi/ny_global) - endif - endif - ULON (i,j,iblk) = c0 - ANGLE (i,j,iblk) = c0 - - ANGLET(i,j,iblk) = c0 - HTN (i,j,iblk) = 1.e36_dbl_kind - HTE (i,j,iblk) = 1.e36_dbl_kind - dxt (i,j,iblk) = 1.e36_dbl_kind - dyt (i,j,iblk) = 1.e36_dbl_kind - dxu (i,j,iblk) = 1.e36_dbl_kind - dyu (i,j,iblk) = 1.e36_dbl_kind - dxhy (i,j,iblk) = 1.e36_dbl_kind - dyhx (i,j,iblk) = 1.e36_dbl_kind - cyp (i,j,iblk) = 1.e36_dbl_kind - cxp (i,j,iblk) = 1.e36_dbl_kind - cym (i,j,iblk) = 1.e36_dbl_kind - cxm (i,j,iblk) = 1.e36_dbl_kind - enddo - enddo - enddo - !$OMP END PARALLEL DO - - call makemask -#else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) -#endif - - end subroutine latlongrid -#endif - !======================================================================= ! Regular rectangular grid and mask diff --git a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 index 917774908..a585dd331 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 @@ -1,444 +1,446 @@ -!======================================================================= -! -! This module contains the CICE initialization routine that sets model -! parameters and initializes the grid and CICE state variables. -! -! authors Elizabeth C. Hunke, LANL -! William H. Lipscomb, LANL -! Philip W. Jones, LANL -! -! 2006: Converted to free form source (F90) by Elizabeth Hunke -! 2008: E. Hunke moved ESMF code to its own driver - - module CICE_InitMod - - use ice_kinds_mod - use ice_exit, only: abort_ice - use ice_fileunits, only: init_fileunits, nu_diag - use icepack_intfc, only: icepack_aggregate - use icepack_intfc, only: icepack_init_itd, icepack_init_itd_hist - use icepack_intfc, only: icepack_init_fsd_bounds, icepack_init_wave - use icepack_intfc, only: icepack_configure - use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted - use icepack_intfc, only: icepack_query_parameters, icepack_query_tracer_flags, & - icepack_query_tracer_indices, icepack_query_tracer_sizes - - implicit none - private - public :: cice_init +module CICE_InitMod -!======================================================================= + ! Initialize CICE model. - contains + use ice_kinds_mod + use ice_exit, only: abort_ice + use ice_fileunits, only: init_fileunits, nu_diag + use icepack_intfc, only: icepack_aggregate + use icepack_intfc, only: icepack_init_itd, icepack_init_itd_hist + use icepack_intfc, only: icepack_init_fsd_bounds, icepack_init_wave + use icepack_intfc, only: icepack_configure + use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted + use icepack_intfc, only: icepack_query_parameters, icepack_query_tracer_flags + use icepack_intfc, only: icepack_query_tracer_indices, icepack_query_tracer_sizes + implicit none + private + public :: cice_init + +!======================================================================= +contains !======================================================================= -! -! Initialize CICE model. - - subroutine cice_init - - ! Initialize the basic state, grid and all necessary parameters for - ! running the CICE model. - - use ice_arrays_column, only: hin_max, c_hi_range, alloc_arrays_column - use ice_arrays_column, only: floe_rad_l, floe_rad_c, & - floe_binwidth, c_fsd_range - use ice_state, only: alloc_state - use ice_flux_bgc, only: alloc_flux_bgc - use ice_calendar, only: dt, dt_dyn, time, istep, istep1, write_ic, & - init_calendar, calendar - use ice_communicate, only: my_task, master_task - use ice_diagnostics, only: init_diags - use ice_domain, only: init_domain_blocks - use ice_domain_size, only: ncat, nfsd - use ice_dyn_eap, only: init_eap, alloc_dyn_eap - use ice_dyn_shared, only: kdyn, init_evp, alloc_dyn_shared - use ice_flux, only: init_coupler_flux, init_history_therm, & - init_history_dyn, init_flux_atm, init_flux_ocn, alloc_flux - use ice_forcing, only: init_forcing_ocn - use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & - faero_default, faero_optics, alloc_forcing_bgc, fiso_default - use ice_grid, only: init_grid1, init_grid2, alloc_grid - use ice_history, only: init_hist, accum_hist - use ice_restart_shared, only: restart, runtype - use ice_init, only: input_data, init_state - use ice_init_column, only: init_thermo_vertical, init_shortwave, init_zbgc, input_zbgc, count_tracers - use ice_kinds_mod - use ice_restoring, only: ice_HaloRestore_init - use ice_timers, only: timer_total, init_ice_timers, ice_timer_start - use ice_transport_driver, only: init_transport - - logical(kind=log_kind) :: tr_aero, tr_zaero, skl_bgc, z_tracers, & - tr_iso, tr_fsd, wave_spec - character(len=*), parameter :: subname = '(cice_init)' - - call init_fileunits ! unit numbers - - call icepack_configure() ! initialize icepack - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(trim(subname), & - file=__FILE__,line= __LINE__) - - call input_data ! namelist variables - call input_zbgc ! vertical biogeochemistry namelist - call count_tracers ! count tracers - - call init_domain_blocks ! set up block decomposition - call init_grid1 ! domain distribution - call alloc_grid ! allocate grid arrays - call alloc_arrays_column ! allocate column arrays - call alloc_state ! allocate state arrays - call alloc_dyn_shared ! allocate dyn shared arrays - call alloc_flux_bgc ! allocate flux_bgc arrays - call alloc_flux ! allocate flux arrays - call init_ice_timers ! initialize all timers - call ice_timer_start(timer_total) ! start timing entire run - call init_grid2 ! grid variables - call init_zbgc ! vertical biogeochemistry initialization - call init_calendar ! initialize some calendar stuff - call init_hist (dt) ! initialize output history file - - if (kdyn == 2) then - call alloc_dyn_eap ! allocate dyn_eap arrays - call init_eap (dt_dyn) ! define eap dynamics parameters, variables - else ! for both kdyn = 0 or 1 - call init_evp (dt_dyn) ! define evp dynamics parameters, variables - endif - - call init_coupler_flux ! initialize fluxes exchanged with coupler - call init_thermo_vertical ! initialize vertical thermodynamics - - call icepack_init_itd(ncat=ncat, hin_max=hin_max) ! ice thickness distribution - if (my_task == master_task) then - call icepack_init_itd_hist(ncat=ncat, hin_max=hin_max, c_hi_range=c_hi_range) ! output - endif - - call icepack_query_tracer_flags(tr_fsd_out=tr_fsd) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(trim(subname), & - file=__FILE__,line= __LINE__) - - if (tr_fsd) call icepack_init_fsd_bounds (nfsd, & ! floe size distribution + + subroutine cice_init1() + + ! Initialize the basic state, grid and all necessary parameters for + ! running the CICE model. + + use ice_init , only: input_data + use ice_init_column , only: input_zbgc, count_tracers + use ice_grid , only: init_grid1, alloc_grid + use ice_domain , only: init_domain_blocks + use ice_arrays_column , only: alloc_arrays_column + use ice_state , only: alloc_state + use ice_dyn_shared , only: alloc_dyn_shared + use ice_flux_bgc , only: alloc_flux_bgc + use ice_flux , only: alloc_flux + use ice_timers , only: timer_total, init_ice_timers, ice_timer_start + + character(len=*), parameter :: subname = '(cice_init1)' + !---------------------------------------------------- + + call init_fileunits ! unit numbers + call icepack_configure() ! initialize icepack + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(trim(subname), & + file=__FILE__,line= __LINE__) + + call input_data ! namelist variables + call input_zbgc ! vertical biogeochemistry namelist + call count_tracers ! count tracers + + call init_domain_blocks ! set up block decomposition + call init_grid1 ! domain distribution + call alloc_grid ! allocate grid arrays + call alloc_arrays_column ! allocate column arrays + call alloc_state ! allocate state arrays + call alloc_dyn_shared ! allocate dyn shared arrays + call alloc_flux_bgc ! allocate flux_bgc arrays + call alloc_flux ! allocate flux arrays + call init_ice_timers ! initialize all timers + call ice_timer_start(timer_total) ! start timing entire run + + end subroutine cice_init1 + + !======================================================================= + subroutine cice_init2() + + ! Initialize the basic state, and all necessary parameters for + ! running the CICE model. + + use ice_arrays_column , only: hin_max, c_hi_range + use ice_arrays_column , only: floe_rad_l, floe_rad_c, floe_binwidth, c_fsd_range + use ice_calendar , only: dt, dt_dyn, time, istep, istep1, write_ic, init_calendar, calendar + use ice_communicate , only: my_task, master_task + use ice_diagnostics , only: init_diags + use ice_domain_size , only: ncat, nfsd + use ice_dyn_eap , only: init_eap, alloc_dyn_eap + use ice_dyn_shared , only: kdyn, init_evp + use ice_flux , only: init_coupler_flux, init_history_therm + use ice_flux , only: init_history_dyn, init_flux_atm, init_flux_ocn + use ice_forcing , only: init_forcing_ocn + use ice_forcing_bgc , only: get_forcing_bgc, get_atm_bgc + use ice_forcing_bgc , only: faero_default, faero_optics, alloc_forcing_bgc, fiso_default + use ice_history , only: init_hist, accum_hist + use ice_restart_shared , only: restart, runtype + use ice_init , only: input_data, init_state + use ice_init_column , only: init_thermo_vertical, init_shortwave, init_zbgc + use ice_restoring , only: ice_HaloRestore_init + use ice_timers , only: timer_total, init_ice_timers, ice_timer_start + use ice_transport_driver , only: init_transport + + logical(kind=log_kind) :: tr_aero, tr_zaero, skl_bgc, z_tracers + logical(kind=log_kind) :: tr_iso, tr_fsd, wave_spec + character(len=*), parameter :: subname = '(cice_init2)' + !---------------------------------------------------- + + call init_zbgc ! vertical biogeochemistry initialization + call init_calendar ! initialize some calendar stuff + call init_hist (dt) ! initialize output history file + + if (kdyn == 2) then + call alloc_dyn_eap ! allocate dyn_eap arrays + call init_eap (dt_dyn) ! define eap dynamics parameters, variables + else ! for both kdyn = 0 or 1 + call init_evp (dt_dyn) ! define evp dynamics parameters, variables + endif + + call init_coupler_flux ! initialize fluxes exchanged with coupler + call init_thermo_vertical ! initialize vertical thermodynamics + + call icepack_init_itd(ncat=ncat, hin_max=hin_max) ! ice thickness distribution + if (my_task == master_task) then + call icepack_init_itd_hist(ncat=ncat, hin_max=hin_max, c_hi_range=c_hi_range) ! output + endif + + call icepack_query_tracer_flags(tr_fsd_out=tr_fsd) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(trim(subname), & + file=__FILE__,line= __LINE__) + + if (tr_fsd) call icepack_init_fsd_bounds (nfsd, & ! floe size distribution floe_rad_l, & ! fsd size lower bound in m (radius) floe_rad_c, & ! fsd size bin centre in m (radius) floe_binwidth, & ! fsd size bin width in m (radius) c_fsd_range, & ! string for history output write_diags=(my_task == master_task)) ! write diag on master only - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - call calendar(time) ! determine the initial date - - ! TODO: - why is this being called when you are using CMEPS? - call init_forcing_ocn(dt) ! initialize sss and sst from data - - call init_state ! initialize the ice state - call init_transport ! initialize horizontal transport - call ice_HaloRestore_init ! restored boundary conditions - - call icepack_query_parameters(skl_bgc_out=skl_bgc, z_tracers_out=z_tracers, & - wave_spec_out=wave_spec) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(trim(subname), & - file=__FILE__,line= __LINE__) - - if (skl_bgc .or. z_tracers) call alloc_forcing_bgc ! allocate biogeochemistry arrays - - call init_restart ! initialize restart variables - call init_diags ! initialize diagnostic output points - call init_history_therm ! initialize thermo history variables - call init_history_dyn ! initialize dynamic history variables - - call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_zaero_out=tr_zaero) - call icepack_query_tracer_flags(tr_iso_out=tr_iso) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(trim(subname), & - file=__FILE__,line= __LINE__) - - if (tr_aero .or. tr_zaero) then - call faero_optics !initialize aerosol optical property tables - end if - - ! Initialize shortwave components using swdn from previous timestep - ! if restarting. These components will be scaled to current forcing - ! in prep_radiation. - - if (trim(runtype) == 'continue' .or. restart) then - call init_shortwave ! initialize radiative transfer - end if - - !-------------------------------------------------------------------- - ! coupler communication or forcing data initialization - !-------------------------------------------------------------------- - - if (z_tracers) call get_atm_bgc ! biogeochemistry - - if (runtype == 'initial' .and. .not. restart) then - call init_shortwave ! initialize radiative transfer using current swdn - end if - - call init_flux_atm ! initialize atmosphere fluxes sent to coupler - call init_flux_ocn ! initialize ocean fluxes sent to coupler - - end subroutine cice_init - -!======================================================================= - - subroutine init_restart - - use ice_arrays_column, only: dhsn - use ice_blocks, only: nx_block, ny_block - use ice_calendar, only: time, calendar - use ice_constants, only: c0 - use ice_domain, only: nblocks - use ice_domain_size, only: ncat, n_iso, n_aero, nfsd - use ice_dyn_eap, only: read_restart_eap - use ice_dyn_shared, only: kdyn - use ice_grid, only: tmask - use ice_init, only: ice_ic - use ice_init_column, only: init_age, init_FY, init_lvl, & - init_meltponds_cesm, init_meltponds_lvl, init_meltponds_topo, & - init_isotope, init_aerosol, init_hbrine, init_bgc, init_fsd - use ice_restart_column, only: restart_age, read_restart_age, & - restart_FY, read_restart_FY, restart_lvl, read_restart_lvl, & - restart_pond_cesm, read_restart_pond_cesm, & - restart_pond_lvl, read_restart_pond_lvl, & - restart_pond_topo, read_restart_pond_topo, & - restart_fsd, read_restart_fsd, & - restart_iso, read_restart_iso, & - restart_aero, read_restart_aero, & - restart_hbrine, read_restart_hbrine, & - restart_zsal, restart_bgc - use ice_restart_driver, only: restartfile - use ice_restart_shared, only: runtype, restart - use ice_state ! almost everything - - integer(kind=int_kind) :: & + call calendar(time) ! determine the initial date + + ! TODO: - why is this being called when you are using CMEPS? + call init_forcing_ocn(dt) ! initialize sss and sst from data + + call init_state ! initialize the ice state + call init_transport ! initialize horizontal transport + call ice_HaloRestore_init ! restored boundary conditions + + call icepack_query_parameters(skl_bgc_out=skl_bgc, z_tracers_out=z_tracers, & + wave_spec_out=wave_spec) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(trim(subname), & + file=__FILE__,line= __LINE__) + + if (skl_bgc .or. z_tracers) call alloc_forcing_bgc ! allocate biogeochemistry arrays + + call init_restart ! initialize restart variables + call init_diags ! initialize diagnostic output points + call init_history_therm ! initialize thermo history variables + call init_history_dyn ! initialize dynamic history variables + + call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_zaero_out=tr_zaero) + call icepack_query_tracer_flags(tr_iso_out=tr_iso) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(trim(subname), & + file=__FILE__,line= __LINE__) + + if (tr_aero .or. tr_zaero) then + call faero_optics !initialize aerosol optical property tables + end if + + ! Initialize shortwave components using swdn from previous timestep + ! if restarting. These components will be scaled to current forcing + ! in prep_radiation. + + if (trim(runtype) == 'continue' .or. restart) then + call init_shortwave ! initialize radiative transfer + end if + + !-------------------------------------------------------------------- + ! coupler communication or forcing data initialization + !-------------------------------------------------------------------- + + if (z_tracers) call get_atm_bgc ! biogeochemistry + + if (runtype == 'initial' .and. .not. restart) then + call init_shortwave ! initialize radiative transfer using current swdn + end if + + call init_flux_atm ! initialize atmosphere fluxes sent to coupler + call init_flux_ocn ! initialize ocean fluxes sent to coupler + + end subroutine cice_init2 + + !======================================================================= + + subroutine init_restart() + + use ice_arrays_column, only: dhsn + use ice_blocks, only: nx_block, ny_block + use ice_calendar, only: time, calendar + use ice_constants, only: c0 + use ice_domain, only: nblocks + use ice_domain_size, only: ncat, n_iso, n_aero, nfsd + use ice_dyn_eap, only: read_restart_eap + use ice_dyn_shared, only: kdyn + use ice_grid, only: tmask + use ice_init, only: ice_ic + use ice_init_column, only: init_age, init_FY, init_lvl, & + init_meltponds_cesm, init_meltponds_lvl, init_meltponds_topo, & + init_isotope, init_aerosol, init_hbrine, init_bgc, init_fsd + use ice_restart_column, only: restart_age, read_restart_age, & + restart_FY, read_restart_FY, restart_lvl, read_restart_lvl, & + restart_pond_cesm, read_restart_pond_cesm, & + restart_pond_lvl, read_restart_pond_lvl, & + restart_pond_topo, read_restart_pond_topo, & + restart_fsd, read_restart_fsd, & + restart_iso, read_restart_iso, & + restart_aero, read_restart_aero, & + restart_hbrine, read_restart_hbrine, & + restart_zsal, restart_bgc + use ice_restart_driver, only: restartfile + use ice_restart_shared, only: runtype, restart + use ice_state ! almost everything + + integer(kind=int_kind) :: & i, j , & ! horizontal indices iblk ! block index - logical(kind=log_kind) :: & - tr_iage, tr_FY, tr_lvl, tr_pond_cesm, tr_pond_lvl, & - tr_pond_topo, tr_fsd, tr_iso, tr_aero, tr_brine, & - skl_bgc, z_tracers, solve_zsal - integer(kind=int_kind) :: & - ntrcr - integer(kind=int_kind) :: & - nt_alvl, nt_vlvl, nt_apnd, nt_hpnd, nt_ipnd, & - nt_iage, nt_FY, nt_aero, nt_fsd, nt_isosno, nt_isoice - - character(len=*), parameter :: subname = '(init_restart)' - - call icepack_query_tracer_sizes(ntrcr_out=ntrcr) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - - call icepack_query_parameters(skl_bgc_out=skl_bgc, & - z_tracers_out=z_tracers, solve_zsal_out=solve_zsal) - call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & - tr_lvl_out=tr_lvl, tr_pond_cesm_out=tr_pond_cesm, tr_pond_lvl_out=tr_pond_lvl, & - tr_pond_topo_out=tr_pond_topo, tr_aero_out=tr_aero, tr_brine_out=tr_brine, & - tr_fsd_out=tr_fsd, tr_iso_out=tr_iso) - call icepack_query_tracer_indices(nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, & - nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, & - nt_iage_out=nt_iage, nt_FY_out=nt_FY, nt_aero_out=nt_aero, nt_fsd_out=nt_fsd, & - nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + logical(kind=log_kind) :: & + tr_iage, tr_FY, tr_lvl, tr_pond_cesm, tr_pond_lvl, & + tr_pond_topo, tr_fsd, tr_iso, tr_aero, tr_brine, & + skl_bgc, z_tracers, solve_zsal + integer(kind=int_kind) :: & + ntrcr + integer(kind=int_kind) :: & + nt_alvl, nt_vlvl, nt_apnd, nt_hpnd, nt_ipnd, & + nt_iage, nt_FY, nt_aero, nt_fsd, nt_isosno, nt_isoice + + character(len=*), parameter :: subname = '(init_restart)' + !---------------------------------------------------- + + call icepack_query_tracer_sizes(ntrcr_out=ntrcr) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - if (trim(runtype) == 'continue') then - ! start from core restart file - call restartfile() ! given by pointer in ice_in - call calendar(time) ! update time parameters - if (kdyn == 2) call read_restart_eap ! EAP - else if (restart) then ! ice_ic = core restart file - call restartfile (ice_ic) ! or 'default' or 'none' - !!! uncomment to create netcdf - ! call restartfile_v4 (ice_ic) ! CICE v4.1 binary restart file - !!! uncomment if EAP restart data exists - ! if (kdyn == 2) call read_restart_eap - endif - - ! tracers - ! ice age tracer - if (tr_iage) then - if (trim(runtype) == 'continue') & - restart_age = .true. - if (restart_age) then - call read_restart_age - else - do iblk = 1, nblocks - call init_age(trcrn(:,:,nt_iage,:,iblk)) - enddo ! iblk - endif - endif - ! first-year area tracer - if (tr_FY) then - if (trim(runtype) == 'continue') restart_FY = .true. - if (restart_FY) then - call read_restart_FY - else - do iblk = 1, nblocks - call init_FY(trcrn(:,:,nt_FY,:,iblk)) - enddo ! iblk - endif - endif - ! level ice tracer - if (tr_lvl) then - if (trim(runtype) == 'continue') restart_lvl = .true. - if (restart_lvl) then - call read_restart_lvl - else - do iblk = 1, nblocks - call init_lvl(iblk,trcrn(:,:,nt_alvl,:,iblk), & - trcrn(:,:,nt_vlvl,:,iblk)) - enddo ! iblk - endif - endif - ! CESM melt ponds - if (tr_pond_cesm) then - if (trim(runtype) == 'continue') & - restart_pond_cesm = .true. - if (restart_pond_cesm) then - call read_restart_pond_cesm - else - do iblk = 1, nblocks - call init_meltponds_cesm(trcrn(:,:,nt_apnd,:,iblk), & - trcrn(:,:,nt_hpnd,:,iblk)) - enddo ! iblk - endif - endif - ! level-ice melt ponds - if (tr_pond_lvl) then - if (trim(runtype) == 'continue') & - restart_pond_lvl = .true. - if (restart_pond_lvl) then - call read_restart_pond_lvl - else - do iblk = 1, nblocks - call init_meltponds_lvl(trcrn(:,:,nt_apnd,:,iblk), & - trcrn(:,:,nt_hpnd,:,iblk), & - trcrn(:,:,nt_ipnd,:,iblk), & - dhsn(:,:,:,iblk)) - enddo ! iblk - endif - endif - ! topographic melt ponds - if (tr_pond_topo) then - if (trim(runtype) == 'continue') & - restart_pond_topo = .true. - if (restart_pond_topo) then - call read_restart_pond_topo - else - do iblk = 1, nblocks - call init_meltponds_topo(trcrn(:,:,nt_apnd,:,iblk), & - trcrn(:,:,nt_hpnd,:,iblk), & - trcrn(:,:,nt_ipnd,:,iblk)) - enddo ! iblk - endif ! .not. restart_pond - endif - ! floe size distribution - if (tr_fsd) then - if (trim(runtype) == 'continue') restart_fsd = .true. - if (restart_fsd) then - call read_restart_fsd - else - call init_fsd(trcrn(:,:,nt_fsd:nt_fsd+nfsd-1,:,:)) - endif - endif - - ! isotopes - if (tr_iso) then - if (trim(runtype) == 'continue') restart_iso = .true. - if (restart_iso) then - call read_restart_iso - else - do iblk = 1, nblocks - call init_isotope(trcrn(:,:,nt_isosno:nt_isosno+n_iso-1,:,iblk), & - trcrn(:,:,nt_isoice:nt_isoice+n_iso-1,:,iblk)) - enddo ! iblk - endif - endif - - if (tr_aero) then ! ice aerosol - if (trim(runtype) == 'continue') restart_aero = .true. - if (restart_aero) then - call read_restart_aero - else - do iblk = 1, nblocks - call init_aerosol(trcrn(:,:,nt_aero:nt_aero+4*n_aero-1,:,iblk)) - enddo ! iblk - endif ! .not. restart_aero - endif - - if (trim(runtype) == 'continue') then - if (tr_brine) & - restart_hbrine = .true. - if (solve_zsal) & - restart_zsal = .true. - if (skl_bgc .or. z_tracers) & - restart_bgc = .true. - endif - - if (tr_brine .or. skl_bgc) then ! brine height tracer - call init_hbrine - if (tr_brine .and. restart_hbrine) call read_restart_hbrine - endif - - if (solve_zsal .or. skl_bgc .or. z_tracers) then ! biogeochemistry - if (tr_fsd) then - write (nu_diag,*) 'FSD implementation incomplete for use with BGC' - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + call icepack_query_parameters(skl_bgc_out=skl_bgc, & + z_tracers_out=z_tracers, solve_zsal_out=solve_zsal) + call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & + tr_lvl_out=tr_lvl, tr_pond_cesm_out=tr_pond_cesm, tr_pond_lvl_out=tr_pond_lvl, & + tr_pond_topo_out=tr_pond_topo, tr_aero_out=tr_aero, tr_brine_out=tr_brine, & + tr_fsd_out=tr_fsd, tr_iso_out=tr_iso) + call icepack_query_tracer_indices(nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, & + nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, & + nt_iage_out=nt_iage, nt_FY_out=nt_FY, nt_aero_out=nt_aero, nt_fsd_out=nt_fsd, & + nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + if (trim(runtype) == 'continue') then + ! start from core restart file + call restartfile() ! given by pointer in ice_in + call calendar(time) ! update time parameters + if (kdyn == 2) call read_restart_eap ! EAP + else if (restart) then ! ice_ic = core restart file + call restartfile (ice_ic) ! or 'default' or 'none' +!!! uncomment to create netcdf + ! call restartfile_v4 (ice_ic) ! CICE v4.1 binary restart file +!!! uncomment if EAP restart data exists + ! if (kdyn == 2) call read_restart_eap + endif + + ! tracers + ! ice age tracer + if (tr_iage) then + if (trim(runtype) == 'continue') & + restart_age = .true. + if (restart_age) then + call read_restart_age + else + do iblk = 1, nblocks + call init_age(trcrn(:,:,nt_iage,:,iblk)) + enddo ! iblk + endif + endif + ! first-year area tracer + if (tr_FY) then + if (trim(runtype) == 'continue') restart_FY = .true. + if (restart_FY) then + call read_restart_FY + else + do iblk = 1, nblocks + call init_FY(trcrn(:,:,nt_FY,:,iblk)) + enddo ! iblk + endif + endif + ! level ice tracer + if (tr_lvl) then + if (trim(runtype) == 'continue') restart_lvl = .true. + if (restart_lvl) then + call read_restart_lvl + else + do iblk = 1, nblocks + call init_lvl(iblk,trcrn(:,:,nt_alvl,:,iblk), & + trcrn(:,:,nt_vlvl,:,iblk)) + enddo ! iblk + endif + endif + ! CESM melt ponds + if (tr_pond_cesm) then + if (trim(runtype) == 'continue') & + restart_pond_cesm = .true. + if (restart_pond_cesm) then + call read_restart_pond_cesm + else + do iblk = 1, nblocks + call init_meltponds_cesm(trcrn(:,:,nt_apnd,:,iblk), & + trcrn(:,:,nt_hpnd,:,iblk)) + enddo ! iblk + endif + endif + ! level-ice melt ponds + if (tr_pond_lvl) then + if (trim(runtype) == 'continue') & + restart_pond_lvl = .true. + if (restart_pond_lvl) then + call read_restart_pond_lvl + else + do iblk = 1, nblocks + call init_meltponds_lvl(trcrn(:,:,nt_apnd,:,iblk), & + trcrn(:,:,nt_hpnd,:,iblk), & + trcrn(:,:,nt_ipnd,:,iblk), & + dhsn(:,:,:,iblk)) + enddo ! iblk + endif + endif + ! topographic melt ponds + if (tr_pond_topo) then + if (trim(runtype) == 'continue') & + restart_pond_topo = .true. + if (restart_pond_topo) then + call read_restart_pond_topo + else + do iblk = 1, nblocks + call init_meltponds_topo(trcrn(:,:,nt_apnd,:,iblk), & + trcrn(:,:,nt_hpnd,:,iblk), & + trcrn(:,:,nt_ipnd,:,iblk)) + enddo ! iblk + endif ! .not. restart_pond + endif + ! floe size distribution + if (tr_fsd) then + if (trim(runtype) == 'continue') restart_fsd = .true. + if (restart_fsd) then + call read_restart_fsd + else + call init_fsd(trcrn(:,:,nt_fsd:nt_fsd+nfsd-1,:,:)) + endif + endif + + ! isotopes + if (tr_iso) then + if (trim(runtype) == 'continue') restart_iso = .true. + if (restart_iso) then + call read_restart_iso + else + do iblk = 1, nblocks + call init_isotope(trcrn(:,:,nt_isosno:nt_isosno+n_iso-1,:,iblk), & + trcrn(:,:,nt_isoice:nt_isoice+n_iso-1,:,iblk)) + enddo ! iblk + endif + endif + + if (tr_aero) then ! ice aerosol + if (trim(runtype) == 'continue') restart_aero = .true. + if (restart_aero) then + call read_restart_aero + else + do iblk = 1, nblocks + call init_aerosol(trcrn(:,:,nt_aero:nt_aero+4*n_aero-1,:,iblk)) + enddo ! iblk + endif ! .not. restart_aero + endif + + if (trim(runtype) == 'continue') then + if (tr_brine) & + restart_hbrine = .true. + if (solve_zsal) & + restart_zsal = .true. + if (skl_bgc .or. z_tracers) & + restart_bgc = .true. + endif + + if (tr_brine .or. skl_bgc) then ! brine height tracer + call init_hbrine + if (tr_brine .and. restart_hbrine) call read_restart_hbrine + endif + + if (solve_zsal .or. skl_bgc .or. z_tracers) then ! biogeochemistry + if (tr_fsd) then + write (nu_diag,*) 'FSD implementation incomplete for use with BGC' + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - endif - call init_bgc - endif - - !----------------------------------------------------------------- - ! aggregate tracers - !----------------------------------------------------------------- - - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks - do j = 1, ny_block - do i = 1, nx_block - if (tmask(i,j,iblk)) then - call icepack_aggregate(ncat = ncat, & - aicen = aicen(i,j,:,iblk), & - trcrn = trcrn(i,j,:,:,iblk), & - vicen = vicen(i,j,:,iblk), & - vsnon = vsnon(i,j,:,iblk), & - aice = aice (i,j, iblk), & - trcr = trcr (i,j,:,iblk), & - vice = vice (i,j, iblk), & - vsno = vsno (i,j, iblk), & - aice0 = aice0(i,j, iblk), & - ntrcr = ntrcr, & - trcr_depend = trcr_depend, & - trcr_base = trcr_base, & - n_trcr_strata = n_trcr_strata, & - nt_strata = nt_strata) - else - ! tcraig, reset all tracer values on land to zero - trcrn(i,j,:,:,iblk) = c0 - endif - enddo - enddo - enddo - !$OMP END PARALLEL DO - - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + endif + call init_bgc + endif + + !----------------------------------------------------------------- + ! aggregate tracers + !----------------------------------------------------------------- + + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + do j = 1, ny_block + do i = 1, nx_block + if (tmask(i,j,iblk)) then + call icepack_aggregate(ncat = ncat, & + aicen = aicen(i,j,:,iblk), & + trcrn = trcrn(i,j,:,:,iblk), & + vicen = vicen(i,j,:,iblk), & + vsnon = vsnon(i,j,:,iblk), & + aice = aice (i,j, iblk), & + trcr = trcr (i,j,:,iblk), & + vice = vice (i,j, iblk), & + vsno = vsno (i,j, iblk), & + aice0 = aice0(i,j, iblk), & + ntrcr = ntrcr, & + trcr_depend = trcr_depend, & + trcr_base = trcr_base, & + n_trcr_strata = n_trcr_strata, & + nt_strata = nt_strata) + else + ! tcraig, reset all tracer values on land to zero + trcrn(i,j,:,:,iblk) = c0 + endif + enddo + enddo + enddo + !$OMP END PARALLEL DO + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - end subroutine init_restart + end subroutine init_restart -!======================================================================= + !======================================================================= - end module CICE_InitMod +end module CICE_InitMod !======================================================================= diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index b70e3417b..74e3307ec 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -83,7 +83,7 @@ module ice_comp_nuopc character(len=*),parameter :: shr_cal_noleap = 'NO_LEAP' character(len=*),parameter :: shr_cal_gregorian = 'GREGORIAN' - type(ESMF_Mesh) :: Emesh + type(ESMF_Mesh) :: ice_mesh integer :: dbug = 0 integer , parameter :: debug_import = 0 ! internal debug level @@ -178,22 +178,16 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Local variables character(len=char_len_long) :: cvalue - character(len=char_len_long) :: logmsg logical :: isPresent, isSet real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp - type(ESMF_DistGrid) :: distGrid - type(ESMF_Mesh) :: EmeshTemp - integer :: spatialDim - integer :: numOwnedElements - real(dbl_kind), pointer :: ownedElemCoords(:) - real(dbl_kind), pointer :: lat(:), latMesh(:) - real(dbl_kind), pointer :: lon(:), lonMesh(:) - integer , allocatable :: gindex_ice(:) - integer , allocatable :: gindex_elim(:) - integer , allocatable :: gindex(:) - integer :: globalID + type(ESMF_DistGrid) :: ice_distGrid character(len=char_len) :: tfrz_option + integer(int_kind) :: ktherm + integer :: localPet + integer :: npes + logical :: mastertask type(ESMF_VM) :: vm + integer :: lmpicom ! local communicator type(ESMF_Time) :: currTime ! Current time type(ESMF_Time) :: startTime ! Start time type(ESMF_Time) :: stopTime ! Stop time @@ -212,31 +206,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: yy,mm,dd ! Temporaries for time query integer :: iyear ! yyyy integer :: dtime ! time step - integer :: lmpicom integer :: shrlogunit ! original log unit character(len=char_len) :: starttype ! infodata start type integer :: lsize ! local size of coupling array - integer :: localPet integer :: n,c,g,i,j,m ! indices integer :: iblk, jblk ! indices integer :: ig, jg ! indices integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain type(block) :: this_block ! block information for current block - integer :: compid ! component id - character(len=char_len_long) :: tempc1,tempc2 - real(dbl_kind) :: diff_lon - integer :: npes - integer :: num_elim_global - integer :: num_elim_local - integer :: num_elim - integer :: num_ice - integer :: num_elim_gcells ! local number of eliminated gridcells - integer :: num_elim_blocks ! local number of eliminated blocks - integer :: num_total_blocks - integer :: my_elim_start, my_elim_end - real(dbl_kind) :: rad_to_deg - integer(int_kind) :: ktherm - logical :: mastertask character(len=char_len_long) :: diag_filename = 'unset' character(len=*), parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !-------------------------------- @@ -515,15 +492,60 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) end if !---------------------------------------------------------------------------- - ! Initialize cice + ! First cice initialization phase - before initializing grid info !---------------------------------------------------------------------------- - ! Note that cice_init also sets time manager info as well as mpi communicator info, - ! including master_task and my_task + call t_startf ('cice_init1') + call cice_init1 + call t_stopf ('cice_init1') + + !---------------------------------------------------------------------------- + ! Initialize grid info + !---------------------------------------------------------------------------- + + ! Determine the model distgrid using the decomposition obtained in + ! call to init_grid1 called from cice_init1 + call ice_mesh_set_distgrid(localpet, npes, ice_distgrid, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! read in the mesh + call NUOPC_CompAttributeGet(gcomp, name='mesh_ice', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (my_task == master_task) then + write(nu_diag,*)'mesh file for cice domain is ',trim(cvalue) + end if - call t_startf ('cice_init') - call cice_init - call t_stopf ('cice_init') + ! Read in the ice mesh on the cice distribution + ice_mesh = ESMF_MeshCreate(filename=trim(ice_meshfile), fileformat=ESMF_FILEFORMAT_ESMFMESH, & + elementDistGrid=ice_distgrid, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Initialize the cice mesh and the cice mask + if (trim(grid_type) == 'setmask') then + ! Determine mask input file and create the mask + call NUOPC_CompAttributeGet(gcomp, name='mesh_mask', value=ice_maskfile, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (my_task == master_task) then + write(nu_diag,*)'mask file for cice domain is ',trim(ice_maskfile) + end if + call ice_mesh_setmask_from_maskfile(ice_mesh, ice_maskfile, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + ! In this case init_grid2 will initialize tlon, tlat, area and hm + call init_grid2() + call ice_mesh_check(ice_mesh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + !---------------------------------------------------------------------------- + ! Second cice initialization phase -after initializing grid info + !---------------------------------------------------------------------------- + + ! Note that cice_init2 also sets time manager info as well as mpi communicator info, + ! including master_task and my_task + call t_startf ('cice_init2') + call cice_init2() + call t_stopf ('cice_init2') !---------------------------------------------------------------------------- ! reset shr logging to my log file @@ -611,218 +633,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call accum_hist(dt) ! write initial conditions end if - !--------------------------------------------------------------------------- - ! Determine the global index space needed for the distgrid - !--------------------------------------------------------------------------- - - ! number the local grid to get allocation size for gindex_ice - lsize = 0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - do j = jlo, jhi - do i = ilo, ihi - lsize = lsize + 1 - enddo - enddo - enddo - - ! set global index array - allocate(gindex_ice(lsize)) - n = 0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - do j = jlo, jhi - do i = ilo, ihi - n = n+1 - ig = this_block%i_glob(i) - jg = this_block%j_glob(j) - gindex_ice(n) = (jg-1)*nx_global + ig - enddo - enddo - enddo - - ! Determine total number of eliminated blocks globally - globalID = 0 - num_elim_global = 0 ! number of eliminated blocks - num_total_blocks = 0 - do jblk=1,nblocks_y - do iblk=1,nblocks_x - globalID = globalID + 1 - num_total_blocks = num_total_blocks + 1 - if (distrb_info%blockLocation(globalID) == 0) then - num_elim_global = num_elim_global + 1 - end if - end do - end do - - if (num_elim_global > 0) then - - ! Distribute the eliminated blocks in a round robin fashion amoung processors - num_elim_local = num_elim_global / npes - my_elim_start = num_elim_local*localPet + min(localPet, mod(num_elim_global, npes)) + 1 - if (localPet < mod(num_elim_global, npes)) then - num_elim_local = num_elim_local + 1 - end if - my_elim_end = my_elim_start + num_elim_local - 1 - - ! Determine the number of eliminated gridcells locally - globalID = 0 - num_elim_blocks = 0 ! local number of eliminated blocks - num_elim_gcells = 0 - do jblk=1,nblocks_y - do iblk=1,nblocks_x - globalID = globalID + 1 - if (distrb_info%blockLocation(globalID) == 0) then - num_elim_blocks = num_elim_blocks + 1 - if (num_elim_blocks >= my_elim_start .and. num_elim_blocks <= my_elim_end) then - this_block = get_block(globalID, globalID) - num_elim_gcells = num_elim_gcells + & - (this_block%jhi-this_block%jlo+1) * (this_block%ihi-this_block%ilo+1) - end if - end if - end do - end do - - ! Determine the global index space of the eliminated gridcells - allocate(gindex_elim(num_elim_gcells)) - globalID = 0 - num_elim_gcells = 0 ! local number of eliminated gridcells - num_elim_blocks = 0 ! local number of eliminated blocks - do jblk=1,nblocks_y - do iblk=1,nblocks_x - globalID = globalID + 1 - if (distrb_info%blockLocation(globalID) == 0) then - this_block = get_block(globalID, globalID) - num_elim_blocks = num_elim_blocks + 1 - if (num_elim_blocks >= my_elim_start .and. num_elim_blocks <= my_elim_end) then - do j=this_block%jlo,this_block%jhi - do i=this_block%ilo,this_block%ihi - num_elim_gcells = num_elim_gcells + 1 - ig = this_block%i_glob(i) - jg = this_block%j_glob(j) - gindex_elim(num_elim_gcells) = (jg-1)*nx_global + ig - end do - end do - end if - end if - end do - end do - - ! create a global index that includes both active and eliminated gridcells - num_ice = size(gindex_ice) - num_elim = size(gindex_elim) - allocate(gindex(num_elim + num_ice)) - do n = 1,num_ice - gindex(n) = gindex_ice(n) - end do - do n = num_ice+1,num_ice+num_elim - gindex(n) = gindex_elim(n-num_ice) - end do - - deallocate(gindex_elim) - - else - - ! No eliminated land blocks - num_ice = size(gindex_ice) - allocate(gindex(num_ice)) - do n = 1,num_ice - gindex(n) = gindex_ice(n) - end do - - end if - - !--------------------------------------------------------------------------- - ! Create distGrid from global index array - !--------------------------------------------------------------------------- - - DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - !--------------------------------------------------------------------------- - ! Create the CICE mesh - !--------------------------------------------------------------------------- - - ! read in the mesh - call NUOPC_CompAttributeGet(gcomp, name='mesh_ice', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - EMeshTemp = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (my_task == master_task) then - write(nu_diag,*)'mesh file for cice domain is ',trim(cvalue) - end if - - ! recreate the mesh using the above distGrid - EMesh = ESMF_MeshCreate(EMeshTemp, elementDistgrid=Distgrid, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! obtain mesh lats and lons - call ESMF_MeshGet(Emesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(ownedElemCoords(spatialDim*numOwnedElements)) - allocate(lonMesh(numOwnedElements), latMesh(numOwnedElements)) - call ESMF_MeshGet(Emesh, ownedElemCoords=ownedElemCoords) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - do n = 1,numOwnedElements - lonMesh(n) = ownedElemCoords(2*n-1) - latMesh(n) = ownedElemCoords(2*n) - end do - - call icepack_query_parameters(rad_to_deg_out=rad_to_deg) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - - ! obtain internally generated cice lats and lons for error checks - allocate(lon(lsize)) - allocate(lat(lsize)) - n = 0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - do j = jlo, jhi - do i = ilo, ihi - n = n+1 - lon(n) = tlon(i,j,iblk)*rad_to_deg - lat(n) = tlat(i,j,iblk)*rad_to_deg - enddo - enddo - enddo - - ! error check differences between internally generated lons and those read in - do n = 1,lsize - diff_lon = abs(lonMesh(n) - lon(n)) - if ( (diff_lon > 1.e2 .and. abs(diff_lon - 360_dbl_kind) > 1.e-1) .or.& - (diff_lon > 1.e-3 .and. diff_lon < 1._dbl_kind) ) then - !write(6,100)n,lonMesh(n),lon(n), diff_lon -100 format('ERROR: CICE n, lonmesh(n), lon(n), diff_lon = ',i6,2(f21.13,3x),d21.5) - !call abort_ice() - end if - if (abs(latMesh(n) - lat(n)) > 1.e-1) then - !write(6,101)n,latMesh(n),lat(n), abs(latMesh(n)-lat(n)) -101 format('ERROR: CICE n, latmesh(n), lat(n), diff_lat = ',i6,2(f21.13,3x),d21.5) - !call abort_ice() - end if - end do - !----------------------------------------------------------------- ! Prescribed ice initialization !----------------------------------------------------------------- - call ice_prescribed_init(clock, Emesh, rc) + call ice_prescribed_init(clock, ice_mesh, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !----------------------------------------------------------------- @@ -835,16 +650,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ice_advertise_fields(gcomp, importState, exportState, flds_scalar_name, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !----------------------------------------------------------------- - ! deallocate memory - !----------------------------------------------------------------- - - deallocate(ownedElemCoords) - deallocate(lon, lonMesh) - deallocate(lat, latMesh) - deallocate(gindex_ice) - deallocate(gindex) - call t_stopf ('cice_init_total') end subroutine InitializeAdvertise @@ -871,7 +676,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Realize the actively coupled fields !----------------------------------------------------------------- - call ice_realize_fields(gcomp, mesh=Emesh, & + call ice_realize_fields(gcomp, mesh=ice_mesh, & flds_scalar_name=flds_scalar_name, flds_scalar_num=flds_scalar_num, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From 66356cb3233eb387d1b3fbee6094619228c74c6d Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 28 Jan 2021 20:13:18 -0700 Subject: [PATCH 30/51] added ice_mesh_mod --- cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 | 704 ++++++++++++++++++ 1 file changed, 704 insertions(+) create mode 100644 cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 diff --git a/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 new file mode 100644 index 000000000..b02865320 --- /dev/null +++ b/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 @@ -0,0 +1,704 @@ +module ice_mesh_mod + + use ESMF + use ice_kinds_mod , only : dbl_kind, int_kind + use ice_domain_size , only : nx_global, ny_global, max_blocks + use ice_domain , only : nblocks, blocks_ice, distrb_info + use ice_blocks , only : block, get_block, nx_block, ny_block, nblocks_x, nblocks_y + use ice_shr_methods , only : chkerr + use ice_fileunits , only : nu_diag + use ice_communicate , only : my_task, master_task + use ice_initfc , only : icepack_query_parameters + implicit none + private + + public :: ice_mesh_set_distgrid + public :: ice_mesh_setmask_from_maskfile + public :: ice_mesh_check + + private :: ice_mesh_create_mask + + ! Only relevant for lat-lon grids gridcell value of [1 - (land fraction)] (T-cell) + real (dbl_kind), allocatable, public :: ocn_gridcell_frac(:,:,:) + + character(*), parameter :: u_FILE_u = & + __FILE__ + +!======================================================================= +contains +!======================================================================= + + subroutine ice_mesh_set_distgrid(localpet, npes, distgrid, rc) + + ! Determine the global index space needed for the distgrid + + ! input/output variables + integer , intent(in) :: localpet + integer , intent(in) :: npes + type(ESMF_DistGrid) , intent(inout) :: distgrid + integer , intent(out) :: rc + + ! local variables + integer :: n,c,g,i,j,m ! indices + integer :: iblk, jblk ! indices + integer :: ig, jg ! indices + integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain + integer :: lsize ! local size of coupling array + type(block) :: this_block ! block information for current block + integer :: num_elim_global + integer :: num_elim_local + integer :: num_elim + integer :: num_ice + integer :: num_elim_gcells ! local number of eliminated gridcells + integer :: num_elim_blocks ! local number of eliminated blocks + integer :: num_total_blocks + integer :: my_elim_start, my_elim_end + integer , allocatable :: gindex(:) + integer , allocatable :: gindex_ice(:) + integer , allocatable :: gindex_elim(:) + integer :: globalID + character(len=*), parameter :: subname = ' ice_mesh_set_distgrid: ' + !---------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! number the local grid to get allocation size for gindex_ice + lsize = 0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + do j = jlo, jhi + do i = ilo, ihi + lsize = lsize + 1 + enddo + enddo + enddo + + ! set global index array + allocate(gindex_ice(lsize)) + n = 0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + do j = jlo, jhi + do i = ilo, ihi + n = n+1 + ig = this_block%i_glob(i) + jg = this_block%j_glob(j) + gindex_ice(n) = (jg-1)*nx_global + ig + enddo + enddo + enddo + + ! Determine total number of eliminated blocks globally + globalID = 0 + num_elim_global = 0 ! number of eliminated blocks + num_total_blocks = 0 + do jblk=1,nblocks_y + do iblk=1,nblocks_x + globalID = globalID + 1 + num_total_blocks = num_total_blocks + 1 + if (distrb_info%blockLocation(globalID) == 0) then + num_elim_global = num_elim_global + 1 + end if + end do + end do + + if (num_elim_global > 0) then + + ! Distribute the eliminated blocks in a round robin fashion amoung processors + num_elim_local = num_elim_global / npes + my_elim_start = num_elim_local*localPet + min(localPet, mod(num_elim_global, npes)) + 1 + if (localPet < mod(num_elim_global, npes)) then + num_elim_local = num_elim_local + 1 + end if + my_elim_end = my_elim_start + num_elim_local - 1 + + ! Determine the number of eliminated gridcells locally + globalID = 0 + num_elim_blocks = 0 ! local number of eliminated blocks + num_elim_gcells = 0 + do jblk=1,nblocks_y + do iblk=1,nblocks_x + globalID = globalID + 1 + if (distrb_info%blockLocation(globalID) == 0) then + num_elim_blocks = num_elim_blocks + 1 + if (num_elim_blocks >= my_elim_start .and. num_elim_blocks <= my_elim_end) then + this_block = get_block(globalID, globalID) + num_elim_gcells = num_elim_gcells + & + (this_block%jhi-this_block%jlo+1) * (this_block%ihi-this_block%ilo+1) + end if + end if + end do + end do + + ! Determine the global index space of the eliminated gridcells + allocate(gindex_elim(num_elim_gcells)) + globalID = 0 + num_elim_gcells = 0 ! local number of eliminated gridcells + num_elim_blocks = 0 ! local number of eliminated blocks + do jblk=1,nblocks_y + do iblk=1,nblocks_x + globalID = globalID + 1 + if (distrb_info%blockLocation(globalID) == 0) then + this_block = get_block(globalID, globalID) + num_elim_blocks = num_elim_blocks + 1 + if (num_elim_blocks >= my_elim_start .and. num_elim_blocks <= my_elim_end) then + do j=this_block%jlo,this_block%jhi + do i=this_block%ilo,this_block%ihi + num_elim_gcells = num_elim_gcells + 1 + ig = this_block%i_glob(i) + jg = this_block%j_glob(j) + gindex_elim(num_elim_gcells) = (jg-1)*nx_global + ig + end do + end do + end if + end if + end do + end do + + ! create a global index that includes both active and eliminated gridcells + num_ice = size(gindex_ice) + num_elim = size(gindex_elim) + allocate(gindex(num_elim + num_ice)) + do n = 1,num_ice + gindex(n) = gindex_ice(n) + end do + do n = num_ice+1,num_ice+num_elim + gindex(n) = gindex_elim(n-num_ice) + end do + + deallocate(gindex_elim) + + else + + ! No eliminated land blocks + num_ice = size(gindex_ice) + allocate(gindex(num_ice)) + do n = 1,num_ice + gindex(n) = gindex_ice(n) + end do + + end if + + !--------------------------------------------------------------------------- + ! Create distGrid from global index array + !--------------------------------------------------------------------------- + + DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + deallocate(gindex_ice) + deallocate(gindex) + + end subroutine ice_mesh_set_distgrid + + !======================================================================= + subroutine ice_mesh_setmask_from_maskfile(ice_mesh, ice_maskfile, rc) + + use ice_scam , only : scmlat, scmlon, single_column + use ice_grid , only : tlon, tlat, hm, tarea, ULON, ULAT, HTN, HTE, ANGLE, ANGLET + use ice_grid , only : uarea, uarear, tarear, tinyarea + use ice_grid , only : dxt, dyt, dxu, dyu, dyhx, dxhy, cyp, cxp, cym, cxm + use ice_grid , only : kmt_file, makemask, tmask + use ice_boundary , only : ice_HaloUpdate + use ice_domain , only : blocks_ice, nblocks, halo_info, distrb_info + use ice_constants , only : c0, c1, c2, p5, radius + use ice_constants , only : field_loc_center, field_type_scalar + use ice_read_write , only : ice_open_nc, ice_close_nc + use ice_exit , only : abort_ice + use netcdf + + ! input/output variables + type(ESMF_Mesh) , intent(in) :: ice_mesh + character(len=*) , intent(in) :: ice_maskfile + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: iblk, jblk ! indices + integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain + type(ESMF_Field) :: areaField + real(dbl_kind) , pointer :: mesh_areas(:) + integer :: numownedelements + real(dbl_kind) , pointer :: ownedElemCoords(:) + integer :: spatialDim + integer (int_kind) :: ni, nj, ncid + integer (int_kind) :: dimid, varid, ier + type (block) :: this_block ! block information for current block + real (dbl_kind) :: closelat ! Single-column latitude value + real (dbl_kind) :: closelon ! Single-column longitude value + real (dbl_kind) :: closelatidx ! Single-column latitude index to retrieve + real (dbl_kind) :: closelonidx ! Single-column longitude index to retrieve + integer (int_kind) :: start(2) ! Start index to read in + integer (int_kind) :: count(2) ! Number of points to read in + integer (int_kind) :: start3(3) ! Start index to read in + integer (int_kind) :: count3(3) ! Number of points to read in + integer (int_kind) :: status ! status flag + real (dbl_kind), allocatable :: lats(:) ! temporary + real (dbl_kind), allocatable :: lons(:) ! temporary + real (dbl_kind), allocatable :: pos_lons(:) ! temporary + real (dbl_kind), allocatable :: glob_grid(:,:) ! temporary + real (dbl_kind) :: pos_scmlon ! temporary + real (dbl_kind) :: scamdata ! temporary + integer (int_kind), pointer :: ice_mask(:) + real(dbl_kind) , pointer :: ice_frac(:) + real(dbl_kind) :: pi + real(dbl_kind) :: puny + real(dbl_kind) :: deg_to_rad + character(len=*), parameter :: subname = ' ice_mesh_setmask_from_maskfile' + !--------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Determine start/count to read in for either single column or global lat-lon grid + ! If single_column, then assume that only master_task is used since there is only one task + + if (.not. single_column) then + + ! Obtain the model mask and model frac by mapping the mesh created by reading + ! in the model_maskfile to the model mesh and then resetting the model mesh mask + call ice_mesh_create_mask(ice_mesh, ice_maskfile, ice_mask, ice_frac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Obtain mesh areas in radians^2 + areaField = ESMF_FieldCreate(ice_mesh, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegridGetArea(areaField, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(areaField, farrayPtr=mesh_areas, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Obtain mesh lons and lats in degrees + call ESMF_MeshGet(ice_mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(ownedElemCoords(spatialDim*numownedelements)) + call ESMF_MeshGet(ice_mesh, ownedElemCoords=ownedElemCoords) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(ice_mesh, ownedElemCoords=ownedElemCoords, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Allocate module variable ocn_gridcell_frac + allocate(ocn_gridcell_frac(nx_block,ny_block,max_blocks)) + + ! Get required constants + call icepack_query_parameters(pi_out=pi, pi2_out=pi2, puny_out=puny, deg_to_rad_out=deg_to_rad) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + ! Set tlon, tlat, tarea, hm and ocn_gridcell_frac + ! Convert mesh areas from radians^2 to m^2 (tarea is in m^2) + ! Convert lons and lats from degrees to radians + n = 0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + do j = jlo, jhi + do i = ilo, ihi + n = n + 1 + tlon(i,j,iblk) = ownedElemCoords(2*n-1) * deg_to_rad + tlat(i,j,iblk) = ownedElemCoords(2*n) * deg_to_rad + tarea(i,j,iblk) = mesh_areas(n) * (radius*radius) + hm(i,j,iblk) = real(ice_mask(n),kind=dbl_kind) + ocn_gridcell_frac(i,j,iblk) = ice_frac(n) + enddo + enddo + enddo + + ! Dealocate memory + deallocate(ownedElemCoords) + call ESMF_FieldDestroy(areaField) + + else ! single column mode + + if (my_task == master_task) then + call ice_open_nc(kmt_file, ncid) + status = nf90_inq_dimid (ncid, 'ni', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=ni) + status = nf90_inq_dimid (ncid, 'nj', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nj) + end if + + ! Check for consistency + if (my_task == master_task) then + if ((nx_global /= 1).or. (ny_global /= 1)) then + write(nu_diag,*) 'Because you have selected the column model flag' + write(nu_diag,*) 'Please set nx_global=ny_global=1 in file' + write(nu_diag,*) 'ice_domain_size.F and recompile' + call abort_ice ('ice_mesh_setmask_from_maskfile: check nx_global, ny_global') + endif + end if + + ! Read in domain file for single column + allocate(lats(nj)) + allocate(lons(ni)) + allocate(pos_lons(ni)) + allocate(glob_grid(ni,nj)) + + start3=(/1,1,1/) + count3=(/ni,nj,1/) + status = nf90_inq_varid(ncid, 'xc' , varid) + if (status /= nf90_noerr) call abort_ice (subname//' inq_varid xc') + status = nf90_get_var(ncid, varid, glob_grid, start3, count3) + if (status /= nf90_noerr) call abort_ice (subname//' get_var xc') + do i = 1,ni + lons(i) = glob_grid(i,1) + end do + + status = nf90_inq_varid(ncid, 'yc' , varid) + if (status /= nf90_noerr) call abort_ice (subname//' inq_varid yc') + status = nf90_get_var(ncid, varid, glob_grid, start3, count3) + if (status /= nf90_noerr) call abort_ice (subname//' get_var yc') + do j = 1,nj + lats(j) = glob_grid(1,j) + end do + + ! convert lons array and scmlon to 0,360 and find index of value closest to 0 + ! and obtain single-column longitude/latitude indices to retrieve + + pos_lons(:)= mod(lons(:) + 360._dbl_kind,360._dbl_kind) + pos_scmlon = mod(scmlon + 360._dbl_kind,360._dbl_kind) + start(1) = (MINLOC(abs(pos_lons-pos_scmlon),dim=1)) + start(2) = (MINLOC(abs(lats -scmlat ),dim=1)) + + deallocate(lats) + deallocate(lons) + deallocate(pos_lons) + deallocate(glob_grid) + + status = nf90_inq_varid(ncid, 'xc' , varid) + if (status /= nf90_noerr) call abort_ice (subname//' inq_varid xc') + status = nf90_get_var(ncid, varid, scamdata, start) + if (status /= nf90_noerr) call abort_ice (subname//' get_var xc') + TLON = scamdata + status = nf90_inq_varid(ncid, 'yc' , varid) + if (status /= nf90_noerr) call abort_ice (subname//' inq_varid yc') + status = nf90_get_var(ncid, varid, scamdata, start) + if (status /= nf90_noerr) call abort_ice (subname//' get_var yc') + TLAT = scamdata + status = nf90_inq_varid(ncid, 'area' , varid) + if (status /= nf90_noerr) call abort_ice (subname//' inq_varid area') + status = nf90_get_var(ncid, varid, scamdata, start) + if (status /= nf90_noerr) call abort_ice (subname//' get_var are') + tarea = scamdata + status = nf90_inq_varid(ncid, 'mask' , varid) + if (status /= nf90_noerr) call abort_ice (subname//' inq_varid mask') + status = nf90_get_var(ncid, varid, scamdata, start) + if (status /= nf90_noerr) call abort_ice (subname//' get_var mask') + hm = scamdata + status = nf90_inq_varid(ncid, 'frac' , varid) + if (status /= nf90_noerr) call abort_ice (subname//' inq_varid frac') + status = nf90_get_var(ncid, varid, scamdata, start) + if (status /= nf90_noerr) call abort_ice (subname//' get_var frac') + ocn_gridcell_frac = scamdata + + if (my_task == master_task) then + call ice_close_nc(ncid) + end if + + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo, jhi + do i = ilo, ihi + ! Convert from degrees to radians + TLON(i,j,iblk) = pi*TLON(i,j,iblk)/180._dbl_kind + + ! Convert from degrees to radians + TLAT(i,j,iblk) = pi*TLAT(i,j,iblk)/180._dbl_kind + + ! Convert from radians^2 to m^2 + ! (area in domain file is in radians^2 and tarea is in m^2) + tarea(i,j,iblk) = tarea(i,j,iblk) * (radius*radius) + end do + end do + end do + + end if + + call ice_HaloUpdate (TLON , halo_info, field_loc_center, field_type_scalar, fillValue=c1) + call ice_HaloUpdate (TLAT , halo_info, field_loc_center, field_type_scalar, fillValue=c1) + call ice_HaloUpdate (tarea , halo_info, field_loc_center, field_type_scalar, fillValue=c1) + call ice_HaloUpdate (hm , halo_info, field_loc_center, field_type_scalar, fillValue=c1) + + !----------------------------------------------------------------- + ! CALCULATE various geometric 2d arrays + ! The U grid (velocity) is not used when run with sequential CAM + ! because we only use thermodynamic sea ice. However, ULAT is used + ! in the default initialization of CICE so we calculate it here as + ! a "dummy" so that CICE will initialize with ice. If a no ice + ! initialization is OK (or desired) this can be commented out and + ! ULAT will remain 0 as specified above. ULAT is located at the + ! NE corner of the grid cell, TLAT at the center, so here ULAT is + ! hacked by adding half the latitudinal spacing (in radians) to TLAT. + !----------------------------------------------------------------- + + ANGLET(:,:,:) = c0 + + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo, jhi + do i = ilo, ihi + + if (ny_global == 1) then + uarea(i,j,iblk) = tarea(i,j, iblk) + else + uarea(i,j,iblk) = p25* & + (tarea(i,j, iblk) + tarea(i+1,j, iblk) & + + tarea(i,j+1,iblk) + tarea(i+1,j+1,iblk)) + endif + tarear(i,j,iblk) = c1/tarea(i,j,iblk) + uarear(i,j,iblk) = c1/uarea(i,j,iblk) + tinyarea(i,j,iblk) = puny*tarea(i,j,iblk) + + if (single_column) then + ULAT (i,j,iblk) = TLAT(i,j,iblk)+(pi/nj) + else + if (ny_global == 1) then + ULAT (i,j,iblk) = TLAT(i,j,iblk) + else + ULAT (i,j,iblk) = TLAT(i,j,iblk)+(pi/ny_global) + endif + endif + ULON (i,j,iblk) = c0 + ANGLE (i,j,iblk) = c0 + + HTN (i,j,iblk) = 1.e36_dbl_kind + HTE (i,j,iblk) = 1.e36_dbl_kind + dxt (i,j,iblk) = 1.e36_dbl_kind + dyt (i,j,iblk) = 1.e36_dbl_kind + dxu (i,j,iblk) = 1.e36_dbl_kind + dyu (i,j,iblk) = 1.e36_dbl_kind + dxhy (i,j,iblk) = 1.e36_dbl_kind + dyhx (i,j,iblk) = 1.e36_dbl_kind + cyp (i,j,iblk) = 1.e36_dbl_kind + cxp (i,j,iblk) = 1.e36_dbl_kind + cym (i,j,iblk) = 1.e36_dbl_kind + cxm (i,j,iblk) = 1.e36_dbl_kind + enddo + enddo + enddo + + call ice_HaloUpdate (ULAT, halo_info, field_loc_center, field_type_scalar, fillValue=c1) + + ! Set the boundary values for the T cell land mask (hm) and + ! make the logical land masks for T and U cells (tmask, umask). + ! Also create hemisphere masks (mask-n northern, mask-s southern) + call makemask() + + end subroutine ice_mesh_setmask_from_maskfile + + !=============================================================================== + subroutine ice_mesh_create_mask(ice_mesh, ice_maskfile, ice_mask, ice_frac, rc) + + use ice_constants, only : c0, c1 + + ! input/out variables + type(ESMF_Mesh) , intent(in) :: ice_mesh + character(len=*) , intent(in) :: ice_maskfile + integer , pointer , intent(out) :: ice_mask(:) + real(dbl_kind) , pointer , intent(out) :: ice_frac(:) + integer , intent(out) :: rc + + ! local variables: + type(ESMF_Mesh) :: mesh_mask + type(ESMF_Field) :: field_mask + type(ESMF_Field) :: field_dst + type(ESMF_RouteHandle) :: rhandle + integer :: srcMaskValue = 0 + integer :: dstMaskValue = -987987 ! spval for RH mask values + integer :: srcTermProcessing_Value = 0 + logical :: checkflag = .false. + real(dbl_kind) , pointer :: mask_src(:) ! on mesh created from ice_maskfile + real(dbl_kind) , pointer :: dataptr1d(:) + type(ESMF_DistGrid) :: distgrid_mask + type(ESMF_Array) :: elemMaskArray + integer :: lsize_mask, lsize_dst + integer :: n, spatialDim + real(dbl_kind) :: fminval = 0.001_dbl_kind ! TODO: make this a share constant + real(dbl_kind) :: fmaxval = 1._dbl_kind + real(dbl_kind) :: lfrac + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + mesh_mask = ESMF_MeshCreate(trim(ice_maskfile), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MeshGet(ice_mesh, spatialDim=spatialDim, numOwnedElements=lsize_dst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(ice_mask(lsize_dst)) + allocate(ice_frac(lsize_dst)) + + ! create fields on source and destination meshes + field_mask = ESMF_FieldCreate(mesh_mask, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + field_dst = ESMF_FieldCreate(ice_mesh, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create route handle to map source mask (assume ocean) to destination mesh (assume atm/lnd) + call ESMF_FieldRegridStore(field_mask, field_dst, routehandle=rhandle, & + srcMaskValues=(/srcMaskValue/), dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_CONSERVE, normType=ESMF_NORMTYPE_DSTAREA, & + srcTermProcessing=srcTermProcessing_Value, & + ignoreDegenerate=.true., unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! fill in values for field_mask with mask on source mesh + call ESMF_MeshGet(mesh_mask, elementdistGrid=distgrid_mask, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_DistGridGet(distgrid_mask, localDe=0, elementCount=lsize_mask, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(mask_src(lsize_mask)) + elemMaskArray = ESMF_ArrayCreate(distgrid_mask, mask_src, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! The following call fills in the values of mask_src + call ESMF_MeshGet(mesh_mask, elemMaskArray=elemMaskArray, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! The following call fills in the values of field_mask + call ESMF_FieldGet(field_mask, farrayptr=dataptr1d, rc=rc) + dataptr1d(:) = mask_src(:) + + ! map source mask to destination mesh - to obtain destination mask and frac + call ESMF_FieldRegrid(field_mask, field_dst, routehandle=rhandle, & + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MeshGet(ice_mesh, spatialDim=spatialDim, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field_dst, farrayptr=dataptr1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! now determine ice_mask and ice_frac + do n = 1,lsize_dst + lfrac = c1 - dataptr1d(n) + if (lfrac > fmaxval) lfrac = c1 + if (lfrac < fminval) lfrac = c0 + ice_frac(n) = c1 - lfrac + if (ice_frac(n) == c0) then + ice_mask(n) = 0 + else + ice_mask(n) = 1 + end if + enddo + + ! reset the model mesh mask + call ESMF_MeshSet(ice_mesh, elementMask=ice_mask, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! deallocate memory + call ESMF_RouteHandleDestroy(rhandle, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldDestroy(field_mask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldDestroy(field_dst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + deallocate(mask_src) + + end subroutine ice_mesh_create_mask + + !=============================================================================== + subroutine ice_mesh_check(ice_mesh, rc) + + ! Check CICE mesh + + use ice_constants, only : c1 + use ice_grid , only : tlon, tlat + + ! input/output parameters + type(ESMF_Mesh) , intent(inout) :: ice_mesh + integer , intent(out) :: rc + + ! local variables + type(ESMF_DistGrid) :: distGrid + integer :: n,c,g,i,j,m ! indices + integer :: iblk, jblk ! indices + integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain + type(block) :: this_block ! block information for current block + integer :: spatialDim + integer :: numOwnedElements + real(dbl_kind), pointer :: ownedElemCoords(:) + real(dbl_kind), pointer :: lat(:), latMesh(:) + real(dbl_kind), pointer :: lon(:), lonMesh(:) + real(dbl_kind) :: diff_lon + real(dbl_kind) :: diff_lat + real(dbl_kind) :: rad_to_deg + !--------------------------------------------------- + + ! error check differences between internally generated lons and those read in + call ESMF_MeshGet(ice_mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(ownedElemCoords(spatialDim*numownedelements)) + allocate(lonmesh(numOwnedElements)) + allocate(latmesh(numOwnedElements)) + call ESMF_MeshGet(ice_mesh, ownedElemCoords=ownedElemCoords) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,numOwnedElements + lonMesh(n) = ownedElemCoords(2*n-1) + latMesh(n) = ownedElemCoords(2*n) + end do + + ! obtain internally generated cice lats and lons for error checks + call icepack_query_parameters(rad_to_deg_out=rad_to_deg) + allocate(lon(numOwnedElements)) + allocate(lat(numOwnedElements)) + lon(:) = 0. + lat(:) = 0. + n = 0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + do j = jlo, jhi + do i = ilo, ihi + n = n + 1 + lon(n) = tlon(i,j,iblk)*rad_to_deg + lat(n) = tlat(i,j,iblk)*rad_to_deg + + ! error check differences between internally generated lons and those read in + diff_lon = abs(lonMesh(n) - lon(n)) + if ( (diff_lon > 1.e2 .and. abs(diff_lon - 360.) > 1.e-1) .or.& + (diff_lon > 1.e-3 .and. diff_lon < c1) ) then + write(6,100)n,lonMesh(n),lon(n), diff_lon + !call shr_sys_abort() + end if + if (abs(latMesh(n) - lat(n)) > 1.e-1) then + write(6,101)n,latMesh(n),lat(n), abs(latMesh(n)-lat(n)) + !call shr_sys_abort() + end if + + enddo + enddo + enddo + +100 format('ERROR: CICE n, lonmesh, lon, diff_lon = ',i6,2(f21.13,3x),d21.5) +101 format('ERROR: CICE n, latmesh, lat, diff_lat = ',i6,2(f21.13,3x),d21.5) + + ! deallocate memory + deallocate(ownedElemCoords) + deallocate(lon, lonMesh) + deallocate(lat, latMesh) + + end subroutine ice_mesh_check + +end module ice_mesh_mod From 6ff987ca2cd9db47c86a0b9f59a7fe9f54e6299d Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 31 Jan 2021 18:11:22 -0700 Subject: [PATCH 31/51] implemented area correction factors as option --- cicecore/cicedynB/infrastructure/ice_grid.F90 | 2 +- cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 | 7 +- .../drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 68 +- .../drivers/nuopc/cmeps/ice_import_export.F90 | 919 ++++++++---------- cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 | 57 +- 5 files changed, 476 insertions(+), 577 deletions(-) diff --git a/cicecore/cicedynB/infrastructure/ice_grid.F90 b/cicecore/cicedynB/infrastructure/ice_grid.F90 index ce1af48d8..5ebb502cd 100644 --- a/cicecore/cicedynB/infrastructure/ice_grid.F90 +++ b/cicecore/cicedynB/infrastructure/ice_grid.F90 @@ -40,7 +40,7 @@ module ice_grid private public :: init_grid1, init_grid2, & t2ugrid_vector, u2tgrid_vector, & - to_ugrid, to_tgrid, alloc_grid + to_ugrid, to_tgrid, alloc_grid, makemask character (len=char_len_long), public :: & grid_format , & ! file format ('bin'=binary or 'nc'=netcdf) diff --git a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 index a585dd331..7b7c537ce 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 @@ -3,7 +3,7 @@ module CICE_InitMod ! Initialize CICE model. use ice_kinds_mod - use ice_exit, only: abort_ice + use ice_exit , only: abort_ice use ice_fileunits, only: init_fileunits, nu_diag use icepack_intfc, only: icepack_aggregate use icepack_intfc, only: icepack_init_itd, icepack_init_itd_hist @@ -15,7 +15,10 @@ module CICE_InitMod implicit none private - public :: cice_init + public :: cice_init1 + public :: cice_init2 + + private :: init_restart !======================================================================= contains diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index 74e3307ec..256fe5bf8 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -20,22 +20,16 @@ module ice_comp_nuopc use ice_shr_methods , only : set_component_logging, get_component_instance, state_flddebug use ice_import_export , only : ice_import, ice_export, ice_advertise_fields, ice_realize_fields use ice_domain_size , only : nx_global, ny_global - use ice_domain , only : nblocks, blocks_ice, distrb_info - use ice_blocks , only : block, get_block, nx_block, ny_block, nblocks_x, nblocks_y - use ice_grid , only : tlon, tlat + use ice_grid , only : grid_type, init_grid2 use ice_communicate , only : init_communicate, my_task, master_task, mpi_comm_ice use ice_calendar , only : force_restart_now, write_ic use ice_calendar , only : idate, mday, time, month, daycal, time2sec, year_init use ice_calendar , only : sec, dt, calendar, calendar_type, nextsw_cday, istep use ice_kinds_mod , only : dbl_kind, int_kind, char_len, char_len_long - use ice_scam , only : scmlat, scmlon, single_column use ice_fileunits , only : nu_diag, nu_diag_set, inst_index, inst_name use ice_fileunits , only : inst_suffix, release_all_fileunits, flush_fileunit use ice_restart_shared , only : runid, runtype, restart, use_restart_time, restart_dir, restart_file use ice_history , only : accum_hist - use ice_flux , only : send_i2x_per_cat - use CICE_InitMod , only : cice_init - use CICE_RunMod , only : cice_run use ice_exit , only : abort_ice use icepack_intfc , only : icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc , only : icepack_init_orbit, icepack_init_parameters, icepack_query_orbit @@ -47,6 +41,9 @@ module ice_comp_nuopc use shr_orb_mod , only : shr_orb_decl, shr_orb_params, SHR_ORB_UNDEF_REAL, SHR_ORB_UNDEF_INT #endif use ice_timers + use CICE_InitMod , only : cice_init1, cice_init2 + use CICE_RunMod , only : cice_run + use ice_mesh_mod , only : ice_mesh_set_distgrid, ice_mesh_setmask_from_maskfile, ice_mesh_check use ice_prescribed_mod , only : ice_prescribed_init implicit none @@ -178,6 +175,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Local variables character(len=char_len_long) :: cvalue + character(len=char_len_long) :: ice_meshfile logical :: isPresent, isSet real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp type(ESMF_DistGrid) :: ice_distGrid @@ -213,8 +211,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: iblk, jblk ! indices integer :: ig, jg ! indices integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain - type(block) :: this_block ! block information for current block character(len=char_len_long) :: diag_filename = 'unset' + character(len=char_len_long) :: logmsg character(len=*), parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !-------------------------------- @@ -278,14 +276,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) write(logmsg,'(i6)') dbug call ESMF_LogWrite('CICE_cap: dbug = '//trim(logmsg), ESMF_LOGMSG_INFO) - send_i2x_per_cat = .false. - call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) send_i2x_per_cat - call ESMF_LogWrite('send_i2x_per_cat = '// trim(cvalue), ESMF_LOGMSG_INFO) - end if - !---------------------------------------------------------------------------- ! generate local mpi comm !---------------------------------------------------------------------------- @@ -403,23 +393,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) runtype = 'initial' ! determined from the namelist in ice_init if CESMCOUPLED is not defined end if - ! Determine if single column - call NUOPC_CompAttributeGet(gcomp, name='single_column', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) single_column - if (single_column) then - call NUOPC_CompAttributeGet(gcomp, name='scmlon', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) scmlon - call NUOPC_CompAttributeGet(gcomp, name='scmlat', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) scmlat - end if - else - single_column = .false. - end if - ! Determine runid call NUOPC_CompAttributeGet(gcomp, name='case_name', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (isPresent .and. isSet) then @@ -474,12 +447,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call shr_file_setLogUnit (shrlogunit) - call NUOPC_CompAttributeGet(gcomp, name="diro", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name="diro", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then diag_filename = trim(cvalue) end if - call NUOPC_CompAttributeGet(gcomp, name="logfile", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name="logfile", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then diag_filename = trim(diag_filename) // '/' // trim(cvalue) @@ -508,27 +483,19 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ice_mesh_set_distgrid(localpet, npes, ice_distgrid, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! read in the mesh - call NUOPC_CompAttributeGet(gcomp, name='mesh_ice', value=cvalue, rc=rc) + ! Read in the ice mesh on the cice distribution + call NUOPC_CompAttributeGet(gcomp, name='mesh_ice', value=ice_meshfile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (my_task == master_task) then - write(nu_diag,*)'mesh file for cice domain is ',trim(cvalue) + write(nu_diag,*)'mesh file for cice domain is ',trim(ice_meshfile) end if - - ! Read in the ice mesh on the cice distribution - ice_mesh = ESMF_MeshCreate(filename=trim(ice_meshfile), fileformat=ESMF_FILEFORMAT_ESMFMESH, & - elementDistGrid=ice_distgrid, rc=rc) + ice_mesh = ESMF_MeshCreate(filename=trim(ice_meshfile), & + fileformat=ESMF_FILEFORMAT_ESMFMESH, elementDistGrid=ice_distgrid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Initialize the cice mesh and the cice mask if (trim(grid_type) == 'setmask') then - ! Determine mask input file and create the mask - call NUOPC_CompAttributeGet(gcomp, name='mesh_mask', value=ice_maskfile, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (my_task == master_task) then - write(nu_diag,*)'mask file for cice domain is ',trim(ice_maskfile) - end if - call ice_mesh_setmask_from_maskfile(ice_mesh, ice_maskfile, rc=rc) + call ice_mesh_setmask_from_maskfile(gcomp, ice_mesh, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else ! In this case init_grid2 will initialize tlon, tlat, area and hm @@ -1280,7 +1247,4 @@ subroutine ice_cal_ymd2date(year, month, day, date) end subroutine ice_cal_ymd2date - !=============================================================================== - - end module ice_comp_nuopc diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index a1537a1d8..6e584eb90 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -4,7 +4,7 @@ module ice_import_export use NUOPC use NUOPC_Model use ice_kinds_mod , only : int_kind, dbl_kind, char_len, log_kind - use ice_constants , only : c0, c1, spval_dbl + use ice_constants , only : c0, c1, spval_dbl, radius use ice_constants , only : field_loc_center, field_type_scalar, field_type_vector use ice_blocks , only : block, get_block, nx_block, ny_block use ice_domain , only : nblocks, blocks_ice, halo_info, distrb_info @@ -21,6 +21,7 @@ module ice_import_export use ice_flux , only : fresh, fsalt, zlvl, uatm, vatm, potT, Tair, Qa use ice_flux , only : rhoa, swvdr, swvdf, swidr, swidf, flw, frain use ice_flux , only : fsnow, uocn, vocn, sst, ss_tltx, ss_tlty, frzmlt + use ice_flux , only : send_i2x_per_cat use ice_flux , only : sss, Tf, wind, fsw use ice_state , only : vice, vsno, aice, aicen_init, trcr use ice_grid , only : tlon, tlat, tarea, tmask, anglet, hm, ocn_gridcell_frac @@ -34,7 +35,7 @@ module ice_import_export use icepack_intfc , only : icepack_query_parameters, icepack_query_tracer_flags use icepack_intfc , only : icepack_liquidus_temperature use icepack_intfc , only : icepack_sea_freezing_temperature - use cice_wrapper_mod , only : t_startf, t_stopf, t_barrierf + use cice_wrapper_mod , only : t_startf, t_stopf, t_barrierf #ifdef CESMCOUPLED use shr_frz_mod , only : shr_frz_freezetemp #endif @@ -54,8 +55,6 @@ module ice_import_export interface state_getfldptr module procedure state_getfldptr_1d module procedure state_getfldptr_2d - module procedure state_getfldptr_3d - module procedure state_getfldptr_4d end interface state_getfldptr private :: state_getfldptr @@ -79,12 +78,15 @@ module ice_import_export integer :: ungridded_ubound = 0 end type fld_list_type + ! area correction factors for fluxes send and received from mediator + real(dbl_kind), allocatable :: mod2med_areacor(:) ! ratios of model areas to input mesh areas + real(dbl_kind), allocatable :: med2mod_areacor(:) ! ratios of input mesh areas to model areas + integer, parameter :: fldsMax = 100 integer :: fldsToIce_num = 0 integer :: fldsFrIce_num = 0 type (fld_list_type) :: fldsToIce(fldsMax) type (fld_list_type) :: fldsFrIce(fldsMax) - type(ESMF_GeomType_Flag) :: geomtype integer , parameter :: io_dbug = 10 ! i/o debug messages character(*), parameter :: u_FILE_u = & @@ -115,13 +117,28 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam rc = ESMF_SUCCESS if (io_dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + ! Determine if ice sends multiple ice category info back to mediator + send_i2x_per_cat = .false. + call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) send_i2x_per_cat + end if + if (my_task == master_task) then + write(nu_diag,*)'send_i2x_per_cat = ',send_i2x_per_cat + end if + ! Determine if the following attributes are sent by the driver and if so read them in flds_wiso = .false. - call NUOPC_CompAttributeGet(gcomp, name='flds_wiso', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='flds_wiso', value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then read(cvalue,*) flds_wiso - call ESMF_LogWrite('flds_wiso = '// trim(cvalue), ESMF_LOGMSG_INFO) + end if + if (my_task == master_task) then + write(nu_diag,*)'flds_wiso = ',flds_wiso end if !----------------- @@ -253,21 +270,27 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam end subroutine ice_advertise_fields -!============================================================================== - - subroutine ice_realize_fields(gcomp, mesh, grid, flds_scalar_name, flds_scalar_num, rc) + !============================================================================== + subroutine ice_realize_fields(gcomp, mesh, flds_scalar_name, flds_scalar_num, rc) ! input/output variables - type(ESMF_GridComp) :: gcomp - type(ESMF_Mesh) , optional , intent(in) :: mesh - type(ESMF_Grid) , optional , intent(in) :: grid - character(len=*) , intent(in) :: flds_scalar_name - integer , intent(in) :: flds_scalar_num - integer , intent(out) :: rc + type(ESMF_GridComp) :: gcomp + type(ESMF_Mesh) , intent(in) :: mesh + character(len=*) , intent(in) :: flds_scalar_name + integer , intent(in) :: flds_scalar_num + integer , intent(out) :: rc ! local variables - type(ESMF_State) :: importState - type(ESMF_State) :: exportState + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(ESMF_Field) :: lfield + integer :: numOwnedElements + integer :: i, j, iblk, n + integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain + type(block) :: this_block ! block information for current block + real(dbl_kind), allocatable :: mesh_areas(:) + real(dbl_kind), allocatable :: model_areas(:) + real(dbl_kind), pointer :: dataptr(:) character(len=*), parameter :: subname='(ice_import_export:realize_fields)' !--------------------------------------------------------------------------- @@ -276,60 +299,84 @@ subroutine ice_realize_fields(gcomp, mesh, grid, flds_scalar_name, flds_scalar_n call NUOPC_ModelGet(gcomp, importState=importState, exportState=exportState, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (present(mesh)) then - - geomtype = ESMF_GEOMTYPE_MESH - - call fldlist_realize( & - state=ExportState, & - fldList=fldsFrIce, & - numflds=fldsFrIce_num, & - flds_scalar_name=flds_scalar_name, & - flds_scalar_num=flds_scalar_num, & - tag=subname//':CICE_Export',& - mesh=mesh, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call fldlist_realize( & - state=importState, & - fldList=fldsToIce, & - numflds=fldsToIce_num, & - flds_scalar_name=flds_scalar_name, & - flds_scalar_num=flds_scalar_num, & - tag=subname//':CICE_Import',& - mesh=mesh, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - else if (present(grid)) then + call fldlist_realize( & + state=ExportState, & + fldList=fldsFrIce, & + numflds=fldsFrIce_num, & + flds_scalar_name=flds_scalar_name, & + flds_scalar_num=flds_scalar_num, & + tag=subname//':CICE_Export',& + mesh=mesh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - geomtype = ESMF_GEOMTYPE_GRID + call fldlist_realize( & + state=importState, & + fldList=fldsToIce, & + numflds=fldsToIce_num, & + flds_scalar_name=flds_scalar_name, & + flds_scalar_num=flds_scalar_num, & + tag=subname//':CICE_Import',& + mesh=mesh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldlist_realize( & - state=ExportState, & - fldList=fldsFrIce, & - numflds=fldsFrIce_num, & - flds_scalar_name=flds_scalar_name, & - flds_scalar_num=flds_scalar_num, & - tag=subname//':CICE_Export',& - grid=grid, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Determine areas for regridding + call ESMF_MeshGet(mesh, numOwnedElements=numOwnedElements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate (mod2med_areacor(numOwnedElements)) + allocate (med2mod_areacor(numOwnedElements)) + mod2med_areacor(:) = c1 + med2mod_areacor(:) = c1 - call fldlist_realize( & - state=importState, & - fldList=fldsToIce, & - numflds=fldsToIce_num, & - flds_scalar_name=flds_scalar_name, & - flds_scalar_num=flds_scalar_num, & - tag=subname//':CICE_Import',& - grid=grid, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return +#ifdef CESMCOUPLED + ! Get mesh areas from second field - using second field since the + ! first field is the scalar field + call ESMF_StateGet(exportState, itemName=trim(fldsFrIce(2)%stdname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegridGetArea(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 + allocate(mesh_areas(numOwnedElements)) + mesh_areas(:) = dataptr(:) + + ! Determine model areas + allocate(model_areas(numOwnedElements)) + n = 0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + do j = jlo, jhi + do i = ilo, ihi + n = n+1 + model_areas(n) = tarea(i,j,iblk)/(radius*radius) + enddo + enddo + enddo - end if + ! Determine flux correction factors (module variables) + do n = 1,numOwnedElements + if (model_areas(n) == mesh_areas(n)) then + mod2med_areacor(n) = c1 + med2mod_areacor(n) = c1 + else + mod2med_areacor(n) = model_areas(n) / mesh_areas(n) + med2mod_areacor(n) = mesh_areas(n) / model_areas(n) + if (abs(mod2med_areacor(n) - 1._dbl_kind) > 1.e-13) then + write(6,'(a,i8,2x,d21.14,2x)')' AREACOR cice6: n, abs(mod2med_areacor(n)-1)', & + n, abs(mod2med_areacor(n) - 1._dbl_kind) + end if + end if + end do + deallocate(model_areas) + deallocate(mesh_areas) +#endif end subroutine ice_realize_fields !============================================================================== - subroutine ice_import( importState, rc ) ! input/output variables @@ -346,7 +393,11 @@ subroutine ice_import( importState, rc ) real (kind=dbl_kind) :: workx, worky real (kind=dbl_kind) :: MIN_RAIN_TEMP, MAX_SNOW_TEMP real (kind=dbl_kind) :: Tffresh - real (kind=dbl_kind) :: inst_pres_height_lowest + real (kind=dbl_kind) :: inst_pres_height_lowest + real (kind=dbl_kind), pointer :: dataptr2d(:,:) + real (kind=dbl_kind), pointer :: dataptr1d(:) + real (kind=dbl_kind), pointer :: dataptr2d_dstwet(:,:) + real (kind=dbl_kind), pointer :: dataptr2d_dstdry(:,:) character(len=char_len) :: tfrz_option integer(int_kind) :: ktherm character(len=*), parameter :: subname = 'ice_import' @@ -356,17 +407,20 @@ subroutine ice_import( importState, rc ) call icepack_query_parameters(Tffresh_out=Tffresh) call icepack_query_parameters(tfrz_option_out=tfrz_option) call icepack_query_parameters(ktherm_out=ktherm) - if (io_dbug > 5) then + + if (io_dbug > 5) then write(msgString,'(A,i8)')trim(subname)//' tfrz_option = ' & // trim(tfrz_option)//', ktherm = ',ktherm call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) end if -! call icepack_query_parameters(tfrz_option_out=tfrz_option, & -! modal_aero_out=modal_aero, z_tracers_out=z_tracers, skl_bgc_out=skl_bgc, & -! Tffresh_out=Tffresh) -! call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_iage_out=tr_iage, & -! tr_FY_out=tr_FY, tr_pond_out=tr_pond, tr_lvl_out=tr_lvl, & -! tr_zaero_out=tr_zaero, tr_bgc_Nit_out=tr_bgc_Nit) + + ! call icepack_query_parameters(tfrz_option_out=tfrz_option, & + ! modal_aero_out=modal_aero, z_tracers_out=z_tracers, skl_bgc_out=skl_bgc, & + ! Tffresh_out=Tffresh) + ! call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_iage_out=tr_iage, & + ! tr_FY_out=tr_FY, tr_pond_out=tr_pond, tr_lvl_out=tr_lvl, & + ! tr_zaero_out=tr_zaero, tr_bgc_Nit_out=tr_bgc_Nit) + call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=u_FILE_u, line=__LINE__) @@ -420,30 +474,38 @@ subroutine ice_import( importState, rc ) ! import ocn/ice fluxes - call state_getimport(importState, 'freezing_melting_potential', output=aflds, index=9, rc=rc) + call state_getimport(importState, 'freezing_melting_potential', output=aflds, index=9, & + areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! import atm fluxes - call state_getimport(importState, 'mean_down_sw_vis_dir_flx', output=aflds, index=10, rc=rc) + call state_getimport(importState, 'mean_down_sw_vis_dir_flx', output=aflds, index=10, & + areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_down_sw_ir_dir_flx', output=aflds, index=11, rc=rc) + call state_getimport(importState, 'mean_down_sw_ir_dir_flx', output=aflds, index=11, & + areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_down_sw_vis_dif_flx', output=aflds, index=12, rc=rc) + call state_getimport(importState, 'mean_down_sw_vis_dif_flx', output=aflds, index=12, & + areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_down_sw_ir_dif_flx', output=aflds, index=13, rc=rc) + call state_getimport(importState, 'mean_down_sw_ir_dif_flx', output=aflds, index=13, & + areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_down_lw_flx', output=aflds, index=14, rc=rc) + call state_getimport(importState, 'mean_down_lw_flx', output=aflds, index=14, & + areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_prec_rate', output=aflds, index=15, rc=rc) + call state_getimport(importState, 'mean_prec_rate', output=aflds, index=15, & + areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_fprec_rate', output=aflds, index=16, rc=rc) + call state_getimport(importState, 'mean_fprec_rate', output=aflds, index=16, & + areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! perform a halo update @@ -479,7 +541,7 @@ subroutine ice_import( importState, rc ) end do !$OMP END PARALLEL DO - if ( State_fldChk(importState, 'Sa_ptem') .and. State_fldchk(importState,'air_density_height_lowest')) then + if ( State_fldChk(importState, 'Sa_ptem') .and. State_fldchk(importState,'air_density_height_lowest')) then !$OMP PARALLEL DO PRIVATE(iblk,i,j) do iblk = 1, nblocks do j = 1,ny_block @@ -509,7 +571,7 @@ subroutine ice_import( importState, rc ) endif end do !i end do !j - end do !iblk + end do !iblk !$OMP END PARALLEL DO end if @@ -568,34 +630,45 @@ subroutine ice_import( importState, rc ) ! bcphodry ungridded_index=2 ! bcphiwet ungridded_index=3 - ! bcphodry - call state_getimport(importState, 'Faxa_bcph', output=faero_atm, index=1, ungridded_index=2, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! bcphidry + bcphiwet - call state_getimport(importState, 'Faxa_bcph', output=faero_atm, index=2, ungridded_index=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_bcph', output=faero_atm, index=2, do_sum=.true., ungridded_index=3, rc=rc) + call state_getfldptr(importState, 'Faxa_bcph', fldptr=dataPtr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + n = 0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo; ihi = this_block%ihi + jlo = this_block%jlo; jhi = this_block%jhi + do j = jlo, jhi + do i = ilo, ihi + n = n+1 + faero_atm(i,j,1,iblk) = dataPtr2d(2,n) * med2mod_areacor(n) ! bcphodry + faero_atm(i,j,2,iblk) = (dataptr2d(1,n) + dataPtr2d(3,n)) * med2mod_areacor(n) ! bcphidry + bcphiwet + end do + end do + end do end if ! Sum over all dry and wet dust fluxes from ath atmosphere if (State_FldChk(importState, 'Faxa_dstwet') .and. State_FldChk(importState, 'Faxa_dstdry')) then - call state_getimport(importState, 'Faxa_dstwet', output=faero_atm, index=3, ungridded_index=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_dstdry', output=faero_atm, index=3, do_sum=.true., ungridded_index=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_dstwet', output=faero_atm, index=3, do_sum=.true., ungridded_index=2, rc=rc) + call state_getfldptr(importState, 'Faxa_dstwet', fldptr=dataPtr2d_dstwet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_dstdry', output=faero_atm, index=3, do_sum=.true., ungridded_index=2, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_dstwet', output=faero_atm, index=3, do_sum=.true., ungridded_index=3, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_dstdry', output=faero_atm, index=3, do_sum=.true., ungridded_index=3, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_dstwet', output=faero_atm, index=3, do_sum=.true., ungridded_index=4, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_dstdry', output=faero_atm, index=3, do_sum=.true., ungridded_index=4, rc=rc) + call state_getfldptr(importState, 'Faxa_dstdry', fldptr=dataPtr2d_dstdry, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + n = 0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo; ihi = this_block%ihi + jlo = this_block%jlo; jhi = this_block%jhi + do j = jlo, jhi + do i = ilo, ihi + n = n+1 + faero_atm(i,j,3,iblk) = dataPtr2d_dstwet(1,n) + dataptr2d_dstdry(1,n) + & + dataPtr2d_dstwet(2,n) + dataptr2d_dstdry(2,n) + & + dataPtr2d_dstwet(3,n) + dataptr2d_dstdry(3,n) + & + dataPtr2d_dstwet(4,n) + dataptr2d_dstdry(4,n) + faero_atm(i,j,3,iblk) = faero_atm(i,j,3,iblk) * med2mod_areacor(n) + end do + end do + end do end if !------------------------------------------------------- @@ -614,12 +687,15 @@ subroutine ice_import( importState, rc ) call state_getimport(importState, 'inst_spec_humid_height_lowest_wiso', output=Qa_iso, index=3, ungridded_index=2, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call state_getimport(importState, 'mean_prec_rate_wiso', output=fiso_rain, index=1, ungridded_index=3, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call state_getimport(importState, 'mean_prec_rate_wiso', output=fiso_rain, index=2, ungridded_index=1, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return -! call state_getimport(importState, 'mean_prec_rate_wiso', output=fiso_rain, index=3, ungridded_index=2, rc=rc) -! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call state_getimport(importState, 'mean_prec_rate_wiso', output=fiso_rain, index=1, ungridded_index=3, & + ! areacor=med2mod_areacor, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call state_getimport(importState, 'mean_prec_rate_wiso', output=fiso_rain, index=2, ungridded_index=1, & + ! areacor=med2mod_areacor, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call state_getimport(importState, 'mean_prec_rate_wiso', output=fiso_rain, index=3, ungridded_index=2, & + ! areacor=med2mod_areacor, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_getimport(importState, 'mean_fprec_rate_wiso', output=fiso_atm, index=1, ungridded_index=3, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -628,11 +704,14 @@ subroutine ice_import( importState, rc ) call state_getimport(importState, 'mean_fprec_rate_wiso', output=fiso_atm, index=3, ungridded_index=2, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'So_roce_wiso', output=HDO_ocn , ungridded_index=3, rc=rc) + call state_getimport(importState, 'So_roce_wiso', output=HDO_ocn , ungridded_index=3, & + areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'So_roce_wiso', output=H2_16O_ocn, ungridded_index=1, rc=rc) + call state_getimport(importState, 'So_roce_wiso', output=H2_16O_ocn, ungridded_index=1, & + areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'So_roce_wiso', output=H2_18O_ocn, ungridded_index=2, rc=rc) + call state_getimport(importState, 'So_roce_wiso', output=H2_18O_ocn, ungridded_index=2, & + areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -682,7 +761,7 @@ subroutine ice_import( importState, rc ) #ifdef CESMCOUPLED ! Use shr_frz_mod for this Tf(:,:,iblk) = shr_frz_freezetemp(sss(:,:,iblk)) -#else +#else !$OMP PARALLEL DO PRIVATE(iblk,i,j,workx,worky) do iblk = 1, nblocks do j = 1,ny_block @@ -738,7 +817,6 @@ subroutine ice_import( importState, rc ) end subroutine ice_import !=============================================================================== - subroutine ice_export( exportState, rc ) ! input/output variables @@ -770,12 +848,13 @@ subroutine ice_export( exportState, rc ) if (io_dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) call icepack_query_parameters(Tffresh_out=Tffresh) -! call icepack_query_parameters(tfrz_option_out=tfrz_option, & -! modal_aero_out=modal_aero, z_tracers_out=z_tracers, skl_bgc_out=skl_bgc, & -! Tffresh_out=Tffresh) -! call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_iage_out=tr_iage, & -! tr_FY_out=tr_FY, tr_pond_out=tr_pond, tr_lvl_out=tr_lvl, & -! tr_zaero_out=tr_zaero, tr_bgc_Nit_out=tr_bgc_Nit) + ! call icepack_query_parameters(tfrz_option_out=tfrz_option, & + ! modal_aero_out=modal_aero, z_tracers_out=z_tracers, skl_bgc_out=skl_bgc, & + ! Tffresh_out=Tffresh) + ! call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_iage_out=tr_iage, & + ! tr_FY_out=tr_FY, tr_pond_out=tr_pond, tr_lvl_out=tr_lvl, & + ! tr_zaero_out=tr_zaero, tr_bgc_Nit_out=tr_bgc_Nit) + call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=u_FILE_u, line=__LINE__) @@ -958,31 +1037,38 @@ subroutine ice_export( exportState, rc ) ! ------ ! Zonal air/ice stress - call state_setexport(exportState, 'stress_on_air_ice_zonal' , input=tauxa, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'stress_on_air_ice_zonal' , input=tauxa, lmask=tmask, ifrac=ailohi, & + areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Meridional air/ice stress - call state_setexport(exportState, 'stress_on_air_ice_merid' , input=tauya, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'stress_on_air_ice_merid' , input=tauya, lmask=tmask, ifrac=ailohi, & + areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Latent heat flux (atm into ice) - call state_setexport(exportState, 'mean_laten_heat_flx_atm_into_ice' , input=flat, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'mean_laten_heat_flx_atm_into_ice' , input=flat, lmask=tmask, ifrac=ailohi, & + areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Sensible heat flux (atm into ice) - call state_setexport(exportState, 'mean_sensi_heat_flx_atm_into_ice' , input=fsens, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'mean_sensi_heat_flx_atm_into_ice' , input=fsens, lmask=tmask, ifrac=ailohi, & + areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! longwave outgoing (upward), average over ice fraction only - call state_setexport(exportState, 'mean_up_lw_flx_ice' , input=flwout, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'mean_up_lw_flx_ice' , input=flwout, lmask=tmask, ifrac=ailohi, & + areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Evaporative water flux (kg/m^2/s) - call state_setexport(exportState, 'mean_evap_rate_atm_into_ice' , input=evap, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'mean_evap_rate_atm_into_ice' , input=evap, lmask=tmask, ifrac=ailohi, & + areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Shortwave flux absorbed in ice and ocean (W/m^2) - call state_setexport(exportState, 'Faii_swnet' , input=fswabs, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'Faii_swnet' , input=fswabs, lmask=tmask, ifrac=ailohi, & + areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ------ @@ -990,43 +1076,53 @@ subroutine ice_export( exportState, rc ) ! ------ ! flux of shortwave through ice to ocean - call state_setexport(exportState, 'mean_sw_pen_to_ocn' , input=fswthru, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'mean_sw_pen_to_ocn' , input=fswthru, lmask=tmask, ifrac=ailohi, & + areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! flux of vis dir shortwave through ice to ocean - call state_setexport(exportState, 'mean_sw_pen_to_ocn_vis_dir_flx' , input=fswthru_vdr, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'mean_sw_pen_to_ocn_vis_dir_flx' , input=fswthru_vdr, lmask=tmask, ifrac=ailohi, & + areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! flux of vis dif shortwave through ice to ocean - call state_setexport(exportState, 'mean_sw_pen_to_ocn_vis_dif_flx' , input=fswthru_vdf, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'mean_sw_pen_to_ocn_vis_dif_flx' , input=fswthru_vdf, lmask=tmask, ifrac=ailohi, & + areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! flux of ir dir shortwave through ice to ocean - call state_setexport(exportState, 'mean_sw_pen_to_ocn_ir_dir_flx' , input=fswthru_idr, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'mean_sw_pen_to_ocn_ir_dir_flx' , input=fswthru_idr, lmask=tmask, ifrac=ailohi, & + areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! flux of ir dif shortwave through ice to ocean - call state_setexport(exportState, 'mean_sw_pen_to_ocn_ir_dif_flx' , input=fswthru_idf, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'mean_sw_pen_to_ocn_ir_dif_flx' , input=fswthru_idf, lmask=tmask, ifrac=ailohi, & + areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! heat exchange with ocean - call state_setexport(exportState, 'net_heat_flx_to_ocn' , input=fhocn, lmask=tmask, ifrac=ailohi, rc=rc) + ! flux of heat exchange with ocean + call state_setexport(exportState, 'net_heat_flx_to_ocn' , input=fhocn, lmask=tmask, ifrac=ailohi, & + areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! fresh water to ocean (h2o flux from melting) - call state_setexport(exportState, 'mean_fresh_water_to_ocean_rate' , input=fresh, lmask=tmask, ifrac=ailohi, rc=rc) + ! flux fresh water to ocean (h2o flux from melting) + call state_setexport(exportState, 'mean_fresh_water_to_ocean_rate' , input=fresh, lmask=tmask, ifrac=ailohi, & + areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! salt to ocean (salt flux from melting) - call state_setexport(exportState, 'mean_salt_rate' , input=fsalt, lmask=tmask, ifrac=ailohi, rc=rc) + ! flux of salt to ocean (salt flux from melting) + call state_setexport(exportState, 'mean_salt_rate' , input=fsalt, lmask=tmask, ifrac=ailohi, & + areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! stress n i/o zonal - call state_setexport(exportState, 'stress_on_ocn_ice_zonal' , input=tauxo, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'stress_on_ocn_ice_zonal' , input=tauxo, lmask=tmask, ifrac=ailohi, & + areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! stress n i/o meridional - call state_setexport(exportState, 'stress_on_ocn_ice_merid' , input=tauyo, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'stress_on_ocn_ice_merid' , input=tauyo, lmask=tmask, ifrac=ailohi, & + areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ------ @@ -1035,19 +1131,22 @@ subroutine ice_export( exportState, rc ) ! hydrophobic bc if (State_FldChk(exportState, 'Fioi_bcpho')) then - call state_setexport(exportState, 'Fioi_bcpho' , input=faero_ocn, index=1, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'Fioi_bcpho' , input=faero_ocn, index=1, lmask=tmask, ifrac=ailohi, & + areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! hydrophilic bc if (State_FldChk(exportState, 'Fioi_bcphi')) then - call state_setexport(exportState, 'Fioi_bcphi' , input=faero_ocn, index=2, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'Fioi_bcphi' , input=faero_ocn, index=2, lmask=tmask, ifrac=ailohi, & + areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! dust if (State_FldChk(exportState, 'Fioi_flxdst')) then - call state_setexport(exportState, 'Fioi_flxdst' , input=faero_ocn, index=3, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'Fioi_flxdst' , input=faero_ocn, index=3, lmask=tmask, ifrac=ailohi, & + areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -1061,13 +1160,13 @@ subroutine ice_export( exportState, rc ) ! HDO => ungridded_index=3 call state_setexport(exportState, 'mean_fresh_water_to_ocean_rate_wiso' , input=fiso_ocn, index=1, & - lmask=tmask, ifrac=ailohi, ungridded_index=3, rc=rc) + lmask=tmask, ifrac=ailohi, ungridded_index=3, areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_setexport(exportState, 'mean_fresh_water_to_ocean_rate_wiso' , input=fiso_ocn, index=2, & - lmask=tmask, ifrac=ailohi, ungridded_index=1, rc=rc) + lmask=tmask, ifrac=ailohi, ungridded_index=1, areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_setexport(exportState, 'mean_fresh_water_to_ocean_rate_wiso' , input=fiso_ocn, index=3, & - lmask=tmask, ifrac=ailohi, ungridded_index=2, rc=rc) + lmask=tmask, ifrac=ailohi, ungridded_index=2, areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -1078,16 +1177,16 @@ subroutine ice_export( exportState, rc ) if (State_FldChk(exportState, 'mean_evap_rate_atm_into_ice_wiso')) then ! Isotope evap to atm call state_setexport(exportState, 'mean_evap_rate_atm_into_ice_wiso' , input=fiso_evap, index=1, & - lmask=tmask, ifrac=ailohi, ungridded_index=3, rc=rc) + lmask=tmask, ifrac=ailohi, ungridded_index=3, areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_setexport(exportState, 'mean_evap_rate_atm_into_ice_wiso' , input=fiso_evap, index=2, & - lmask=tmask, ifrac=ailohi, ungridded_index=1, rc=rc) + lmask=tmask, ifrac=ailohi, ungridded_index=1, areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_setexport(exportState, 'mean_evap_rate_atm_into_ice_wiso' , input=fiso_evap, index=3, & - lmask=tmask, ifrac=ailohi, ungridded_index=2, rc=rc) + lmask=tmask, ifrac=ailohi, ungridded_index=2, areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Isotope evap to atm + ! qref to atm call state_setexport(exportState, 'Si_qref_wiso' , input=Qref_iso, index=1, & lmask=tmask, ifrac=ailohi, ungridded_index=3, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1115,7 +1214,7 @@ subroutine ice_export( exportState, rc ) ! Note: no need zero out pass-through fields over land for benefit of x2oacc fields in cpl hist files since ! the export state has been zeroed out at the beginning call state_setexport(exportState, 'mean_sw_pen_to_ocn_ifrac_n', input=fswthrun_ai, index=n, & - lmask=tmask, ifrac=ailohi, ungridded_index=n, rc=rc) + lmask=tmask, ifrac=ailohi, ungridded_index=n, areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do end if @@ -1123,7 +1222,6 @@ subroutine ice_export( exportState, rc ) end subroutine ice_export !=============================================================================== - subroutine fldlist_add(num, fldlist, stdname, ungridded_lbound, ungridded_ubound) ! input/output variables @@ -1153,7 +1251,6 @@ subroutine fldlist_add(num, fldlist, stdname, ungridded_lbound, ungridded_ubound end subroutine fldlist_add !=============================================================================== - subroutine fldlist_realize(state, fldList, numflds, flds_scalar_name, flds_scalar_num, mesh, grid, tag, rc) use NUOPC, only : NUOPC_IsConnected, NUOPC_Realize @@ -1284,7 +1381,6 @@ end subroutine SetScalarField end subroutine fldlist_realize !=============================================================================== - logical function State_FldChk(State, fldname) ! ---------------------------------------------- ! Determine if field is in state @@ -1299,27 +1395,25 @@ logical function State_FldChk(State, fldname) ! ---------------------------------------------- call ESMF_StateGet(State, trim(fldname), itemType) - State_FldChk = (itemType /= ESMF_STATEITEM_NOTFOUND) end function State_FldChk !=============================================================================== - - subroutine state_getimport_4d_output(state, fldname, output, index, do_sum, ungridded_index, rc) + subroutine state_getimport_4d_output(state, fldname, output, index, ungridded_index, areacor, rc) ! ---------------------------------------------- ! Map import state field to output array ! ---------------------------------------------- ! input/output variables - type(ESMF_State) , intent(in) :: state - character(len=*) , intent(in) :: fldname - real (kind=dbl_kind) , intent(inout) :: output(:,:,:,:) - integer , intent(in) :: index - logical, optional , intent(in) :: do_sum - integer, optional , intent(in) :: ungridded_index - integer , intent(out) :: rc + type(ESMF_State) , intent(in) :: state + character(len=*) , intent(in) :: fldname + real (kind=dbl_kind) , intent(inout) :: output(:,:,:,:) + integer , intent(in) :: index + integer, optional , intent(in) :: ungridded_index + real(kind=dbl_kind), optional , intent(in) :: areacor(:) + integer , intent(out) :: rc ! local variables type(block) :: this_block ! block information for current block @@ -1327,9 +1421,7 @@ subroutine state_getimport_4d_output(state, fldname, output, index, do_sum, ungr integer :: i, j, iblk, n, i1, j1 ! incides real(kind=dbl_kind), pointer :: dataPtr1d(:) ! mesh real(kind=dbl_kind), pointer :: dataPtr2d(:,:) ! mesh - real(kind=dbl_kind), pointer :: dataPtr3d(:,:,:) ! grid - real(kind=dbl_kind), pointer :: dataPtr4d(:,:,:,:) ! grid - character(len=*), parameter :: subname='(ice_import_export:state_getimport)' + character(len=*), parameter :: subname='(ice_import_export:state_getimport_4d_output)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -1337,103 +1429,62 @@ subroutine state_getimport_4d_output(state, fldname, output, index, do_sum, ungr ! check that fieldname exists if (.not. State_FldChk(state, trim(fldname))) return - if (geomtype == ESMF_GEOMTYPE_MESH) then - - ! get field pointer - if (present(ungridded_index)) then - call state_getfldptr(state, trim(fldname), dataPtr2d, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call state_getfldptr(state, trim(fldname), dataPtr1d, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + ! get field pointer + if (present(ungridded_index)) then + call state_getfldptr(state, trim(fldname), dataPtr2d, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call state_getfldptr(state, trim(fldname), dataPtr1d, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - ! set values of output array - n=0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - do j = jlo, jhi - do i = ilo, ihi - n = n+1 - if (present(do_sum)) then ! do sum - if (present(ungridded_index)) then - output(i,j,index,iblk) = output(i,j,index, iblk) + dataPtr2d(ungridded_index,n) - else - output(i,j,index,iblk) = output(i,j,index, iblk) + dataPtr1d(n) - end if - else ! do not do sum - if (present(ungridded_index)) then - output(i,j,index,iblk) = dataPtr2d(ungridded_index,n) - else - output(i,j,index,iblk) = dataPtr1d(n) - end if - end if - end do + ! set values of output array + n=0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + do j = jlo, jhi + do i = ilo, ihi + n = n+1 + if (present(ungridded_index)) then + output(i,j,index,iblk) = dataPtr2d(ungridded_index,n) + else + output(i,j,index,iblk) = dataPtr1d(n) + end if end do end do - - else if (geomtype == ESMF_GEOMTYPE_GRID) then - - ! get field pointer + end do + if (present(areacor)) then if (present(ungridded_index)) then - call state_getfldptr(state, trim(fldname), dataptr4d, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(dataptr2d,dim=2) + dataPtr2d(:,n) = dataPtr2d(:,n) * areacor(n) + end do else - call state_getfldptr(state, trim(fldname), dataptr3d, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - ! set values of output array - do iblk = 1,nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - do j = jlo,jhi - do i = ilo,ihi - i1 = i - ilo + 1 - j1 = j - jlo + 1 - if (present(do_sum)) then - if (present(ungridded_index)) then - output(i,j,index,iblk) = output(i,j,index,iblk) + dataPtr4d(i1,j1,iblk,ungridded_index) - else - output(i,j,index,iblk) = output(i,j,index,iblk) + dataPtr3d(i1,j1,iblk) - end if - else - if (present(ungridded_index)) then - output(i,j,index,iblk) = dataPtr4d(i1,j1,iblk,ungridded_index) - else - output(i,j,index,iblk) = dataPtr3d(i1,j1,iblk) - end if - end if - end do + do n = 1,size(dataptr1d) + dataPtr1d(n) = dataPtr1d(n) * areacor(n) end do - end do - + end if end if end subroutine state_getimport_4d_output !=============================================================================== - - subroutine state_getimport_3d_output(state, fldname, output, do_sum, ungridded_index, rc) + subroutine state_getimport_3d_output(state, fldname, output, ungridded_index, areacor, rc) ! ---------------------------------------------- ! Map import state field to output array ! ---------------------------------------------- ! input/output variables - type(ESMF_State) , intent(in) :: state - character(len=*) , intent(in) :: fldname - real (kind=dbl_kind) , intent(inout) :: output(:,:,:) - logical, optional , intent(in) :: do_sum - integer, optional , intent(in) :: ungridded_index - integer , intent(out) :: rc + type(ESMF_State) , intent(in) :: state + character(len=*) , intent(in) :: fldname + real (kind=dbl_kind) , intent(inout) :: output(:,:,:) + integer, optional , intent(in) :: ungridded_index + real(kind=dbl_kind), optional , intent(in) :: areacor(:) + integer , intent(out) :: rc ! local variables type(block) :: this_block ! block information for current block @@ -1441,8 +1492,6 @@ subroutine state_getimport_3d_output(state, fldname, output, do_sum, ungridded_i integer :: i, j, iblk, n, i1, j1 ! incides real(kind=dbl_kind), pointer :: dataPtr1d(:) ! mesh real(kind=dbl_kind), pointer :: dataPtr2d(:,:) ! mesh - real(kind=dbl_kind), pointer :: dataPtr3d(:,:,:) ! grid - real(kind=dbl_kind), pointer :: dataPtr4d(:,:,:,:) ! grid character(len=*) , parameter :: subname='(ice_import_export:state_getimport)' ! ---------------------------------------------- @@ -1451,83 +1500,53 @@ subroutine state_getimport_3d_output(state, fldname, output, do_sum, ungridded_i ! check that fieldname exists if (.not. State_FldChk(state, trim(fldname))) return - if (geomtype == ESMF_GEOMTYPE_MESH) then - - ! get field pointer - if (present(ungridded_index)) then - call state_getfldptr(state, trim(fldname), dataPtr2d, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call state_getfldptr(state, trim(fldname), dataPtr1d, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + ! get field pointer + if (present(ungridded_index)) then + call state_getfldptr(state, trim(fldname), dataPtr2d, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call state_getfldptr(state, trim(fldname), dataPtr1d, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - ! determine output array - n=0 + ! determine output array + n = 0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + do j = jlo, jhi + do i = ilo, ihi + n = n+1 + if (present(ungridded_index)) then + output(i,j,iblk) = dataPtr2d(ungridded_index,n) + else + output(i,j,iblk) = dataPtr1d(n) + end if + end do + end do + end do + if (present(areacor)) then + n = 0 do iblk = 1, nblocks this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi + ilo = this_block%ilo; ihi = this_block%ihi + jlo = this_block%jlo; jhi = this_block%jhi do j = jlo, jhi do i = ilo, ihi - n = n+1 - if (present(do_sum) .and. present(ungridded_index)) then - output(i,j,iblk) = output(i,j,iblk) + dataPtr2d(ungridded_index,n) - else if (present(do_sum)) then - output(i,j,iblk) = output(i,j,iblk) + dataPtr1d(n) - else if (present(ungridded_index)) then - output(i,j,iblk) = dataPtr2d(ungridded_index,n) - else - output(i,j,iblk) = dataPtr1d(n) - end if + n = n + 1 + output(i,j,iblk) = output(i,j,iblk) * areacor(n) end do end do end do - - else if (geomtype == ESMF_GEOMTYPE_GRID) then - - ! get field pointer - if (present(ungridded_index)) then - call state_getfldptr(state, trim(fldname), dataptr4d, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call state_getfldptr(state, trim(fldname), dataptr3d, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - ! set values of output array - do iblk = 1,nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - do j = jlo,jhi - do i = ilo,ihi - i1 = i - ilo + 1 - j1 = j - jlo + 1 - if (present(do_sum) .and. present(ungridded_index)) then - output(i,j,iblk) = output(i,j,iblk) + dataPtr4d(i1,j1,iblk,ungridded_index) - else if (present(do_sum)) then - output(i,j,iblk) = output(i,j,iblk) + dataPtr3d(i1,j1,iblk) - else if (present(ungridded_index)) then - output(i,j,iblk) = dataPtr4d(i1,j1,iblk, ungridded_index) - else - output(i,j,iblk) = dataPtr3d(i1,j1,iblk) - end if - end do - end do - end do - end if end subroutine state_getimport_3d_output !=============================================================================== - - subroutine state_setexport_4d_input(state, fldname, input, index, lmask, ifrac, ungridded_index, rc) + subroutine state_setexport_4d_input(state, fldname, input, index, lmask, ifrac, ungridded_index, areacor, rc) ! ---------------------------------------------- ! Map 4d input array to export state field @@ -1541,6 +1560,7 @@ subroutine state_setexport_4d_input(state, fldname, input, index, lmask, ifrac, logical , optional, intent(in) :: lmask(:,:,:) real(kind=dbl_kind) , optional, intent(in) :: ifrac(:,:,:) integer , optional, intent(in) :: ungridded_index + real(kind=dbl_kind) , optional, intent(in) :: areacor(:) integer , intent(out) :: rc ! local variables @@ -1549,8 +1569,6 @@ subroutine state_setexport_4d_input(state, fldname, input, index, lmask, ifrac, integer :: i, j, iblk, n, i1, j1 ! indices real(kind=dbl_kind), pointer :: dataPtr1d(:) ! mesh real(kind=dbl_kind), pointer :: dataPtr2d(:,:) ! mesh - real(kind=dbl_kind), pointer :: dataPtr3d(:,:,:) ! grid - real(kind=dbl_kind), pointer :: dataPtr4d(:,:,:,:) ! grid character(len=*), parameter :: subname='(ice_import_export:state_setexport)' ! ---------------------------------------------- @@ -1559,93 +1577,60 @@ subroutine state_setexport_4d_input(state, fldname, input, index, lmask, ifrac, ! check that fieldname exists if (.not. State_FldChk(state, trim(fldname))) return - if (geomtype == ESMF_GEOMTYPE_MESH) then - - ! get field pointer - if (present(ungridded_index)) then - call state_getfldptr(state, trim(fldname), dataPtr2d, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call state_getfldptr(state, trim(fldname), dataPtr1d, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + ! get field pointer + if (present(ungridded_index)) then + call state_getfldptr(state, trim(fldname), dataPtr2d, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call state_getfldptr(state, trim(fldname), dataPtr1d, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - ! set values of field pointer - n = 0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - do j = jlo, jhi - do i = ilo, ihi - n = n+1 - if (present(lmask) .and. present(ifrac)) then - if ( lmask(i,j,iblk) .and. ifrac(i,j,iblk) > c0 ) then - if (present(ungridded_index)) then - dataPtr2d(ungridded_index,n) = input(i,j,index,iblk) - else - dataPtr1d(n) = input(i,j,index,iblk) - end if - end if - else + ! set values of field pointer + n = 0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + do j = jlo, jhi + do i = ilo, ihi + n = n+1 + if (present(lmask) .and. present(ifrac)) then + if ( lmask(i,j,iblk) .and. ifrac(i,j,iblk) > c0 ) then if (present(ungridded_index)) then dataPtr2d(ungridded_index,n) = input(i,j,index,iblk) else dataPtr1d(n) = input(i,j,index,iblk) end if end if - end do + else + if (present(ungridded_index)) then + dataPtr2d(ungridded_index,n) = input(i,j,index,iblk) + else + dataPtr1d(n) = input(i,j,index,iblk) + end if + end if end do end do - - else if (geomtype == ESMF_GEOMTYPE_GRID) then - + end do + if (present(areacor)) then if (present(ungridded_index)) then - call state_getfldptr(state, trim(fldname), dataptr4d, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(dataptr2d,dim=2) + dataPtr2d(:,n) = dataPtr2d(:,n) * areacor(n) + end do else - call state_getfldptr(state, trim(fldname), dataptr3d, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - do iblk = 1,nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - do j = jlo,jhi - do i = ilo,ihi - i1 = i - ilo + 1 - j1 = j - jlo + 1 - if (present(lmask) .and. present(ifrac)) then - if ( lmask(i,j,iblk) .and. ifrac(i,j,iblk) > c0 ) then - if (present(ungridded_index)) then - dataPtr4d(i1,j1,iblk,ungridded_index) = input(i,j,index,iblk) - end if - else - dataPtr3d(i1,j1,iblk) = input(i,j,index,iblk) - end if - else - if (present(ungridded_index)) then - dataPtr4d(i1,j1,iblk,ungridded_index) = input(i,j,index,iblk) - else - dataPtr3d(i1,j1,iblk) = input(i,j,index,iblk) - end if - end if - end do + do n = 1,size(dataptr1d) + dataPtr1d(n) = dataPtr1d(n) * areacor(n) end do - end do - + end if end if end subroutine state_setexport_4d_input !=============================================================================== - - subroutine state_setexport_3d_input(state, fldname, input, lmask, ifrac, ungridded_index, rc) + subroutine state_setexport_3d_input(state, fldname, input, lmask, ifrac, ungridded_index, areacor, rc) ! ---------------------------------------------- ! Map 3d input array to export state field @@ -1658,6 +1643,7 @@ subroutine state_setexport_3d_input(state, fldname, input, lmask, ifrac, ungridd logical , optional , intent(in) :: lmask(:,:,:) real(kind=dbl_kind) , optional , intent(in) :: ifrac(:,:,:) integer , optional , intent(in) :: ungridded_index + real(kind=dbl_kind) , optional , intent(in) :: areacor(:) integer , intent(out) :: rc ! local variables @@ -1666,8 +1652,6 @@ subroutine state_setexport_3d_input(state, fldname, input, lmask, ifrac, ungridd integer :: i, j, iblk, n, i1, j1 ! incides real(kind=dbl_kind), pointer :: dataPtr1d(:) ! mesh real(kind=dbl_kind), pointer :: dataPtr2d(:,:) ! mesh - real(kind=dbl_kind), pointer :: dataPtr3d(:,:,:) ! grid - real(kind=dbl_kind), pointer :: dataPtr4d(:,:,:,:) ! grid character(len=*), parameter :: subname='(ice_import_export:state_setexport)' ! ---------------------------------------------- @@ -1676,92 +1660,58 @@ subroutine state_setexport_3d_input(state, fldname, input, lmask, ifrac, ungridd ! check that fieldname exists if (.not. State_FldChk(state, trim(fldname))) return - if (geomtype == ESMF_GEOMTYPE_MESH) then - - ! get field pointer - if (present(ungridded_index)) then - call state_getfldptr(state, trim(fldname), dataPtr2d, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call state_getfldptr(state, trim(fldname), dataPtr1d, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + ! get field pointer + if (present(ungridded_index)) then + call state_getfldptr(state, trim(fldname), dataPtr2d, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call state_getfldptr(state, trim(fldname), dataPtr1d, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - n = 0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - do j = jlo, jhi - do i = ilo, ihi - n = n+1 - if (present(lmask) .and. present(ifrac)) then - if ( lmask(i,j,iblk) .and. ifrac(i,j,iblk) > c0 ) then - if (present(ungridded_index)) then - dataPtr2d(ungridded_index,n) = input(i,j,iblk) - else - dataPtr1d(n) = input(i,j,iblk) - end if - end if - else + n = 0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + do j = jlo, jhi + do i = ilo, ihi + n = n+1 + if (present(lmask) .and. present(ifrac)) then + if ( lmask(i,j,iblk) .and. ifrac(i,j,iblk) > c0 ) then if (present(ungridded_index)) then dataPtr2d(ungridded_index,n) = input(i,j,iblk) else dataPtr1d(n) = input(i,j,iblk) end if end if - end do + else + if (present(ungridded_index)) then + dataPtr2d(ungridded_index,n) = input(i,j,iblk) + else + dataPtr1d(n) = input(i,j,iblk) + end if + end if end do end do - - else if (geomtype == ESMF_GEOMTYPE_GRID) then - - ! get field pointer + end do + if (present(areacor)) then if (present(ungridded_index)) then - call state_getfldptr(state, trim(fldname), dataptr4d, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(dataptr2d,dim=2) + dataPtr2d(:,n) = dataPtr2d(:,n) * areacor(n) + end do else - call state_getfldptr(state, trim(fldname), dataptr3d, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - do iblk = 1,nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - do j = jlo,jhi - do i = ilo,ihi - i1 = i - ilo + 1 - j1 = j - jlo + 1 - if (present(lmask) .and. present(ifrac)) then - if ( lmask(i,j,iblk) .and. ifrac(i,j,iblk) > c0 ) then - if (present(ungridded_index)) then - dataPtr4d(i1,j1,iblk,ungridded_index) = input(i,j,iblk) - else - dataPtr3d(i1,j1,iblk) = input(i,j,iblk) - end if - end if - else - if (present(ungridded_index)) then - dataPtr4d(i1,j1,iblk,ungridded_index) = input(i,j,iblk) - else - dataPtr3d(i1,j1,iblk) = input(i,j,iblk) - end if - end if - end do + do n = 1,size(dataptr1d) + dataPtr1d(n) = dataPtr1d(n) * areacor(n) end do - end do - + end if end if end subroutine state_setexport_3d_input !=============================================================================== - subroutine State_GetFldPtr_1d(State, fldname, fldptr, rc) ! ---------------------------------------------- ! Get pointer to a state field @@ -1785,10 +1735,10 @@ subroutine State_GetFldPtr_1d(State, fldname, fldptr, rc) call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + end subroutine State_GetFldPtr_1d !=============================================================================== - subroutine State_GetFldPtr_2d(State, fldname, fldptr, rc) ! ---------------------------------------------- ! Get pointer to a state field @@ -1807,65 +1757,12 @@ subroutine State_GetFldPtr_2d(State, fldname, fldptr, rc) rc = ESMF_SUCCESS - call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end subroutine State_GetFldPtr_2d - - !=============================================================================== - - subroutine State_GetFldPtr_3d(State, fldname, fldptr, rc) - ! ---------------------------------------------- - ! Get pointer to a state field - ! ---------------------------------------------- - - ! input/output variables - type(ESMF_State) , intent(in) :: State - character(len=*) , intent(in) :: fldname - real(kind=dbl_kind) , pointer , intent(inout) :: fldptr(:,:,:) - integer , optional , intent(out) :: rc - - ! local variables - type(ESMF_Field) :: lfield - character(len=*),parameter :: subname='(ice_import_export:State_GetFldPtr_3d)' - ! ---------------------------------------------- - - rc = ESMF_SUCCESS - call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end subroutine State_GetFldPtr_3d - !=============================================================================== - - subroutine State_GetFldPtr_4d(State, fldname, fldptr, rc) - ! ---------------------------------------------- - ! Get pointer to a state field - ! ---------------------------------------------- - - ! input/output variables - type(ESMF_State) , intent(in) :: State - character(len=*) , intent(in) :: fldname - real(kind=dbl_kind) , pointer , intent(inout) :: fldptr(:,:,:,:) - integer , optional , intent(out) :: rc - - ! local variables - type(ESMF_Field) :: lfield - character(len=*),parameter :: subname='(ice_import_export:State_GetFldPtr_3d)' - ! ---------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end subroutine State_GetFldPtr_4d + end subroutine State_GetFldPtr_2d end module ice_import_export diff --git a/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 index b02865320..b9dfda5c7 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 @@ -1,14 +1,17 @@ module ice_mesh_mod use ESMF - use ice_kinds_mod , only : dbl_kind, int_kind + use NUOPC , only : NUOPC_CompAttributeGet + use ice_kinds_mod , only : dbl_kind, int_kind, char_len, char_len_long use ice_domain_size , only : nx_global, ny_global, max_blocks use ice_domain , only : nblocks, blocks_ice, distrb_info use ice_blocks , only : block, get_block, nx_block, ny_block, nblocks_x, nblocks_y use ice_shr_methods , only : chkerr use ice_fileunits , only : nu_diag use ice_communicate , only : my_task, master_task - use ice_initfc , only : icepack_query_parameters + use ice_exit , only : abort_ice + use icepack_intfc , only : icepack_query_parameters + use icepack_intfc , only : icepack_warnings_flush, icepack_warnings_aborted implicit none private @@ -200,7 +203,7 @@ subroutine ice_mesh_set_distgrid(localpet, npes, distgrid, rc) end subroutine ice_mesh_set_distgrid !======================================================================= - subroutine ice_mesh_setmask_from_maskfile(ice_mesh, ice_maskfile, rc) + subroutine ice_mesh_setmask_from_maskfile(gcomp, ice_mesh, rc) use ice_scam , only : scmlat, scmlon, single_column use ice_grid , only : tlon, tlat, hm, tarea, ULON, ULAT, HTN, HTE, ANGLE, ANGLET @@ -209,18 +212,18 @@ subroutine ice_mesh_setmask_from_maskfile(ice_mesh, ice_maskfile, rc) use ice_grid , only : kmt_file, makemask, tmask use ice_boundary , only : ice_HaloUpdate use ice_domain , only : blocks_ice, nblocks, halo_info, distrb_info - use ice_constants , only : c0, c1, c2, p5, radius + use ice_constants , only : c0, c1, c2, p25, radius use ice_constants , only : field_loc_center, field_type_scalar use ice_read_write , only : ice_open_nc, ice_close_nc - use ice_exit , only : abort_ice use netcdf ! input/output variables - type(ESMF_Mesh) , intent(in) :: ice_mesh - character(len=*) , intent(in) :: ice_maskfile - integer , intent(out) :: rc + type(ESMF_GridComp) , intent(inout) :: gcomp + type(ESMF_Mesh) , intent(in) :: ice_mesh + integer , intent(out) :: rc ! local variables + character(len=char_len_long) :: ice_maskfile integer :: i,j,n integer :: iblk, jblk ! indices integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain @@ -250,13 +253,41 @@ subroutine ice_mesh_setmask_from_maskfile(ice_mesh, ice_maskfile, rc) integer (int_kind), pointer :: ice_mask(:) real(dbl_kind) , pointer :: ice_frac(:) real(dbl_kind) :: pi + real(dbl_kind) :: c180 real(dbl_kind) :: puny real(dbl_kind) :: deg_to_rad + logical :: isPresent, isSet + character(len=char_len_long) :: cvalue character(len=*), parameter :: subname = ' ice_mesh_setmask_from_maskfile' !--------------------------------------------------- rc = ESMF_SUCCESS + ! Determine mask input file and create the mask + call NUOPC_CompAttributeGet(gcomp, name='mesh_mask', value=ice_maskfile, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (my_task == master_task) then + write(nu_diag,*)'mask file for cice domain is ',trim(ice_maskfile) + end if + + ! Determine if single column + call NUOPC_CompAttributeGet(gcomp, name='single_column', value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) single_column + if (single_column) then + call NUOPC_CompAttributeGet(gcomp, name='scmlon', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scmlon + call NUOPC_CompAttributeGet(gcomp, name='scmlat', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scmlat + end if + else + single_column = .false. + end if + ! Determine start/count to read in for either single column or global lat-lon grid ! If single_column, then assume that only master_task is used since there is only one task @@ -288,9 +319,10 @@ subroutine ice_mesh_setmask_from_maskfile(ice_mesh, ice_maskfile, rc) allocate(ocn_gridcell_frac(nx_block,ny_block,max_blocks)) ! Get required constants - call icepack_query_parameters(pi_out=pi, pi2_out=pi2, puny_out=puny, deg_to_rad_out=deg_to_rad) + call icepack_query_parameters(pi_out=pi, puny_out=puny, c180_out=c180) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) + deg_to_rad = pi/c180 ! Set tlon, tlat, tarea, hm and ocn_gridcell_frac ! Convert mesh areas from radians^2 to m^2 (tarea is in m^2) @@ -641,6 +673,7 @@ subroutine ice_mesh_check(ice_mesh, rc) real(dbl_kind) :: diff_lon real(dbl_kind) :: diff_lat real(dbl_kind) :: rad_to_deg + character(len=*), parameter :: subname = ' ice_mesh_check: ' !--------------------------------------------------- ! error check differences between internally generated lons and those read in @@ -680,11 +713,13 @@ subroutine ice_mesh_check(ice_mesh, rc) if ( (diff_lon > 1.e2 .and. abs(diff_lon - 360.) > 1.e-1) .or.& (diff_lon > 1.e-3 .and. diff_lon < c1) ) then write(6,100)n,lonMesh(n),lon(n), diff_lon - !call shr_sys_abort() + call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) end if if (abs(latMesh(n) - lat(n)) > 1.e-1) then write(6,101)n,latMesh(n),lat(n), abs(latMesh(n)-lat(n)) - !call shr_sys_abort() + call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) end if enddo From 0f90ce174461fe9e3e64474faf9ef9465292b0cf Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 1 Feb 2021 09:43:37 -0700 Subject: [PATCH 32/51] more cleanup --- .../drivers/nuopc/cmeps/ice_import_export.F90 | 67 +++++++++++-------- 1 file changed, 38 insertions(+), 29 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index 6e584eb90..82afad28d 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -59,14 +59,14 @@ module ice_import_export private :: state_getfldptr interface state_getimport - module procedure state_getimport_4d_output - module procedure state_getimport_3d_output + module procedure state_getimport_4d + module procedure state_getimport_3d end interface state_getimport private :: state_getimport interface state_setexport - module procedure state_setexport_4d_input - module procedure state_setexport_3d_input + module procedure state_setexport_4d + module procedure state_setexport_3d end interface state_setexport private :: state_setexport @@ -291,6 +291,7 @@ subroutine ice_realize_fields(gcomp, mesh, flds_scalar_name, flds_scalar_num, rc real(dbl_kind), allocatable :: mesh_areas(:) real(dbl_kind), allocatable :: model_areas(:) real(dbl_kind), pointer :: dataptr(:) + integer :: num_ice character(len=*), parameter :: subname='(ice_import_export:realize_fields)' !--------------------------------------------------------------------------- @@ -355,9 +356,10 @@ subroutine ice_realize_fields(gcomp, mesh, flds_scalar_name, flds_scalar_num, rc enddo enddo enddo + num_ice = n ! Determine flux correction factors (module variables) - do n = 1,numOwnedElements + do n = 1,num_ice if (model_areas(n) == mesh_areas(n)) then mod2med_areacor(n) = c1 med2mod_areacor(n) = c1 @@ -1400,7 +1402,7 @@ logical function State_FldChk(State, fldname) end function State_FldChk !=============================================================================== - subroutine state_getimport_4d_output(state, fldname, output, index, ungridded_index, areacor, rc) + subroutine state_getimport_4d(state, fldname, output, index, ungridded_index, areacor, rc) ! ---------------------------------------------- ! Map import state field to output array @@ -1421,7 +1423,7 @@ subroutine state_getimport_4d_output(state, fldname, output, index, ungridded_in integer :: i, j, iblk, n, i1, j1 ! incides real(kind=dbl_kind), pointer :: dataPtr1d(:) ! mesh real(kind=dbl_kind), pointer :: dataPtr2d(:,:) ! mesh - character(len=*), parameter :: subname='(ice_import_export:state_getimport_4d_output)' + character(len=*), parameter :: subname='(ice_import_export:state_getimport_4d)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -1458,21 +1460,24 @@ subroutine state_getimport_4d_output(state, fldname, output, index, ungridded_in end do end do if (present(areacor)) then - if (present(ungridded_index)) then - do n = 1,size(dataptr2d,dim=2) - dataPtr2d(:,n) = dataPtr2d(:,n) * areacor(n) - end do - else - do n = 1,size(dataptr1d) - dataPtr1d(n) = dataPtr1d(n) * areacor(n) + n = 0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo; ihi = this_block%ihi + jlo = this_block%jlo; jhi = this_block%jhi + do j = jlo, jhi + do i = ilo, ihi + n = n + 1 + output(i,j,index,iblk) = output(i,j,index,iblk) * areacor(n) + end do end do - end if + end do end if - end subroutine state_getimport_4d_output + end subroutine state_getimport_4d !=============================================================================== - subroutine state_getimport_3d_output(state, fldname, output, ungridded_index, areacor, rc) + subroutine state_getimport_3d(state, fldname, output, ungridded_index, areacor, rc) ! ---------------------------------------------- ! Map import state field to output array @@ -1492,7 +1497,7 @@ subroutine state_getimport_3d_output(state, fldname, output, ungridded_index, ar integer :: i, j, iblk, n, i1, j1 ! incides real(kind=dbl_kind), pointer :: dataPtr1d(:) ! mesh real(kind=dbl_kind), pointer :: dataPtr2d(:,:) ! mesh - character(len=*) , parameter :: subname='(ice_import_export:state_getimport)' + character(len=*) , parameter :: subname='(ice_import_export:state_getimport_3d)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -1543,10 +1548,10 @@ subroutine state_getimport_3d_output(state, fldname, output, ungridded_index, ar end do end if - end subroutine state_getimport_3d_output + end subroutine state_getimport_3d !=============================================================================== - subroutine state_setexport_4d_input(state, fldname, input, index, lmask, ifrac, ungridded_index, areacor, rc) + subroutine state_setexport_4d(state, fldname, input, index, lmask, ifrac, ungridded_index, areacor, rc) ! ---------------------------------------------- ! Map 4d input array to export state field @@ -1569,7 +1574,8 @@ subroutine state_setexport_4d_input(state, fldname, input, index, lmask, ifrac, integer :: i, j, iblk, n, i1, j1 ! indices real(kind=dbl_kind), pointer :: dataPtr1d(:) ! mesh real(kind=dbl_kind), pointer :: dataPtr2d(:,:) ! mesh - character(len=*), parameter :: subname='(ice_import_export:state_setexport)' + integer :: num_ice + character(len=*), parameter :: subname='(ice_import_export:state_setexport_4d)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -1616,21 +1622,22 @@ subroutine state_setexport_4d_input(state, fldname, input, index, lmask, ifrac, end do end do if (present(areacor)) then + num_ice = n if (present(ungridded_index)) then - do n = 1,size(dataptr2d,dim=2) + do n = 1,num_ice dataPtr2d(:,n) = dataPtr2d(:,n) * areacor(n) end do else - do n = 1,size(dataptr1d) + do n = 1,num_ice dataPtr1d(n) = dataPtr1d(n) * areacor(n) end do end if end if - end subroutine state_setexport_4d_input + end subroutine state_setexport_4d !=============================================================================== - subroutine state_setexport_3d_input(state, fldname, input, lmask, ifrac, ungridded_index, areacor, rc) + subroutine state_setexport_3d(state, fldname, input, lmask, ifrac, ungridded_index, areacor, rc) ! ---------------------------------------------- ! Map 3d input array to export state field @@ -1652,7 +1659,8 @@ subroutine state_setexport_3d_input(state, fldname, input, lmask, ifrac, ungridd integer :: i, j, iblk, n, i1, j1 ! incides real(kind=dbl_kind), pointer :: dataPtr1d(:) ! mesh real(kind=dbl_kind), pointer :: dataPtr2d(:,:) ! mesh - character(len=*), parameter :: subname='(ice_import_export:state_setexport)' + integer :: num_ice + character(len=*), parameter :: subname='(ice_import_export:state_setexport_3d)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -1697,19 +1705,20 @@ subroutine state_setexport_3d_input(state, fldname, input, lmask, ifrac, ungridd end do end do end do + num_ice = n if (present(areacor)) then if (present(ungridded_index)) then - do n = 1,size(dataptr2d,dim=2) + do n = 1,num_ice dataPtr2d(:,n) = dataPtr2d(:,n) * areacor(n) end do else - do n = 1,size(dataptr1d) + do n = 1,num_ice dataPtr1d(n) = dataPtr1d(n) * areacor(n) end do end if end if - end subroutine state_setexport_3d_input + end subroutine state_setexport_3d !=============================================================================== subroutine State_GetFldPtr_1d(State, fldname, fldptr, rc) From d78c3a319c424d527c53994586e05c8af2addfab Mon Sep 17 00:00:00 2001 From: David Bailey Date: Mon, 22 Mar 2021 09:52:14 -0600 Subject: [PATCH 33/51] Fix dragio --- cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index b70e3417b..c192ac9ef 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -374,7 +374,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) Tocnfrz_in = -34.0_dbl_kind*0.054_dbl_kind, & pi_in = SHR_CONST_PI, & snowpatch_in = 0.005_dbl_kind, & - dragio_in = 0.00962_dbl_kind) + dragio_in = 0.00536_dbl_kind) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & From 68132e7384215983019ebfaf6591e3ba5bf248c0 Mon Sep 17 00:00:00 2001 From: David Bailey Date: Mon, 22 Mar 2021 15:52:56 -0600 Subject: [PATCH 34/51] Fix mushy bug --- icepack | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/icepack b/icepack index 4c42a82e3..ddec41ec6 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 4c42a82e3d92f191a9c52bca3831e8d242e2e4c0 +Subproject commit ddec41ec6e1cbafeb2dad5ea87dc19fac2661f7e From ff3783a2db1c598ae86d287df3d3e094b221a1a0 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 24 Mar 2021 10:17:02 -0600 Subject: [PATCH 35/51] updates to nuopc cap to resolve inconsistency between driver inputs and cice namelists --- .../drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 68 ++++++++++++++++++- .../drivers/nuopc/cmeps/ice_import_export.F90 | 61 ++++++++++------- 2 files changed, 101 insertions(+), 28 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index 901928483..0135b13c4 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -15,7 +15,7 @@ module ice_comp_nuopc use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock use NUOPC_Model , only : model_label_Finalize => label_Finalize use NUOPC_Model , only : NUOPC_ModelGet, SetVM - use ice_constants , only : ice_init_constants + use ice_constants , only : ice_init_constants, c0 use ice_shr_methods , only : chkerr, state_setscalar, state_getscalar, state_diagnose, alarmInit use ice_shr_methods , only : set_component_logging, get_component_instance, state_flddebug use ice_import_export , only : ice_import, ice_export, ice_advertise_fields, ice_realize_fields @@ -179,7 +179,12 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) logical :: isPresent, isSet real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp type(ESMF_DistGrid) :: ice_distGrid - character(len=char_len) :: tfrz_option + real(kind=dbl_kind) :: atmiter_conv + real(kind=dbl_kind) :: atmiter_conv_driver + integer (kind=int_kind) :: natmiter + integer (kind=int_kind) :: natmiter_driver + character(len=char_len) :: tfrz_option_driver ! tfrz_option from driver attributes + character(len=char_len) :: tfrz_option ! tfrz_option from cice namelist integer(int_kind) :: ktherm integer :: localPet integer :: npes @@ -317,6 +322,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ice_init_constants(omega_in=SHR_CONST_OMEGA, radius_in=SHR_CONST_REARTH, & spval_dbl_in=SHR_CONST_SPVAL) + ! TODO: get tfrz_option from driver + call icepack_init_parameters( & secday_in = SHR_CONST_CDAY, & rhoi_in = SHR_CONST_RHOICE, & @@ -470,10 +477,65 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! First cice initialization phase - before initializing grid info !---------------------------------------------------------------------------- + ! Read the cice namelist as part of the call to cice_init1 call t_startf ('cice_init1') call cice_init1 call t_stopf ('cice_init1') + ! Form of ocean freezing temperature + ! 'minus1p8' = -1.8 C + ! 'linear_salt' = -depressT * sss + ! 'mushy' conforms with ktherm=2 + call NUOPC_CompAttributeGet(gcomp, name="tfreeze_option", value=tfrz_option_driver, & + isPresent=isPresent, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (.not. isPresent) then + tfrz_option_driver = 'linear_salt' + end if + call icepack_query_parameters( tfrz_option_out=tfrz_option) + if (tfrz_option_driver /= tfrz_option) then + if (master_task) then + write(nu_diag,*) trim(subname)//'error: tfrz_option from driver '//trim(tfrz_option_driver)//& + ' must be the same as tfrz_option from cice namelist '//trim(tfrz_option) + end if + call abort_ice(trim(subname)) + endif + + ! Flux convergence tolerance + call NUOPC_CompAttributeGet(gcomp, name="flux_convergence", value=cvalue, & + isPresent=isPresent, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + read(cvalue,*) atmiter_conv_driver + else + atmiter_conv_driver = c0 + end if + call icepack_query_parameters( atmiter_conv_out=atmiter_conv) + if (atmiter_conv_driver /= atmiter_conv) then + if (master_task) then + write(nu_diag,'(a,d13.5,a,d13.5)') trim(subname)//'error: atmiter_ from driver ',& + atmiter_conv_driver,' must be the same as atmiter_conv from cice namelist ',atmiter_conv + end if + call abort_ice(trim(subname)) + endif + + ! Number of iterations for boundary layer calculations + call NUOPC_CompAttributeGet(gcomp, name="flux_max_iteration", value=cvalue, isPresent=isPresent, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + read(cvalue,*) natmiter_driver + else + natmiter_driver = 5 + end if + call icepack_query_parameters( natmiter_out=natmiter) + if (natmiter_driver /= natmiter) then + if (master_task) then + write(nu_diag,'(a,i8,a,i8)') trim(subname)//'error: natmiter_driver ',natmiter_driver, & + ' must be the same as natmiter from cice namelist ',natmiter + end if + call abort_ice(trim(subname)) + endif + !---------------------------------------------------------------------------- ! Initialize grid info !---------------------------------------------------------------------------- @@ -510,6 +572,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Note that cice_init2 also sets time manager info as well as mpi communicator info, ! including master_task and my_task + ! Note that cice_init2 calls ice_init() which in turn calls icepack_init_parameters + ! which sets the tfrz_option call t_startf ('cice_init2') call cice_init2() call t_stopf ('cice_init2') diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index 82afad28d..4bebbe421 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -38,6 +38,7 @@ module ice_import_export use cice_wrapper_mod , only : t_startf, t_stopf, t_barrierf #ifdef CESMCOUPLED use shr_frz_mod , only : shr_frz_freezetemp + use shr_mpi_mod , only : shr_mpi_min, shr_mpi_max #endif implicit none @@ -291,7 +292,14 @@ subroutine ice_realize_fields(gcomp, mesh, flds_scalar_name, flds_scalar_num, rc real(dbl_kind), allocatable :: mesh_areas(:) real(dbl_kind), allocatable :: model_areas(:) real(dbl_kind), pointer :: dataptr(:) - integer :: num_ice + real(dbl_kind) :: max_mod2med_areacor + real(dbl_kind) :: max_med2mod_areacor + real(dbl_kind) :: min_mod2med_areacor + real(dbl_kind) :: min_med2mod_areacor + real(dbl_kind) :: max_mod2med_areacor_glob + real(dbl_kind) :: max_med2mod_areacor_glob + real(dbl_kind) :: min_mod2med_areacor_glob + real(dbl_kind) :: min_med2mod_areacor_glob character(len=*), parameter :: subname='(ice_import_export:realize_fields)' !--------------------------------------------------------------------------- @@ -320,17 +328,12 @@ subroutine ice_realize_fields(gcomp, mesh, flds_scalar_name, flds_scalar_num, rc mesh=mesh, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Determine areas for regridding - call ESMF_MeshGet(mesh, numOwnedElements=numOwnedElements, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate (mod2med_areacor(numOwnedElements)) - allocate (med2mod_areacor(numOwnedElements)) - mod2med_areacor(:) = c1 - med2mod_areacor(:) = c1 - #ifdef CESMCOUPLED ! Get mesh areas from second field - using second field since the ! first field is the scalar field + + call ESMF_MeshGet(mesh, numOwnedElements=numOwnedElements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_StateGet(exportState, itemName=trim(fldsFrIce(2)%stdname), field=lfield, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldRegridGetArea(lfield, rc=rc) @@ -340,8 +343,12 @@ subroutine ice_realize_fields(gcomp, mesh, flds_scalar_name, flds_scalar_num, rc allocate(mesh_areas(numOwnedElements)) mesh_areas(:) = dataptr(:) - ! Determine model areas + ! Determine flux correction factors (module variables) allocate(model_areas(numOwnedElements)) + allocate(mod2med_areacor(numOwnedElements)) + allocate(med2mod_areacor(numOwnedElements)) + mod2med_areacor(:) = 1._dbl_kind + med2mod_areacor(:) = 1._dbl_kind n = 0 do iblk = 1, nblocks this_block = get_block(blocks_ice(iblk),iblk) @@ -353,27 +360,29 @@ subroutine ice_realize_fields(gcomp, mesh, flds_scalar_name, flds_scalar_num, rc do i = ilo, ihi n = n+1 model_areas(n) = tarea(i,j,iblk)/(radius*radius) + mod2med_areacor(n) = model_areas(n) / mesh_areas(n) + med2mod_areacor(n) = mesh_areas(n) / model_areas(n) enddo enddo enddo - num_ice = n - - ! Determine flux correction factors (module variables) - do n = 1,num_ice - if (model_areas(n) == mesh_areas(n)) then - mod2med_areacor(n) = c1 - med2mod_areacor(n) = c1 - else - mod2med_areacor(n) = model_areas(n) / mesh_areas(n) - med2mod_areacor(n) = mesh_areas(n) / model_areas(n) - if (abs(mod2med_areacor(n) - 1._dbl_kind) > 1.e-13) then - write(6,'(a,i8,2x,d21.14,2x)')' AREACOR cice6: n, abs(mod2med_areacor(n)-1)', & - n, abs(mod2med_areacor(n) - 1._dbl_kind) - end if - end if - end do deallocate(model_areas) deallocate(mesh_areas) + + min_mod2med_areacor = minval(mod2med_areacor) + max_mod2med_areacor = maxval(mod2med_areacor) + min_med2mod_areacor = minval(med2mod_areacor) + max_med2mod_areacor = maxval(med2mod_areacor) + call shr_mpi_max(max_mod2med_areacor, max_mod2med_areacor_glob, mpi_comm_ice) + call shr_mpi_min(min_mod2med_areacor, min_mod2med_areacor_glob, mpi_comm_ice) + call shr_mpi_max(max_med2mod_areacor, max_med2mod_areacor_glob, mpi_comm_ice) + call shr_mpi_min(min_med2mod_areacor, min_med2mod_areacor_glob, mpi_comm_ice) + + if (my_task == master_task) then + write(nu_diag,'(2A,2g23.15,A )') trim(subname),' : min_mod2med_areacor, max_mod2med_areacor ',& + min_mod2med_areacor_glob, max_mod2med_areacor_glob, 'CICE6' + write(nu_diag,'(2A,2g23.15,A )') trim(subname),' : min_med2mod_areacor, max_med2mod_areacor ',& + min_med2mod_areacor_glob, max_med2mod_areacor_glob, 'CICE6' + end if #endif end subroutine ice_realize_fields From 718a75dee214c05a3f1518d0bfa48fd69b9e0189 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 24 Mar 2021 15:33:03 -0600 Subject: [PATCH 36/51] changed error message --- .../drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 21 +++++++------------ 1 file changed, 8 insertions(+), 13 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index 0135b13c4..540c4c68f 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -176,6 +176,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Local variables character(len=char_len_long) :: cvalue character(len=char_len_long) :: ice_meshfile + character(len=char_len_long) :: errmsg logical :: isPresent, isSet real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp type(ESMF_DistGrid) :: ice_distGrid @@ -494,11 +495,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) end if call icepack_query_parameters( tfrz_option_out=tfrz_option) if (tfrz_option_driver /= tfrz_option) then - if (master_task) then - write(nu_diag,*) trim(subname)//'error: tfrz_option from driver '//trim(tfrz_option_driver)//& + write(errmsg,'(a)') trim(subname)//'error: tfrz_option from driver '//trim(tfrz_option_driver)//& ' must be the same as tfrz_option from cice namelist '//trim(tfrz_option) - end if - call abort_ice(trim(subname)) + call abort_ice(trim(errmsg)) endif ! Flux convergence tolerance @@ -512,11 +511,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) end if call icepack_query_parameters( atmiter_conv_out=atmiter_conv) if (atmiter_conv_driver /= atmiter_conv) then - if (master_task) then - write(nu_diag,'(a,d13.5,a,d13.5)') trim(subname)//'error: atmiter_ from driver ',& - atmiter_conv_driver,' must be the same as atmiter_conv from cice namelist ',atmiter_conv - end if - call abort_ice(trim(subname)) + write(errmsg,'(a,d13.5,a,d13.5)') trim(subname)//'error: atmiter_ from driver ',& + atmiter_conv_driver,' must be the same as atmiter_conv from cice namelist ',atmiter_conv + call abort_ice(trim(errmsg)) endif ! Number of iterations for boundary layer calculations @@ -529,11 +526,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) end if call icepack_query_parameters( natmiter_out=natmiter) if (natmiter_driver /= natmiter) then - if (master_task) then - write(nu_diag,'(a,i8,a,i8)') trim(subname)//'error: natmiter_driver ',natmiter_driver, & + write(errmsg,'(a,i8,a,i8)') trim(subname)//'error: natmiter_driver ',natmiter_driver, & ' must be the same as natmiter from cice namelist ',natmiter - end if - call abort_ice(trim(subname)) + call abort_ice(trim(errmsg)) endif !---------------------------------------------------------------------------- From 3ee6fe2b004ebf3577ee41e04100c90ec159d185 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 24 Mar 2021 16:57:41 -0600 Subject: [PATCH 37/51] added icepack_warnings_flush --- cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index 540c4c68f..029641cd8 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -501,6 +501,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) endif ! Flux convergence tolerance + ! TODO: these need to be consistent - but for now use namelist value call NUOPC_CompAttributeGet(gcomp, name="flux_convergence", value=cvalue, & isPresent=isPresent, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -513,7 +514,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (atmiter_conv_driver /= atmiter_conv) then write(errmsg,'(a,d13.5,a,d13.5)') trim(subname)//'error: atmiter_ from driver ',& atmiter_conv_driver,' must be the same as atmiter_conv from cice namelist ',atmiter_conv - call abort_ice(trim(errmsg)) + write(nu_diag,*) trim(errmsg) + call icepack_warnings_flush(nu_diag) + !call abort_ice(trim(errmsg)) endif ! Number of iterations for boundary layer calculations From 3bdc07b4f43c80a04e3061adfd5c5d97df862eb5 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 26 Apr 2021 10:32:43 -0600 Subject: [PATCH 38/51] updates to get ice categories working --- cicecore/cicedynB/general/ice_flux.F90 | 6 +- .../drivers/nuopc/cmeps/ice_import_export.F90 | 101 +++++++++++------- 2 files changed, 65 insertions(+), 42 deletions(-) diff --git a/cicecore/cicedynB/general/ice_flux.F90 b/cicecore/cicedynB/general/ice_flux.F90 index 97b726fdb..a357156de 100644 --- a/cicecore/cicedynB/general/ice_flux.F90 +++ b/cicecore/cicedynB/general/ice_flux.F90 @@ -718,10 +718,8 @@ subroutine init_coupler_flux ffep (:,:,:,:)= c0 ffed (:,:,:,:)= c0 - if (send_i2x_per_cat) then - allocate(fswthrun_ai(nx_block,ny_block,ncat,max_blocks)) - fswthrun_ai(:,:,:,:) = c0 - endif + allocate(fswthrun_ai(nx_block,ny_block,ncat,max_blocks)) + fswthrun_ai(:,:,:,:) = c0 !----------------------------------------------------------------- ! derived or computed fields diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index 4bebbe421..7d8c428f6 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -129,6 +129,9 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam if (my_task == master_task) then write(nu_diag,*)'send_i2x_per_cat = ',send_i2x_per_cat end if + if (.not.send_i2x_per_cat) then + deallocate(fswthrun_ai) + end if ! Determine if the following attributes are sent by the driver and if so read them in flds_wiso = .false. @@ -850,8 +853,10 @@ subroutine ice_export( exportState, rc ) real (kind=dbl_kind) :: tauxo (nx_block,ny_block,max_blocks) ! ice/ocean stress real (kind=dbl_kind) :: tauyo (nx_block,ny_block,max_blocks) ! ice/ocean stress real (kind=dbl_kind) :: ailohi(nx_block,ny_block,max_blocks) ! fractional ice area - real (kind=dbl_kind), allocatable :: tempfld(:,:,:) real (kind=dbl_kind) :: Tffresh + real (kind=dbl_kind), allocatable :: tempfld(:,:,:) + real (kind=dbl_kind), pointer :: dataptr_ifrac_n(:,:) + real (kind=dbl_kind), pointer :: dataptr_swpen_n(:,:) character(len=*),parameter :: subname = 'ice_export' !----------------------------------------------------- @@ -1583,7 +1588,7 @@ subroutine state_setexport_4d(state, fldname, input, index, lmask, ifrac, ungrid integer :: i, j, iblk, n, i1, j1 ! indices real(kind=dbl_kind), pointer :: dataPtr1d(:) ! mesh real(kind=dbl_kind), pointer :: dataPtr2d(:,:) ! mesh - integer :: num_ice + integer :: ice_num character(len=*), parameter :: subname='(ice_import_export:state_setexport_4d)' ! ---------------------------------------------- @@ -1596,48 +1601,68 @@ subroutine state_setexport_4d(state, fldname, input, index, lmask, ifrac, ungrid if (present(ungridded_index)) then call state_getfldptr(state, trim(fldname), dataPtr2d, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call state_getfldptr(state, trim(fldname), dataPtr1d, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - ! set values of field pointer - n = 0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - do j = jlo, jhi - do i = ilo, ihi - n = n+1 - if (present(lmask) .and. present(ifrac)) then - if ( lmask(i,j,iblk) .and. ifrac(i,j,iblk) > c0 ) then - if (present(ungridded_index)) then + if (ungridded_index == 1) then + dataptr2d(:,:) = c0 + end if + n = 0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo; ihi = this_block%ihi + jlo = this_block%jlo; jhi = this_block%jhi + if (present(lmask) .and. present(ifrac)) then + do j = jlo, jhi + do i = ilo, ihi + n = n+1 + if ( lmask(i,j,iblk) .and. ifrac(i,j,iblk) > c0 ) then dataPtr2d(ungridded_index,n) = input(i,j,index,iblk) else - dataPtr1d(n) = input(i,j,index,iblk) + dataPtr2d(ungridded_index,n) = c0 end if - end if - else - if (present(ungridded_index)) then + end do + end do + else + do j = jlo, jhi + do i = ilo, ihi + n = n+1 dataPtr2d(ungridded_index,n) = input(i,j,index,iblk) - else - dataPtr1d(n) = input(i,j,index,iblk) - end if - end if - end do + end do + end do + end if end do - end do - if (present(areacor)) then - num_ice = n - if (present(ungridded_index)) then - do n = 1,num_ice - dataPtr2d(:,n) = dataPtr2d(:,n) * areacor(n) + ice_num = n + if (present(areacor)) then + do n = 1,ice_num + dataPtr2d(ungridded_index,n) = dataPtr2d(ungridded_index,n) * areacor(n) end do - else - do n = 1,num_ice + end if + else + call state_getfldptr(state, trim(fldname), dataPtr1d, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + dataptr1d(:) = c0 + n = 0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo; ihi = this_block%ihi + jlo = this_block%jlo; jhi = this_block%jhi + if (present(lmask) .and. present(ifrac)) then + do j = jlo, jhi + do i = ilo, ihi + n = n+1 + if ( lmask(i,j,iblk) .and. ifrac(i,j,iblk) > c0 ) then + dataPtr1d(n) = input(i,j,index,iblk) + end if + end do + end do + else + do i = ilo, ihi + n = n+1 + dataPtr1d(n) = input(i,j,index,iblk) + end do + end if + end do + ice_num = n + if (present(areacor)) then + do n = 1,ice_num dataPtr1d(n) = dataPtr1d(n) * areacor(n) end do end if From 508e9b9bfdbc27807e460238c522cb7cee045183 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 4 May 2021 13:51:37 -0600 Subject: [PATCH 39/51] updates to have F compset almost working with cice6 - still problems in polar regions - need to resolve 253K/cice6 versus 273K/cice5 differences --- .../drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 178 ++++- .../drivers/nuopc/cmeps/ice_import_export.F90 | 17 +- cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 | 607 ++++++++---------- .../nuopc/cmeps/ice_prescribed_mod.F90 | 5 +- cicecore/drivers/nuopc/cmeps/ice_scam.F90 | 12 +- 5 files changed, 434 insertions(+), 385 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index 029641cd8..c5901ffd1 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -26,6 +26,7 @@ module ice_comp_nuopc use ice_calendar , only : idate, mday, time, month, daycal, time2sec, year_init use ice_calendar , only : sec, dt, calendar, calendar_type, nextsw_cday, istep use ice_kinds_mod , only : dbl_kind, int_kind, char_len, char_len_long + use ice_scam , only : scmlat, scmlon, scol_mask, scol_frac, scol_ni, scol_nj, scol_valid, single_column use ice_fileunits , only : nu_diag, nu_diag_set, inst_index, inst_name use ice_fileunits , only : inst_suffix, release_all_fileunits, flush_fileunit use ice_restart_shared , only : runid, runtype, restart, use_restart_time, restart_dir, restart_file @@ -44,6 +45,7 @@ module ice_comp_nuopc use CICE_InitMod , only : cice_init1, cice_init2 use CICE_RunMod , only : cice_run use ice_mesh_mod , only : ice_mesh_set_distgrid, ice_mesh_setmask_from_maskfile, ice_mesh_check + use ice_mesh_mod , only : ice_mesh_init_tlon_tlat_area_hm, ice_mesh_create_scolumn use ice_prescribed_mod , only : ice_prescribed_init implicit none @@ -82,6 +84,8 @@ module ice_comp_nuopc type(ESMF_Mesh) :: ice_mesh + integer :: nthrds ! Number of threads to use in this component + integer :: dbug = 0 integer , parameter :: debug_import = 0 ! internal debug level integer , parameter :: debug_export = 0 ! internal debug level @@ -176,6 +180,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Local variables character(len=char_len_long) :: cvalue character(len=char_len_long) :: ice_meshfile + character(len=char_len_long) :: ice_maskfile character(len=char_len_long) :: errmsg logical :: isPresent, isSet real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp @@ -184,7 +189,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) real(kind=dbl_kind) :: atmiter_conv_driver integer (kind=int_kind) :: natmiter integer (kind=int_kind) :: natmiter_driver - character(len=char_len) :: tfrz_option_driver ! tfrz_option from driver attributes + character(len=char_len) :: tfrz_option_driver ! tfrz_option from driver attributes character(len=char_len) :: tfrz_option ! tfrz_option from cice namelist integer(int_kind) :: ktherm integer :: localPet @@ -288,10 +293,20 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, mpiCommunicator=lmpicom, localPet=localPet, PetCount=npes, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return +#ifdef CESMCOUPLED + call ESMF_VMGet(vm, pet=localPet, peCount=nthrds, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (nthrds==1) then + call NUOPC_CompAttributeGet(gcomp, "nthreads", value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + read(cvalue,*) nthrds + endif +!$ call omp_set_num_threads(nthrds) +#endif + !---------------------------------------------------------------------------- ! Initialize cice communicators !---------------------------------------------------------------------------- @@ -538,30 +553,51 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Initialize grid info !---------------------------------------------------------------------------- - ! Determine the model distgrid using the decomposition obtained in - ! call to init_grid1 called from cice_init1 - call ice_mesh_set_distgrid(localpet, npes, ice_distgrid, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Initialize cice mesh and mask if appropriate - ! Read in the ice mesh on the cice distribution - call NUOPC_CompAttributeGet(gcomp, name='mesh_ice', value=ice_meshfile, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (my_task == master_task) then - write(nu_diag,*)'mesh file for cice domain is ',trim(ice_meshfile) - end if - ice_mesh = ESMF_MeshCreate(filename=trim(ice_meshfile), & - fileformat=ESMF_FILEFORMAT_ESMFMESH, elementDistGrid=ice_distgrid, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (single_column .and. scol_valid) then + call ice_mesh_init_tlon_tlat_area_hm() + else + ! Determine mesh input file + call NUOPC_CompAttributeGet(gcomp, name='mesh_ice', value=ice_meshfile, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Initialize the cice mesh and the cice mask - if (trim(grid_type) == 'setmask') then - call ice_mesh_setmask_from_maskfile(gcomp, ice_mesh, rc=rc) + ! Determine mask input file + call NUOPC_CompAttributeGet(gcomp, name='mesh_mask', value=cvalue, isPresent=isPresent, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - ! In this case init_grid2 will initialize tlon, tlat, area and hm - call init_grid2() - call ice_mesh_check(ice_mesh, rc=rc) + if (isPresent .and. isSet) then + ice_maskfile = trim(cvalue) + else + ice_maskfile = ice_meshfile + end if + if (my_task == master_task) then + write(nu_diag,*)'mesh file for cice domain is ',trim(ice_meshfile) + write(nu_diag,*)'mask file for cice domain is ',trim(ice_maskfile) + end if + + ! Determine the model distgrid using the decomposition obtained in + ! call to init_grid1 called from cice_init1 + call ice_mesh_set_distgrid(localpet, npes, ice_distgrid, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Read in the ice mesh on the cice distribution + ice_mesh = ESMF_MeshCreate(filename=trim(ice_meshfile), fileformat=ESMF_FILEFORMAT_ESMFMESH, & + elementDistGrid=ice_distgrid, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Initialize the cice mesh and the cice mask + if (trim(grid_type) == 'setmask') then + ! In this case cap code determines the mask file + call ice_mesh_setmask_from_maskfile(ice_maskfile, ice_mesh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ice_mesh_init_tlon_tlat_area_hm() + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + ! In this case init_grid2 will initialize tlon, tlat, area and hm + call init_grid2() + call ice_mesh_check(ice_mesh, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if end if !---------------------------------------------------------------------------- @@ -571,7 +607,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Note that cice_init2 also sets time manager info as well as mpi communicator info, ! including master_task and my_task ! Note that cice_init2 calls ice_init() which in turn calls icepack_init_parameters - ! which sets the tfrz_option + ! which sets the tfrz_option call t_startf ('cice_init2') call cice_init2() call t_stopf ('cice_init2') @@ -695,12 +731,106 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer, intent(out) :: rc ! Local variables - character(len=*), parameter :: subname=trim(modName)//':(InitializeRealize) ' + integer :: n + integer :: fieldcount + type(ESMF_Field) :: lfield + character(len=char_len_long) :: cvalue + real(dbl_kind) :: scol_lon + real(dbl_kind) :: scol_lat + real(dbl_kind) :: scol_spval + real(dbl_kind), pointer :: fldptr1d(:) + real(dbl_kind), pointer :: fldptr2d(:,:) + integer :: rank + character(len=char_len_long) :: single_column_lnd_domainfile + character(len=char_len_long) , pointer :: lfieldnamelist(:) => null() + character(len=*), parameter :: subname=trim(modName)//':(InitializeRealize) ' !-------------------------------- rc = ESMF_SUCCESS if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) +#ifdef CESMCOUPLED + call NUOPC_CompAttributeGet(gcomp, name='scol_lon', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scmlon + call NUOPC_CompAttributeGet(gcomp, name='scol_lat', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scmlat + call NUOPC_CompAttributeGet(gcomp, name='scol_spval', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scol_spval + + if (scmlon > scol_spval .and. scmlat > scol_spval) then + call NUOPC_CompAttributeGet(gcomp, name='single_column_lnd_domainfile', & + value=single_column_lnd_domainfile, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(single_column_lnd_domainfile) /= 'UNSET') then + single_column = .true. + else + call abort_ice('single_column_domainfile cannot be null for single column mode') + end if + call NUOPC_CompAttributeGet(gcomp, name='scol_ocnmask', value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scol_mask + call NUOPC_CompAttributeGet(gcomp, name='scol_ocnfrac', value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scol_frac + call NUOPC_CompAttributeGet(gcomp, name='scol_ni', value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scol_ni + call NUOPC_CompAttributeGet(gcomp, name='scol_nj', value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scol_nj + + call ice_mesh_create_scolumn(scmlon, scmlat, ice_mesh, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + scol_valid = (scol_mask == 1) + if (.not. scol_valid) then + ! if single column is not valid - set all export state fields to zero and return + write(nu_diag,'(a)')' (ice_comp_nuopc) single column mode point does not contain any ocn/ice '& + //' - setting all export data to 0' + call ice_realize_fields(gcomp, mesh=ice_mesh, & + flds_scalar_name=flds_scalar_name, flds_scalar_num=flds_scalar_num, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + call ESMF_StateGet(exportState, itemNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1, fieldCount + if (trim(lfieldnamelist(n)) /= flds_scalar_name) then + call ESMF_StateGet(exportState, itemName=trim(lfieldnamelist(n)), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, rank=rank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (rank == 2) then + call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr2d(:,:) = 0._dbl_kind + else + call ESMF_FieldGet(lfield, farrayPtr=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._dbl_kind + end if + end if + enddo + deallocate(lfieldnamelist) + ! ******************* + ! *** RETURN HERE *** + ! ******************* + RETURN + else + write(nu_diag,'(a,3(f10.5,2x))')' (ice_comp_nuopc) single column mode lon/lat/frac is ',& + scmlon,scmlat,scol_frac + end if + else + single_column = .false. + end if +#else + single_column = .false. +#endif + !----------------------------------------------------------------- ! Realize the actively coupled fields !----------------------------------------------------------------- diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index 7d8c428f6..62ff2727d 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -24,8 +24,9 @@ module ice_import_export use ice_flux , only : send_i2x_per_cat use ice_flux , only : sss, Tf, wind, fsw use ice_state , only : vice, vsno, aice, aicen_init, trcr - use ice_grid , only : tlon, tlat, tarea, tmask, anglet, hm, ocn_gridcell_frac + use ice_grid , only : tlon, tlat, tarea, tmask, anglet, hm use ice_grid , only : grid_type, t2ugrid_vector + use ice_mesh_mod , only : ocn_gridcell_frac use ice_boundary , only : ice_HaloUpdate use ice_fileunits , only : nu_diag, flush_fileunit use ice_communicate , only : my_task, master_task, MPI_COMM_ICE @@ -423,9 +424,9 @@ subroutine ice_import( importState, rc ) call icepack_query_parameters(ktherm_out=ktherm) if (io_dbug > 5) then - write(msgString,'(A,i8)')trim(subname)//' tfrz_option = ' & - // trim(tfrz_option)//', ktherm = ',ktherm - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + write(msgString,'(A,i8)')trim(subname)//' tfrz_option = ' & + // trim(tfrz_option)//', ktherm = ',ktherm + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) end if ! call icepack_query_parameters(tfrz_option_out=tfrz_option, & @@ -774,9 +775,11 @@ subroutine ice_import( importState, rc ) #ifdef CESMCOUPLED ! Use shr_frz_mod for this - Tf(:,:,iblk) = shr_frz_freezetemp(sss(:,:,iblk)) + do iblk = 1, nblocks + Tf(:,:,iblk) = shr_frz_freezetemp(sss(:,:,iblk)) + end do #else - !$OMP PARALLEL DO PRIVATE(iblk,i,j,workx,worky) + !$OMP PARALLEL DO PRIVATE(iblk,i,j) do iblk = 1, nblocks do j = 1,ny_block do i = 1,nx_block @@ -966,7 +969,7 @@ subroutine ice_export( exportState, rc ) call state_setexport(exportState, 'ice_fraction', input=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (trim(grid_type) == 'latlon') then + if (trim(grid_type) == 'setmask') then call state_setexport(exportState, 'ice_mask', input=ocn_gridcell_frac, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else diff --git a/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 index b9dfda5c7..37b2d8d1f 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 @@ -12,15 +12,16 @@ module ice_mesh_mod use ice_exit , only : abort_ice use icepack_intfc , only : icepack_query_parameters use icepack_intfc , only : icepack_warnings_flush, icepack_warnings_aborted + implicit none private public :: ice_mesh_set_distgrid public :: ice_mesh_setmask_from_maskfile + public :: ice_mesh_create_scolumn + public :: ice_mesh_init_tlon_tlat_area_hm public :: ice_mesh_check - private :: ice_mesh_create_mask - ! Only relevant for lat-lon grids gridcell value of [1 - (land fraction)] (T-cell) real (dbl_kind), allocatable, public :: ocn_gridcell_frac(:,:,:) @@ -203,262 +204,279 @@ subroutine ice_mesh_set_distgrid(localpet, npes, distgrid, rc) end subroutine ice_mesh_set_distgrid !======================================================================= - subroutine ice_mesh_setmask_from_maskfile(gcomp, ice_mesh, rc) - - use ice_scam , only : scmlat, scmlon, single_column - use ice_grid , only : tlon, tlat, hm, tarea, ULON, ULAT, HTN, HTE, ANGLE, ANGLET - use ice_grid , only : uarea, uarear, tarear, tinyarea - use ice_grid , only : dxt, dyt, dxu, dyu, dyhx, dxhy, cyp, cxp, cym, cxm - use ice_grid , only : kmt_file, makemask, tmask - use ice_boundary , only : ice_HaloUpdate - use ice_domain , only : blocks_ice, nblocks, halo_info, distrb_info - use ice_constants , only : c0, c1, c2, p25, radius - use ice_constants , only : field_loc_center, field_type_scalar - use ice_read_write , only : ice_open_nc, ice_close_nc - use netcdf + subroutine ice_mesh_setmask_from_maskfile(ice_maskfile, ice_mesh, rc) + + use ice_grid , only : tlon, tlat, hm, tarea + use ice_constants , only : c0, c1, c2, p25, radius ! input/output variables - type(ESMF_GridComp) , intent(inout) :: gcomp - type(ESMF_Mesh) , intent(in) :: ice_mesh - integer , intent(out) :: rc + character(len=*) , intent(in) :: ice_maskfile + type(ESMF_Mesh) , intent(inout) :: ice_mesh + integer , intent(out) :: rc ! local variables - character(len=char_len_long) :: ice_maskfile - integer :: i,j,n - integer :: iblk, jblk ! indices - integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain - type(ESMF_Field) :: areaField - real(dbl_kind) , pointer :: mesh_areas(:) - integer :: numownedelements - real(dbl_kind) , pointer :: ownedElemCoords(:) - integer :: spatialDim - integer (int_kind) :: ni, nj, ncid - integer (int_kind) :: dimid, varid, ier - type (block) :: this_block ! block information for current block - real (dbl_kind) :: closelat ! Single-column latitude value - real (dbl_kind) :: closelon ! Single-column longitude value - real (dbl_kind) :: closelatidx ! Single-column latitude index to retrieve - real (dbl_kind) :: closelonidx ! Single-column longitude index to retrieve - integer (int_kind) :: start(2) ! Start index to read in - integer (int_kind) :: count(2) ! Number of points to read in - integer (int_kind) :: start3(3) ! Start index to read in - integer (int_kind) :: count3(3) ! Number of points to read in - integer (int_kind) :: status ! status flag - real (dbl_kind), allocatable :: lats(:) ! temporary - real (dbl_kind), allocatable :: lons(:) ! temporary - real (dbl_kind), allocatable :: pos_lons(:) ! temporary - real (dbl_kind), allocatable :: glob_grid(:,:) ! temporary - real (dbl_kind) :: pos_scmlon ! temporary - real (dbl_kind) :: scamdata ! temporary - integer (int_kind), pointer :: ice_mask(:) - real(dbl_kind) , pointer :: ice_frac(:) - real(dbl_kind) :: pi - real(dbl_kind) :: c180 - real(dbl_kind) :: puny - real(dbl_kind) :: deg_to_rad - logical :: isPresent, isSet - character(len=char_len_long) :: cvalue - character(len=*), parameter :: subname = ' ice_mesh_setmask_from_maskfile' + integer :: i, j, n + integer (int_kind) :: ni, nj + integer :: iblk, jblk ! indices + integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain + type (block) :: this_block ! block information for current block + real(dbl_kind) , pointer :: ice_frac(:) + type(ESMF_Field) :: areaField + type(ESMF_Mesh) :: mesh_mask + type(ESMF_Field) :: field_mask + type(ESMF_Field) :: field_dst + type(ESMF_RouteHandle) :: rhandle + integer :: srcMaskValue = 0 + integer :: dstMaskValue = -987987 ! spval for RH mask values + integer :: srcTermProcessing_Value = 0 + logical :: checkflag = .false. + integer, pointer :: ice_mask(:) + real(dbl_kind) , pointer :: mask_src(:) ! on mesh created from ice_maskfile + real(dbl_kind) , pointer :: dataptr1d(:) + type(ESMF_DistGrid) :: distgrid_mask + type(ESMF_Array) :: elemMaskArray + integer :: lsize_mask, lsize_dst + integer :: spatialDim + real(dbl_kind) :: fminval = 0.001_dbl_kind ! TODO: make this a share constant + real(dbl_kind) :: fmaxval = 1._dbl_kind + real(dbl_kind) :: lfrac + real(dbl_kind) , pointer :: mesh_areas(:) + integer :: numownedelements + real(dbl_kind) , pointer :: ownedElemCoords(:) + real(dbl_kind) :: pi + real(dbl_kind) :: c180 + real(dbl_kind) :: puny + real(dbl_kind) :: deg_to_rad + character(len=*), parameter :: subname = ' ice_mesh_setmask_from_maskfile' !--------------------------------------------------- rc = ESMF_SUCCESS - ! Determine mask input file and create the mask - call NUOPC_CompAttributeGet(gcomp, name='mesh_mask', value=ice_maskfile, rc=rc) + mesh_mask = ESMF_MeshCreate(trim(ice_maskfile), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (my_task == master_task) then - write(nu_diag,*)'mask file for cice domain is ',trim(ice_maskfile) - end if - ! Determine if single column - call NUOPC_CompAttributeGet(gcomp, name='single_column', value=cvalue, & - isPresent=isPresent, isSet=isSet, rc=rc) + call ESMF_MeshGet(ice_mesh, spatialDim=spatialDim, numOwnedElements=lsize_dst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(ice_mask(lsize_dst)) + allocate(ice_frac(lsize_dst)) + + ! create fields on source and destination meshes + field_mask = ESMF_FieldCreate(mesh_mask, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + field_dst = ESMF_FieldCreate(ice_mesh, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create route handle to map source mask (assume ocean) to destination mesh (assume atm/lnd) + call ESMF_FieldRegridStore(field_mask, field_dst, routehandle=rhandle, & + srcMaskValues=(/srcMaskValue/), dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_CONSERVE, normType=ESMF_NORMTYPE_DSTAREA, & + srcTermProcessing=srcTermProcessing_Value, & + ignoreDegenerate=.true., unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! fill in values for field_mask with mask on source mesh + call ESMF_MeshGet(mesh_mask, elementdistGrid=distgrid_mask, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_DistGridGet(distgrid_mask, localDe=0, elementCount=lsize_mask, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(mask_src(lsize_mask)) + elemMaskArray = ESMF_ArrayCreate(distgrid_mask, mask_src, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! The following call fills in the values of mask_src + call ESMF_MeshGet(mesh_mask, elemMaskArray=elemMaskArray, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! The following call fills in the values of field_mask + call ESMF_FieldGet(field_mask, farrayptr=dataptr1d, rc=rc) + dataptr1d(:) = mask_src(:) + + ! map source mask to destination mesh - to obtain destination mask and frac + call ESMF_FieldRegrid(field_mask, field_dst, routehandle=rhandle, & + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MeshGet(ice_mesh, spatialDim=spatialDim, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) single_column - if (single_column) then - call NUOPC_CompAttributeGet(gcomp, name='scmlon', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) scmlon - call NUOPC_CompAttributeGet(gcomp, name='scmlat', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) scmlat + call ESMF_FieldGet(field_dst, farrayptr=dataptr1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! now determine ice_mask and ice_frac + do n = 1,size(dataptr1d) + lfrac = c1 - dataptr1d(n) + if (lfrac > fmaxval) lfrac = c1 + if (lfrac < fminval) lfrac = c0 + ice_frac(n) = c1 - lfrac + if (ice_frac(n) == c0) then + ice_mask(n) = 0 + else + ice_mask(n) = 1 end if - else - single_column = .false. - end if + enddo + + ! reset the model mesh mask + call ESMF_MeshSet(ice_mesh, elementMask=ice_mask, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! deallocate memory + call ESMF_RouteHandleDestroy(rhandle, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldDestroy(field_mask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldDestroy(field_dst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + deallocate(mask_src) + + ! Allocate module variable ocn_gridcell_frac + allocate(ocn_gridcell_frac(nx_block,ny_block,max_blocks)) - ! Determine start/count to read in for either single column or global lat-lon grid - ! If single_column, then assume that only master_task is used since there is only one task - - if (.not. single_column) then - - ! Obtain the model mask and model frac by mapping the mesh created by reading - ! in the model_maskfile to the model mesh and then resetting the model mesh mask - call ice_mesh_create_mask(ice_mesh, ice_maskfile, ice_mask, ice_frac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Obtain mesh areas in radians^2 - areaField = ESMF_FieldCreate(ice_mesh, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldRegridGetArea(areaField, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(areaField, farrayPtr=mesh_areas, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Obtain mesh lons and lats in degrees - call ESMF_MeshGet(ice_mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(ownedElemCoords(spatialDim*numownedelements)) - call ESMF_MeshGet(ice_mesh, ownedElemCoords=ownedElemCoords) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_MeshGet(ice_mesh, ownedElemCoords=ownedElemCoords, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Allocate module variable ocn_gridcell_frac - allocate(ocn_gridcell_frac(nx_block,ny_block,max_blocks)) - - ! Get required constants - call icepack_query_parameters(pi_out=pi, puny_out=puny, c180_out=c180) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - deg_to_rad = pi/c180 - - ! Set tlon, tlat, tarea, hm and ocn_gridcell_frac - ! Convert mesh areas from radians^2 to m^2 (tarea is in m^2) - ! Convert lons and lats from degrees to radians - n = 0 - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - do j = jlo, jhi - do i = ilo, ihi - n = n + 1 - tlon(i,j,iblk) = ownedElemCoords(2*n-1) * deg_to_rad - tlat(i,j,iblk) = ownedElemCoords(2*n) * deg_to_rad - tarea(i,j,iblk) = mesh_areas(n) * (radius*radius) - hm(i,j,iblk) = real(ice_mask(n),kind=dbl_kind) - ocn_gridcell_frac(i,j,iblk) = ice_frac(n) - enddo + ! Obtain mesh areas in radians^2 + areaField = ESMF_FieldCreate(ice_mesh, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegridGetArea(areaField, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(areaField, farrayPtr=mesh_areas, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Obtain mesh lons and lats in degrees + call ESMF_MeshGet(ice_mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(ownedElemCoords(spatialDim*numownedelements)) + call ESMF_MeshGet(ice_mesh, ownedElemCoords=ownedElemCoords) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(ice_mesh, ownedElemCoords=ownedElemCoords, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Get required constants + call icepack_query_parameters(pi_out=pi, c180_out=c180) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + deg_to_rad = pi/c180 + + ! Set tlon, tlat, tarea, hm + ! Convert mesh areas from radians^2 to m^2 (tarea is in m^2) + ! Convert lons and lats from degrees to radians + n = 0 + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + do j = jlo, jhi + do i = ilo, ihi + n = n + 1 + tlon(i,j,iblk) = ownedElemCoords(2*n-1) * deg_to_rad + tlat(i,j,iblk) = ownedElemCoords(2*n) * deg_to_rad + tarea(i,j,iblk) = mesh_areas(n) * (radius*radius) + hm(i,j,iblk) = real(ice_mask(n),kind=dbl_kind) + ocn_gridcell_frac(i,j,iblk) = ice_frac(n) enddo enddo + enddo - ! Dealocate memory - deallocate(ownedElemCoords) - call ESMF_FieldDestroy(areaField) + ! Dealocate memory + deallocate(ownedElemCoords) + call ESMF_FieldDestroy(areaField) - else ! single column mode + end subroutine ice_mesh_setmask_from_maskfile - if (my_task == master_task) then - call ice_open_nc(kmt_file, ncid) - status = nf90_inq_dimid (ncid, 'ni', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=ni) - status = nf90_inq_dimid (ncid, 'nj', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=nj) - end if + !=============================================================================== + subroutine ice_mesh_create_scolumn(scol_lon, scol_lat, ice_mesh, rc) - ! Check for consistency - if (my_task == master_task) then - if ((nx_global /= 1).or. (ny_global /= 1)) then - write(nu_diag,*) 'Because you have selected the column model flag' - write(nu_diag,*) 'Please set nx_global=ny_global=1 in file' - write(nu_diag,*) 'ice_domain_size.F and recompile' - call abort_ice ('ice_mesh_setmask_from_maskfile: check nx_global, ny_global') - endif - end if + use ice_constants , only : c0, c1 + use ice_scam , only : scmlat, scmlon, scol_area, scol_mask, scol_frac, scol_nj + use netcdf - ! Read in domain file for single column - allocate(lats(nj)) - allocate(lons(ni)) - allocate(pos_lons(ni)) - allocate(glob_grid(ni,nj)) - - start3=(/1,1,1/) - count3=(/ni,nj,1/) - status = nf90_inq_varid(ncid, 'xc' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid xc') - status = nf90_get_var(ncid, varid, glob_grid, start3, count3) - if (status /= nf90_noerr) call abort_ice (subname//' get_var xc') - do i = 1,ni - lons(i) = glob_grid(i,1) - end do + ! Create the model mesh from the domain file - for either single column mode + ! or for a regional grid - status = nf90_inq_varid(ncid, 'yc' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid yc') - status = nf90_get_var(ncid, varid, glob_grid, start3, count3) - if (status /= nf90_noerr) call abort_ice (subname//' get_var yc') - do j = 1,nj - lats(j) = glob_grid(1,j) - end do + ! input/output variables + real(dbl_kind) , intent(in) :: scol_lon + real(dbl_kind) , intent(in) :: scol_lat + type(ESMF_Mesh) , intent(inout) :: ice_mesh + integer , intent(out) :: rc - ! convert lons array and scmlon to 0,360 and find index of value closest to 0 - ! and obtain single-column longitude/latitude indices to retrieve - - pos_lons(:)= mod(lons(:) + 360._dbl_kind,360._dbl_kind) - pos_scmlon = mod(scmlon + 360._dbl_kind,360._dbl_kind) - start(1) = (MINLOC(abs(pos_lons-pos_scmlon),dim=1)) - start(2) = (MINLOC(abs(lats -scmlat ),dim=1)) - - deallocate(lats) - deallocate(lons) - deallocate(pos_lons) - deallocate(glob_grid) - - status = nf90_inq_varid(ncid, 'xc' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid xc') - status = nf90_get_var(ncid, varid, scamdata, start) - if (status /= nf90_noerr) call abort_ice (subname//' get_var xc') - TLON = scamdata - status = nf90_inq_varid(ncid, 'yc' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid yc') - status = nf90_get_var(ncid, varid, scamdata, start) - if (status /= nf90_noerr) call abort_ice (subname//' get_var yc') - TLAT = scamdata - status = nf90_inq_varid(ncid, 'area' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid area') - status = nf90_get_var(ncid, varid, scamdata, start) - if (status /= nf90_noerr) call abort_ice (subname//' get_var are') - tarea = scamdata - status = nf90_inq_varid(ncid, 'mask' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid mask') - status = nf90_get_var(ncid, varid, scamdata, start) - if (status /= nf90_noerr) call abort_ice (subname//' get_var mask') - hm = scamdata - status = nf90_inq_varid(ncid, 'frac' , varid) - if (status /= nf90_noerr) call abort_ice (subname//' inq_varid frac') - status = nf90_get_var(ncid, varid, scamdata, start) - if (status /= nf90_noerr) call abort_ice (subname//' get_var frac') - ocn_gridcell_frac = scamdata - - if (my_task == master_task) then - call ice_close_nc(ncid) - end if + ! local variables + type(ESMF_Grid) :: lgrid + integer :: maxIndex(2) + real(dbl_kind) :: mincornerCoord(2) + real(dbl_kind) :: maxcornerCoord(2) + integer :: i, j,iblk, jblk ! indices + integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain + type (block) :: this_block ! block information for current block + character(len=*), parameter :: subname = ' ice_mesh_create_scolumn' + ! ---------------------------------------------- - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - - do j = jlo, jhi - do i = ilo, ihi - ! Convert from degrees to radians - TLON(i,j,iblk) = pi*TLON(i,j,iblk)/180._dbl_kind - - ! Convert from degrees to radians - TLAT(i,j,iblk) = pi*TLAT(i,j,iblk)/180._dbl_kind - - ! Convert from radians^2 to m^2 - ! (area in domain file is in radians^2 and tarea is in m^2) - tarea(i,j,iblk) = tarea(i,j,iblk) * (radius*radius) - end do - end do - end do + rc = ESMF_SUCCESS + + ! Use center and come up with arbitrary area delta lon and lat = .1 degree + maxIndex(1) = 1 ! number of lons + maxIndex(2) = 1 ! number of lats + mincornerCoord(1) = scol_lon - .1_dbl_kind ! min lon + mincornerCoord(2) = scol_lat - .1_dbl_kind ! min lat + maxcornerCoord(1) = scol_lon + .1_dbl_kind ! max lon + maxcornerCoord(2) = scol_lat + .1_dbl_kind ! max lat + + ! create the ESMF grid + lgrid = ESMF_GridCreateNoPeriDimUfrm (maxindex=maxindex, & + mincornercoord=mincornercoord, maxcornercoord= maxcornercoord, & + staggerloclist=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create the mesh from the lgrid + ice_mesh = ESMF_MeshCreate(lgrid, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Allocate module variable ocn_gridcell_frac + allocate(ocn_gridcell_frac(nx_block,ny_block,max_blocks)) + ocn_gridcell_frac(:,:,:) = scol_frac + + end subroutine ice_mesh_create_scolumn + !=============================================================================== + subroutine ice_mesh_init_tlon_tlat_area_hm() + + use ice_grid , only : tlon, tlat, hm, tarea, ULON, ULAT, HTN, HTE, ANGLE, ANGLET + use ice_grid , only : uarea, uarear, tarear, tinyarea + use ice_grid , only : dxt, dyt, dxu, dyu, dyhx, dxhy, cyp, cxp, cym, cxm + use ice_grid , only : makemask + use ice_boundary , only : ice_HaloUpdate + use ice_domain , only : blocks_ice, nblocks, halo_info, distrb_info + use ice_constants , only : c0, c1, p25 + use ice_constants , only : field_loc_center, field_type_scalar + use ice_scam , only : scmlat, scmlon, scol_area, scol_mask, scol_frac, scol_nj, single_column + + ! local variables + integer :: i,j,n + integer :: iblk, jblk ! indices + integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain + type (block) :: this_block ! block information for current block + real(dbl_kind) :: puny + real(dbl_kind) :: pi + character(len=*), parameter :: subname = ' ice_mesh_init_tlon_tlat_area_hm' + ! ---------------------------------------------- + + ! Get required constants + call icepack_query_parameters(pi_out=pi, puny_out=puny) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + ! Check for consistency + if (single_column) then + if ((nx_global /= 1).or. (ny_global /= 1)) then + write(nu_diag,*) 'nx_global = ',nx_global + write(nu_diag,*) 'ny_global = ',ny_global + write(nu_diag,*) 'Because you have selected the column model flag' + write(nu_diag,*) 'then require nx_global=ny_global=1 in file ice_domain_size.F' + call abort_ice(' ice_mesh_init_tlon_tlat_area_hm: nx_global and ny_global need to be 1 for single column') + else + write(nu_diag,'(a,f10.5)')' single column mode lon/lat does contain ocn with ocn fraction ',scol_frac + end if + + TLON = scmlon + TLAT = scmlat + tarea = scol_area + hm = scol_mask + ULAT = TLAT + pi/scol_nj end if call ice_HaloUpdate (TLON , halo_info, field_loc_center, field_type_scalar, fillValue=c1) @@ -495,19 +513,17 @@ subroutine ice_mesh_setmask_from_maskfile(gcomp, ice_mesh, rc) else uarea(i,j,iblk) = p25* & (tarea(i,j, iblk) + tarea(i+1,j, iblk) & - + tarea(i,j+1,iblk) + tarea(i+1,j+1,iblk)) + + tarea(i,j+1,iblk) + tarea(i+1,j+1,iblk)) endif tarear(i,j,iblk) = c1/tarea(i,j,iblk) uarear(i,j,iblk) = c1/uarea(i,j,iblk) tinyarea(i,j,iblk) = puny*tarea(i,j,iblk) - if (single_column) then - ULAT (i,j,iblk) = TLAT(i,j,iblk)+(pi/nj) - else + if (.not. single_column) then if (ny_global == 1) then - ULAT (i,j,iblk) = TLAT(i,j,iblk) + ULAT(i,j,iblk) = TLAT(i,j,iblk) else - ULAT (i,j,iblk) = TLAT(i,j,iblk)+(pi/ny_global) + ULAT(i,j,iblk) = TLAT(i,j,iblk)+(pi/ny_global) endif endif ULON (i,j,iblk) = c0 @@ -536,116 +552,7 @@ subroutine ice_mesh_setmask_from_maskfile(gcomp, ice_mesh, rc) ! Also create hemisphere masks (mask-n northern, mask-s southern) call makemask() - end subroutine ice_mesh_setmask_from_maskfile - - !=============================================================================== - subroutine ice_mesh_create_mask(ice_mesh, ice_maskfile, ice_mask, ice_frac, rc) - - use ice_constants, only : c0, c1 - - ! input/out variables - type(ESMF_Mesh) , intent(in) :: ice_mesh - character(len=*) , intent(in) :: ice_maskfile - integer , pointer , intent(out) :: ice_mask(:) - real(dbl_kind) , pointer , intent(out) :: ice_frac(:) - integer , intent(out) :: rc - - ! local variables: - type(ESMF_Mesh) :: mesh_mask - type(ESMF_Field) :: field_mask - type(ESMF_Field) :: field_dst - type(ESMF_RouteHandle) :: rhandle - integer :: srcMaskValue = 0 - integer :: dstMaskValue = -987987 ! spval for RH mask values - integer :: srcTermProcessing_Value = 0 - logical :: checkflag = .false. - real(dbl_kind) , pointer :: mask_src(:) ! on mesh created from ice_maskfile - real(dbl_kind) , pointer :: dataptr1d(:) - type(ESMF_DistGrid) :: distgrid_mask - type(ESMF_Array) :: elemMaskArray - integer :: lsize_mask, lsize_dst - integer :: n, spatialDim - real(dbl_kind) :: fminval = 0.001_dbl_kind ! TODO: make this a share constant - real(dbl_kind) :: fmaxval = 1._dbl_kind - real(dbl_kind) :: lfrac - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - mesh_mask = ESMF_MeshCreate(trim(ice_maskfile), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_MeshGet(ice_mesh, spatialDim=spatialDim, numOwnedElements=lsize_dst, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(ice_mask(lsize_dst)) - allocate(ice_frac(lsize_dst)) - - ! create fields on source and destination meshes - field_mask = ESMF_FieldCreate(mesh_mask, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - field_dst = ESMF_FieldCreate(ice_mesh, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! create route handle to map source mask (assume ocean) to destination mesh (assume atm/lnd) - call ESMF_FieldRegridStore(field_mask, field_dst, routehandle=rhandle, & - srcMaskValues=(/srcMaskValue/), dstMaskValues=(/dstMaskValue/), & - regridmethod=ESMF_REGRIDMETHOD_CONSERVE, normType=ESMF_NORMTYPE_DSTAREA, & - srcTermProcessing=srcTermProcessing_Value, & - ignoreDegenerate=.true., unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! fill in values for field_mask with mask on source mesh - call ESMF_MeshGet(mesh_mask, elementdistGrid=distgrid_mask, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_DistGridGet(distgrid_mask, localDe=0, elementCount=lsize_mask, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(mask_src(lsize_mask)) - elemMaskArray = ESMF_ArrayCreate(distgrid_mask, mask_src, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! The following call fills in the values of mask_src - call ESMF_MeshGet(mesh_mask, elemMaskArray=elemMaskArray, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! The following call fills in the values of field_mask - call ESMF_FieldGet(field_mask, farrayptr=dataptr1d, rc=rc) - dataptr1d(:) = mask_src(:) - - ! map source mask to destination mesh - to obtain destination mask and frac - call ESMF_FieldRegrid(field_mask, field_dst, routehandle=rhandle, & - termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_MeshGet(ice_mesh, spatialDim=spatialDim, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field_dst, farrayptr=dataptr1d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! now determine ice_mask and ice_frac - do n = 1,lsize_dst - lfrac = c1 - dataptr1d(n) - if (lfrac > fmaxval) lfrac = c1 - if (lfrac < fminval) lfrac = c0 - ice_frac(n) = c1 - lfrac - if (ice_frac(n) == c0) then - ice_mask(n) = 0 - else - ice_mask(n) = 1 - end if - enddo - - ! reset the model mesh mask - call ESMF_MeshSet(ice_mesh, elementMask=ice_mask, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! deallocate memory - call ESMF_RouteHandleDestroy(rhandle, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldDestroy(field_mask, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldDestroy(field_dst, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - deallocate(mask_src) - - end subroutine ice_mesh_create_mask + end subroutine ice_mesh_init_tlon_tlat_area_hm !=============================================================================== subroutine ice_mesh_check(ice_mesh, rc) diff --git a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 index 3ea3704a8..3840a0a57 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 @@ -244,12 +244,15 @@ subroutine ice_prescribed_run(mDateIn, secIn) end if ! Get pointer for stream data that is time and spatially interpolate to model time and grid - call dshr_fldbun_getFldPtr(sdat%pstrm(1)%fldbun_model, 'ice_cov', dataptr, rc=rc) + call dshr_fldbun_getFldPtr(sdat%pstrm(1)%fldbun_model, 'ice_cov', dataptr, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then call ESMF_Finalize(endflag=ESMF_END_ABORT) end if ! Fill in module ice_cov array + if (.not. allocated(ice_cov)) then + allocate(ice_cov(nx_block,ny_block,max_blocks)) + end if ice_cov(:,:,:) = c0 ! This initializes ghost cells as well n = 0 do iblk = 1, nblocks diff --git a/cicecore/drivers/nuopc/cmeps/ice_scam.F90 b/cicecore/drivers/nuopc/cmeps/ice_scam.F90 index f5280b259..84ff87853 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_scam.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_scam.F90 @@ -6,9 +6,15 @@ module ice_scam ! single column control variables (only used for latlon grid) - logical :: single_column ! true => single column mode - real (kind=dbl_kind) scmlat ! single column latitude (degrees) - real (kind=dbl_kind) scmlon ! single column longitude (degrees) + logical :: single_column ! true => single column mode + real (kind=dbl_kind) :: scmlat ! single column latitude (degrees) + real (kind=dbl_kind) :: scmlon ! single column longitude (degrees) + real (kind=dbl_kind) :: scol_frac ! single column ocn fraction + real (kind=dbl_kind) :: scol_mask ! single column ocn mask + real (kind=dbl_kind) :: scol_area ! single column ocn area + integer :: scol_ni ! ni size of single column domain file + integer :: scol_nj ! nj size of single column domain file + logical :: scol_valid ! true => single column mask is 1 end module ice_scam From a2ddbd9316a50e31a96182e7b099be6c2e969871 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 6 May 2021 10:39:16 -0600 Subject: [PATCH 40/51] changed tolerance of mesh/grid comparison --- cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 index 37b2d8d1f..d49fd58ee 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 @@ -618,7 +618,7 @@ subroutine ice_mesh_check(ice_mesh, rc) ! error check differences between internally generated lons and those read in diff_lon = abs(lonMesh(n) - lon(n)) if ( (diff_lon > 1.e2 .and. abs(diff_lon - 360.) > 1.e-1) .or.& - (diff_lon > 1.e-3 .and. diff_lon < c1) ) then + (diff_lon > 1.e-1 .and. diff_lon < c1) ) then write(6,100)n,lonMesh(n),lon(n), diff_lon call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) From 56e1a8392dce44ab0ea544657e7162a7387c1240 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 10 May 2021 13:56:51 -0600 Subject: [PATCH 41/51] added issues raised in PR --- .../drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 23 ++++++++----------- 1 file changed, 10 insertions(+), 13 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index c5901ffd1..28a4220f8 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -26,7 +26,6 @@ module ice_comp_nuopc use ice_calendar , only : idate, mday, time, month, daycal, time2sec, year_init use ice_calendar , only : sec, dt, calendar, calendar_type, nextsw_cday, istep use ice_kinds_mod , only : dbl_kind, int_kind, char_len, char_len_long - use ice_scam , only : scmlat, scmlon, scol_mask, scol_frac, scol_ni, scol_nj, scol_valid, single_column use ice_fileunits , only : nu_diag, nu_diag_set, inst_index, inst_name use ice_fileunits , only : inst_suffix, release_all_fileunits, flush_fileunit use ice_restart_shared , only : runid, runtype, restart, use_restart_time, restart_dir, restart_file @@ -40,6 +39,7 @@ module ice_comp_nuopc #ifdef CESMCOUPLED use shr_const_mod use shr_orb_mod , only : shr_orb_decl, shr_orb_params, SHR_ORB_UNDEF_REAL, SHR_ORB_UNDEF_INT + use ice_scam , only : scmlat, scmlon, scol_mask, scol_frac, scol_ni, scol_nj, scol_valid, single_column #endif use ice_timers use CICE_InitMod , only : cice_init1, cice_init2 @@ -515,24 +515,21 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call abort_ice(trim(errmsg)) endif - ! Flux convergence tolerance - ! TODO: these need to be consistent - but for now use namelist value + ! Flux convergence tolerance - always use the driver attribute value call NUOPC_CompAttributeGet(gcomp, name="flux_convergence", value=cvalue, & isPresent=isPresent, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then read(cvalue,*) atmiter_conv_driver - else - atmiter_conv_driver = c0 + call icepack_query_parameters( atmiter_conv_out=atmiter_conv) + if (atmiter_conv_driver /= atmiter_conv) then + write(errmsg,'(a,d13.5,a,d13.5)') trim(subname)//'warning: atmiter_ from driver ',& + atmiter_conv_driver,' is overwritting atmiter_conv from cice namelist ',atmiter_conv + write(nu_diag,*) trim(errmsg) + call icepack_warnings_flush(nu_diag) + call icepack_init_parameters(atmiter_conv_in=atmiter_conv_driver) + end if end if - call icepack_query_parameters( atmiter_conv_out=atmiter_conv) - if (atmiter_conv_driver /= atmiter_conv) then - write(errmsg,'(a,d13.5,a,d13.5)') trim(subname)//'error: atmiter_ from driver ',& - atmiter_conv_driver,' must be the same as atmiter_conv from cice namelist ',atmiter_conv - write(nu_diag,*) trim(errmsg) - call icepack_warnings_flush(nu_diag) - !call abort_ice(trim(errmsg)) - endif ! Number of iterations for boundary layer calculations call NUOPC_CompAttributeGet(gcomp, name="flux_max_iteration", value=cvalue, isPresent=isPresent, rc=rc) From a026050e71d8812b167ddf7a9737567fede89c32 Mon Sep 17 00:00:00 2001 From: David Bailey Date: Mon, 21 Jun 2021 11:50:36 -0600 Subject: [PATCH 42/51] Update CESM-CICE sync with new time manager --- .../drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 23 +++++-------------- 1 file changed, 6 insertions(+), 17 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index 61eb6b1c5..a832e7bdf 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -23,7 +23,7 @@ module ice_comp_nuopc use ice_grid , only : grid_type, init_grid2 use ice_communicate , only : init_communicate, my_task, master_task, mpi_comm_ice use ice_calendar , only : force_restart_now, write_ic - use ice_calendar , only : idate, mday, mmonth, year_init, timesecs + use ice_calendar , only : idate, mday, mmonth, myear, year_init use ice_calendar , only : msec, dt, calendar, calendar_type, nextsw_cday, istep use ice_kinds_mod , only : dbl_kind, int_kind, char_len, char_len_long use ice_fileunits , only : nu_diag, nu_diag_set, inst_index, inst_name @@ -214,7 +214,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: ref_ymd ! Reference date (YYYYMMDD) integer :: ref_tod ! reference time of day (s) integer :: yy,mm,dd ! Temporaries for time query - integer :: iyear ! yyyy integer :: dtime ! time step integer :: shrlogunit ! original log unit character(len=char_len) :: starttype ! infodata start type @@ -638,7 +637,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! - on initial run ! - iyear, month and mday obtained from sync clock - ! - time determined from iyear, month and mday + ! - time determined from myear, month and mday ! - istep0 and istep1 are set to 0 ! - on restart run ! - istep0, time and time_forc are read from restart file @@ -667,28 +666,18 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) end if call abort_ice(subname//' :: ERROR idate lt zero') endif - iyear = (idate/10000) ! integer year of basedate - mmonth= (idate-iyear*10000)/100 ! integer month of basedate - mday = idate-iyear*10000-mmonth*100 ! day of month of basedate + myear = (idate/10000) ! integer year of basedate + mmonth= (idate-myear*10000)/100 ! integer month of basedate + mday = idate-myear*10000-mmonth*100 ! day of month of basedate if (my_task == master_task) then write(nu_diag,*) trim(subname),' curr_ymd = ',curr_ymd write(nu_diag,*) trim(subname),' cice year_init = ',year_init write(nu_diag,*) trim(subname),' cice start date = ',idate - write(nu_diag,*) trim(subname),' cice start ymds = ',iyear,mmonth,mday,start_tod + write(nu_diag,*) trim(subname),' cice start ymds = ',myear,mmonth,mday,start_tod write(nu_diag,*) trim(subname),' cice calendar_type = ',trim(calendar_type) endif -#ifdef CESMCOUPLED - if (calendar_type == "GREGORIAN" .or. & - calendar_type == "Gregorian" .or. & - calendar_type == "gregorian") then - call time2sec(iyear-(year_init-1),mmonth,mday,time) - else - call time2sec(iyear-year_init,mmonth,mday,time) - endif -#endif - timesecs = timesecs+start_tod end if call calendar() ! update calendar info From 380045bb4e03479662b8eaf02a969b81fbdb255c Mon Sep 17 00:00:00 2001 From: David Bailey Date: Mon, 21 Jun 2021 11:54:49 -0600 Subject: [PATCH 43/51] Add back in latlongrid --- cicecore/cicedynB/infrastructure/ice_grid.F90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/cicecore/cicedynB/infrastructure/ice_grid.F90 b/cicecore/cicedynB/infrastructure/ice_grid.F90 index 4e7f1d35c..470ea4844 100644 --- a/cicecore/cicedynB/infrastructure/ice_grid.F90 +++ b/cicecore/cicedynB/infrastructure/ice_grid.F90 @@ -379,6 +379,11 @@ subroutine init_grid2 else call popgrid ! read POP grid lengths directly endif +#ifdef CESMCOUPLED + elseif (trim(grid_type) == 'latlon') then + call latlongrid ! lat lon grid for sequential CESM (CAM mode) + return +#endif elseif (trim(grid_type) == 'cpom_grid') then call cpomgrid ! cpom model orca1 type grid else From c896dc652117e4bb01a7c76157fd8608cee49875 Mon Sep 17 00:00:00 2001 From: David Bailey Date: Tue, 19 Oct 2021 13:48:49 -0600 Subject: [PATCH 44/51] Add new advanced snow physics to driver --- cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 | 55 ++++++++++++++----- cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 | 27 ++++++--- 2 files changed, 61 insertions(+), 21 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 index cfca994c3..94c980e00 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 @@ -8,6 +8,7 @@ module CICE_InitMod use icepack_intfc, only: icepack_aggregate use icepack_intfc, only: icepack_init_itd, icepack_init_itd_hist use icepack_intfc, only: icepack_init_fsd_bounds, icepack_init_wave + use icepack_intfc, only: icepack_init_snow use icepack_intfc, only: icepack_configure use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_query_parameters, icepack_query_tracer_flags @@ -83,7 +84,7 @@ subroutine cice_init2() use ice_dyn_vp , only: init_vp use ice_flux , only: init_coupler_flux, init_history_therm use ice_flux , only: init_history_dyn, init_flux_atm, init_flux_ocn - use ice_forcing , only: init_forcing_ocn + use ice_forcing , only: init_snowtable use ice_forcing_bgc , only: get_forcing_bgc, get_atm_bgc use ice_forcing_bgc , only: faero_default, faero_optics, alloc_forcing_bgc, fiso_default use ice_history , only: init_hist, accum_hist @@ -95,7 +96,8 @@ subroutine cice_init2() use ice_transport_driver , only: init_transport logical(kind=log_kind) :: tr_aero, tr_zaero, skl_bgc, z_tracers - logical(kind=log_kind) :: tr_iso, tr_fsd, wave_spec + logical(kind=log_kind) :: tr_iso, tr_fsd, wave_spec, tr_snow + character(len=char_len) :: snw_aging_table character(len=*), parameter :: subname = '(cice_init2)' !---------------------------------------------------- @@ -137,15 +139,12 @@ subroutine cice_init2() call calendar() ! determine the initial date - !TODO: - why is this being called when you are using CMEPS? - call init_forcing_ocn(dt) ! initialize sss and sst from data - call init_state ! initialize the ice state call init_transport ! initialize horizontal transport call ice_HaloRestore_init ! restored boundary conditions call icepack_query_parameters(skl_bgc_out=skl_bgc, z_tracers_out=z_tracers, & - wave_spec_out=wave_spec) + wave_spec_out=wave_spec,snw_aging_table_out=snw_aging_table) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(trim(subname), & file=__FILE__,line= __LINE__) @@ -158,11 +157,22 @@ subroutine cice_init2() call init_history_dyn ! initialize dynamic history variables call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_zaero_out=tr_zaero) - call icepack_query_tracer_flags(tr_iso_out=tr_iso) + call icepack_query_tracer_flags(tr_iso_out=tr_iso,tr_snow_out=tr_snow) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(trim(subname), & file=__FILE__,line= __LINE__) + ! snow aging lookup table initialization + if (tr_snow) then ! advanced snow physics + call icepack_init_snow() + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + if (snw_aging_table(1:4) /= 'test') then + call init_snowtable() + endif + endif + if (tr_aero .or. tr_zaero) then call faero_optics !initialize aerosol optical property tables end if @@ -199,12 +209,12 @@ subroutine init_restart() use ice_calendar, only: calendar use ice_constants, only: c0 use ice_domain, only: nblocks - use ice_domain_size, only: ncat, n_iso, n_aero, nfsd + use ice_domain_size, only: ncat, n_iso, n_aero, nfsd, nslyr use ice_dyn_eap, only: read_restart_eap use ice_dyn_shared, only: kdyn use ice_grid, only: tmask use ice_init, only: ice_ic - use ice_init_column, only: init_age, init_FY, init_lvl, & + use ice_init_column, only: init_age, init_FY, init_lvl, init_snowtracers, & init_meltponds_cesm, init_meltponds_lvl, init_meltponds_topo, & init_isotope, init_aerosol, init_hbrine, init_bgc, init_fsd use ice_restart_column, only: restart_age, read_restart_age, & @@ -212,6 +222,7 @@ subroutine init_restart() restart_pond_cesm, read_restart_pond_cesm, & restart_pond_lvl, read_restart_pond_lvl, & restart_pond_topo, read_restart_pond_topo, & + restart_snow, read_restart_snow, & restart_fsd, read_restart_fsd, & restart_iso, read_restart_iso, & restart_aero, read_restart_aero, & @@ -226,13 +237,14 @@ subroutine init_restart() iblk ! block index logical(kind=log_kind) :: & tr_iage, tr_FY, tr_lvl, tr_pond_cesm, tr_pond_lvl, & - tr_pond_topo, tr_fsd, tr_iso, tr_aero, tr_brine, & + tr_pond_topo, tr_snow, tr_fsd, tr_iso, tr_aero, tr_brine, & skl_bgc, z_tracers, solve_zsal integer(kind=int_kind) :: & ntrcr integer(kind=int_kind) :: & - nt_alvl, nt_vlvl, nt_apnd, nt_hpnd, nt_ipnd, & - nt_iage, nt_FY, nt_aero, nt_fsd, nt_isosno, nt_isoice + nt_alvl, nt_vlvl, nt_apnd, nt_hpnd, nt_ipnd, nt_smliq, nt_smice, & + nt_iage, nt_FY, nt_aero, nt_fsd, nt_isosno, nt_isoice, & + nt_rhos, nt_rsnw character(len=*), parameter :: subname = '(init_restart)' !---------------------------------------------------- @@ -247,10 +259,12 @@ subroutine init_restart() call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & tr_lvl_out=tr_lvl, tr_pond_cesm_out=tr_pond_cesm, tr_pond_lvl_out=tr_pond_lvl, & tr_pond_topo_out=tr_pond_topo, tr_aero_out=tr_aero, tr_brine_out=tr_brine, & - tr_fsd_out=tr_fsd, tr_iso_out=tr_iso) + tr_snow_out=tr_snow, tr_fsd_out=tr_fsd, tr_iso_out=tr_iso) call icepack_query_tracer_indices(nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, & nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, & nt_iage_out=nt_iage, nt_FY_out=nt_FY, nt_aero_out=nt_aero, nt_fsd_out=nt_fsd, & + nt_smice_out=nt_smice, nt_smliq_out=nt_smliq, & + nt_rhos_out=nt_rhos, nt_rsnw_out=nt_rsnw, & nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -347,6 +361,20 @@ subroutine init_restart() enddo ! iblk endif ! .not. restart_pond endif + ! snow redistribution/metamorphism + if (tr_snow) then + if (trim(runtype) == 'continue') restart_snow = .true. + if (restart_snow) then + call read_restart_snow + else + do iblk = 1, nblocks + call init_snowtracers(trcrn(:,:,nt_smice:nt_smice+nslyr-1,:,iblk), & + trcrn(:,:,nt_smliq:nt_smliq+nslyr-1,:,iblk), & + trcrn(:,:,nt_rhos :nt_rhos +nslyr-1,:,iblk), & + trcrn(:,:,nt_rsnw :nt_rsnw +nslyr-1,:,iblk)) + enddo ! iblk + endif + endif ! floe size distribution if (tr_fsd) then if (trim(runtype) == 'continue') restart_fsd = .true. @@ -356,7 +384,6 @@ subroutine init_restart() call init_fsd(trcrn(:,:,nt_fsd:nt_fsd+nfsd-1,:,:)) endif endif - ! isotopes if (tr_iso) then if (trim(runtype) == 'continue') restart_iso = .true. diff --git a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 index 81fa367c1..ee817fa55 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 @@ -90,9 +90,9 @@ subroutine CICE_Run call ice_step - !-------------------------------------------------------------------- - ! end of timestep loop - !-------------------------------------------------------------------- + !-------------------------------------------------------------------- + ! end of timestep loop + !-------------------------------------------------------------------- call ice_timer_stop(timer_step) ! end timestepping loop timer @@ -123,12 +123,13 @@ subroutine ice_step use ice_restart_column, only: write_restart_age, write_restart_FY, & write_restart_lvl, write_restart_pond_cesm, write_restart_pond_lvl, & write_restart_pond_topo, write_restart_aero, write_restart_fsd, & - write_restart_iso, write_restart_bgc, write_restart_hbrine + write_restart_iso, write_restart_bgc, write_restart_hbrine, & + write_restart_snow use ice_restart_driver, only: dumpfile use ice_restoring, only: restore_ice, ice_HaloRestore use ice_step_mod, only: prep_radiation, step_therm1, step_therm2, & update_state, step_dyn_horiz, step_dyn_ridge, step_radiation, & - biogeochemistry, save_init, step_dyn_wave + biogeochemistry, save_init, step_dyn_wave, step_snow use ice_timers, only: ice_timer_start, ice_timer_stop, & timer_diags, timer_column, timer_thermo, timer_bound, & timer_hist, timer_readwrite @@ -144,7 +145,7 @@ subroutine ice_step offset ! d(age)/dt time offset logical (kind=log_kind) :: & - tr_iage, tr_FY, tr_lvl, tr_fsd, & + tr_iage, tr_FY, tr_lvl, tr_fsd, tr_snow, & tr_pond_cesm, tr_pond_lvl, tr_pond_topo, tr_brine, tr_iso, tr_aero, & calc_Tsfc, skl_bgc, solve_zsal, z_tracers, wave_spec @@ -156,7 +157,7 @@ subroutine ice_step call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & tr_lvl_out=tr_lvl, tr_pond_cesm_out=tr_pond_cesm, tr_pond_lvl_out=tr_pond_lvl, & tr_pond_topo_out=tr_pond_topo, tr_brine_out=tr_brine, tr_aero_out=tr_aero, & - tr_iso_out=tr_iso, tr_fsd_out=tr_fsd) + tr_iso_out=tr_iso, tr_fsd_out=tr_fsd, tr_snow_out=tr_snow) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -191,6 +192,17 @@ subroutine ice_step call ice_timer_start(timer_column) ! column physics call ice_timer_start(timer_thermo) ! thermodynamics + !----------------------------------------------------------------- + ! snow redistribution and metamorphosis + !----------------------------------------------------------------- + + if (tr_snow) then ! advanced snow physics + do iblk = 1, nblocks + call step_snow (dt, iblk) + enddo + call update_state (dt) ! clean up + endif + !$OMP PARALLEL DO PRIVATE(iblk) do iblk = 1, nblocks @@ -310,6 +322,7 @@ subroutine ice_step if (tr_pond_lvl) call write_restart_pond_lvl if (tr_pond_topo) call write_restart_pond_topo if (tr_fsd) call write_restart_fsd + if (tr_snow) call write_restart_snow if (tr_iso) call write_restart_iso if (tr_aero) call write_restart_aero if (solve_zsal .or. skl_bgc .or. z_tracers) & From 9fbb18848a03211c20ac108079710c92f9be6d27 Mon Sep 17 00:00:00 2001 From: David Bailey Date: Wed, 27 Oct 2021 15:09:47 -0600 Subject: [PATCH 45/51] Fix restart issue with land blocks --- cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 index 0ec6b7628..8e35463aa 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 @@ -728,6 +728,7 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3,diag, & ! if (ndim3 == ncat .and. ncat>1) then if (ndim3 == ncat .and. ndims == 3) then call pio_read_darray(File, vardesc, iodesc3d_ncat, work, status) + where (work == PIO_FILL_DOUBLE) work = c0 if (present(field_loc)) then do n=1,ndim3 call ice_HaloUpdate (work(:,:,n,:), halo_info, & @@ -737,6 +738,7 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3,diag, & ! elseif (ndim3 == 1) then elseif (ndim3 == 1 .and. ndims == 2) then call pio_read_darray(File, vardesc, iodesc2d, work, status) + where (work == PIO_FILL_DOUBLE) work = c0 if (present(field_loc)) then call ice_HaloUpdate (work(:,:,1,:), halo_info, & field_loc, field_type) From cbefb7abbf7f92ee41841237c289ad0d3f226e2b Mon Sep 17 00:00:00 2001 From: David Bailey Date: Thu, 28 Oct 2021 14:28:37 -0600 Subject: [PATCH 46/51] Update mesh check in cap --- cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 | 31 +++++++++++++------ 1 file changed, 21 insertions(+), 10 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 index 17941435d..3b7a51cf7 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 @@ -636,17 +636,28 @@ subroutine ice_mesh_check(gcomp, ice_mesh, rc) if(tmplon < c0)tmplon = tmplon + c360 ! error check differences between internally generated lons and those read in - diff_lon = abs(mod(lonMesh(n) - tmplon,360.0)) - if (diff_lon > eps_imesh ) then - write(6,100)n,lonMesh(n),tmplon, diff_lon - call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) +! diff_lon = abs(mod(lonMesh(n) - tmplon,360.0)) +! if (diff_lon > eps_imesh ) then +! write(6,100)n,lonMesh(n),tmplon, diff_lon +! call abort_ice(error_message=subname, & +! file=__FILE__, line=__LINE__) +! end if +! diff_lat = abs(latMesh(n) - lat(n)) +! if (diff_lat > eps_imesh) then +! write(6,101)n,latMesh(n),lat(n), diff_lat +! call abort_ice(error_message=subname, & +! file=__FILE__, line=__LINE__) +! end if + ! error check differences between internally generated lons and those read in + diff_lon = abs(lonMesh(n) - lon(n)) + if ( (diff_lon > 1.e2 .and. abs(diff_lon - 360.) > 1.e-1) .or.& + (diff_lon > 1.e-3 .and. diff_lon < c1) ) then + write(6,100)n,lonMesh(n),lon(n), diff_lon + !call abort_ice ('aborting due to mismatch of mesh lon and input cice lon') end if - diff_lat = abs(latMesh(n) - lat(n)) - if (diff_lat > eps_imesh) then - write(6,101)n,latMesh(n),lat(n), diff_lat - call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) + if (abs(latMesh(n) - lat(n)) > 1.e-1) then + write(6,101)n,latMesh(n),lat(n), abs(latMesh(n)-lat(n)) + !call abort_ice ('aborting due to mismatch of mesh lat and input cice lat') end if enddo From ecbd0a2b75c8822376a35a946388606b5d36fc85 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 8 Nov 2021 19:15:56 -0700 Subject: [PATCH 47/51] fix scam problems --- .../drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 185 +++++++++++------- .../drivers/nuopc/cmeps/ice_import_export.F90 | 4 +- 2 files changed, 114 insertions(+), 75 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index a832e7bdf..99388fcb4 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -224,6 +224,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain character(len=char_len_long) :: diag_filename = 'unset' character(len=char_len_long) :: logmsg + character(len=char_len_long) :: single_column_lnd_domainfile + real(dbl_kind) :: scol_lon + real(dbl_kind) :: scol_lat + real(dbl_kind) :: scol_spval character(len=*), parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !-------------------------------- @@ -493,12 +497,67 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! First cice initialization phase - before initializing grid info !---------------------------------------------------------------------------- +#ifdef CESMCOUPLED + ! Determine if single column + + call NUOPC_CompAttributeGet(gcomp, name='scol_lon', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scmlon + call NUOPC_CompAttributeGet(gcomp, name='scol_lat', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scmlat + call NUOPC_CompAttributeGet(gcomp, name='scol_spval', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scol_spval + + if (scmlon > scol_spval .and. scmlat > scol_spval) then + call NUOPC_CompAttributeGet(gcomp, name='single_column_lnd_domainfile', & + value=single_column_lnd_domainfile, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(single_column_lnd_domainfile) /= 'UNSET') then + single_column = .true. + else + call abort_ice('single_column_domainfile cannot be null for single column mode') + end if + call NUOPC_CompAttributeGet(gcomp, name='scol_ocnmask', value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scol_mask + call NUOPC_CompAttributeGet(gcomp, name='scol_ocnfrac', value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scol_frac + call NUOPC_CompAttributeGet(gcomp, name='scol_ni', value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scol_ni + call NUOPC_CompAttributeGet(gcomp, name='scol_nj', value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scol_nj + + call ice_mesh_create_scolumn(scmlon, scmlat, ice_mesh, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + scol_valid = (scol_mask == 1) + if (.not. scol_valid) then + write(6,*)'DEBUG: i am here' + ! Advertise fields + call ice_advertise_fields(gcomp, importState, exportState, flds_scalar_name, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call t_stopf ('cice_init_total') + + ! ******************* + ! *** RETURN HERE *** + ! ******************* + RETURN + end if + end if + ! Read the cice namelist as part of the call to cice_init1 + ! Note that if single_column is true and scol_valid is not - will never get here + call t_startf ('cice_init1') call cice_init1 call t_stopf ('cice_init1') -#ifdef CESMCOUPLED ! Form of ocean freezing temperature ! 'minus1p8' = -1.8 C ! 'linear_salt' = -depressT * sss @@ -546,13 +605,20 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ' must be the same as natmiter from cice namelist ',natmiter call abort_ice(trim(errmsg)) endif + +#else + + ! Read the cice namelist as part of the call to cice_init1 + call t_startf ('cice_init1') + call cice_init1 + call t_stopf ('cice_init1') + #endif + !---------------------------------------------------------------------------- ! Initialize grid info !---------------------------------------------------------------------------- - ! Initialize cice mesh and mask if appropriate - if (single_column .and. scol_valid) then call ice_mesh_init_tlon_tlat_area_hm() else @@ -737,82 +803,43 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) #ifdef CESMCOUPLED - call NUOPC_CompAttributeGet(gcomp, name='scol_lon', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) scmlon - call NUOPC_CompAttributeGet(gcomp, name='scol_lat', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) scmlat - call NUOPC_CompAttributeGet(gcomp, name='scol_spval', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) scol_spval - - if (scmlon > scol_spval .and. scmlat > scol_spval) then - call NUOPC_CompAttributeGet(gcomp, name='single_column_lnd_domainfile', & - value=single_column_lnd_domainfile, rc=rc) + ! if single column is not valid - set all export state fields to zero and return + if (single_column .and. .not. scol_valid) then + write(nu_diag,'(a)')' (ice_comp_nuopc) single column mode point does not contain any ocn/ice '& + //' - setting all export data to 0' + call ice_realize_fields(gcomp, mesh=ice_mesh, & + flds_scalar_name=flds_scalar_name, flds_scalar_num=flds_scalar_num, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (trim(single_column_lnd_domainfile) /= 'UNSET') then - single_column = .true. - else - call abort_ice('single_column_domainfile cannot be null for single column mode') - end if - call NUOPC_CompAttributeGet(gcomp, name='scol_ocnmask', value=cvalue, rc=rc) + call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) scol_mask - call NUOPC_CompAttributeGet(gcomp, name='scol_ocnfrac', value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) scol_frac - call NUOPC_CompAttributeGet(gcomp, name='scol_ni', value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) scol_ni - call NUOPC_CompAttributeGet(gcomp, name='scol_nj', value=cvalue, rc=rc) + allocate(lfieldnamelist(fieldCount)) + call ESMF_StateGet(exportState, itemNameList=lfieldnamelist, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) scol_nj - - call ice_mesh_create_scolumn(scmlon, scmlat, ice_mesh, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - scol_valid = (scol_mask == 1) - if (.not. scol_valid) then - ! if single column is not valid - set all export state fields to zero and return - write(nu_diag,'(a)')' (ice_comp_nuopc) single column mode point does not contain any ocn/ice '& - //' - setting all export data to 0' - call ice_realize_fields(gcomp, mesh=ice_mesh, & - flds_scalar_name=flds_scalar_name, flds_scalar_num=flds_scalar_num, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(lfieldnamelist(fieldCount)) - call ESMF_StateGet(exportState, itemNameList=lfieldnamelist, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1, fieldCount - if (trim(lfieldnamelist(n)) /= flds_scalar_name) then - call ESMF_StateGet(exportState, itemName=trim(lfieldnamelist(n)), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, rank=rank, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (rank == 2) then - call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr2d(:,:) = 0._dbl_kind - else - call ESMF_FieldGet(lfield, farrayPtr=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - fldptr1d(:) = 0._dbl_kind - end if + do n = 1, fieldCount + if (trim(lfieldnamelist(n)) /= flds_scalar_name) then + call ESMF_StateGet(exportState, itemName=trim(lfieldnamelist(n)), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, rank=rank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (rank == 2) then + call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr2d(:,:) = 0._dbl_kind + else + call ESMF_FieldGet(lfield, farrayPtr=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._dbl_kind end if - enddo - deallocate(lfieldnamelist) - ! ******************* - ! *** RETURN HERE *** - ! ******************* - RETURN - else - write(nu_diag,'(a,3(f10.5,2x))')' (ice_comp_nuopc) single column mode lon/lat/frac is ',& - scmlon,scmlat,scol_frac - end if + end if + enddo + deallocate(lfieldnamelist) + ! ******************* + ! *** RETURN HERE *** + ! ******************* + RETURN else - single_column = .false. + write(nu_diag,'(a,3(f10.5,2x))')' (ice_comp_nuopc) single column mode lon/lat/frac is ',& + scmlon,scmlat,scol_frac end if #endif @@ -902,6 +929,16 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + + if (single_column .and. .not. scol_valid) then + ! ******************* + ! *** RETURN HERE *** + ! ******************* + RETURN + end if + if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! query the Component for its clock, importState and exportState diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index 62ff2727d..d44199bcb 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -131,7 +131,9 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam write(nu_diag,*)'send_i2x_per_cat = ',send_i2x_per_cat end if if (.not.send_i2x_per_cat) then - deallocate(fswthrun_ai) + if (allocated(fswthrun_ai)) then + deallocate(fswthrun_ai) + end if end if ! Determine if the following attributes are sent by the driver and if so read them in From 364961c48c9e50a0cd368a5b21299683ec6564b0 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 23 Nov 2021 17:04:30 -0700 Subject: [PATCH 48/51] reintroduced imesh_eps check --- cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 | 30 +++++-------------- 1 file changed, 8 insertions(+), 22 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 index 3b7a51cf7..fffe575de 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_mesh_mod.F90 @@ -636,30 +636,16 @@ subroutine ice_mesh_check(gcomp, ice_mesh, rc) if(tmplon < c0)tmplon = tmplon + c360 ! error check differences between internally generated lons and those read in -! diff_lon = abs(mod(lonMesh(n) - tmplon,360.0)) -! if (diff_lon > eps_imesh ) then -! write(6,100)n,lonMesh(n),tmplon, diff_lon -! call abort_ice(error_message=subname, & -! file=__FILE__, line=__LINE__) -! end if -! diff_lat = abs(latMesh(n) - lat(n)) -! if (diff_lat > eps_imesh) then -! write(6,101)n,latMesh(n),lat(n), diff_lat -! call abort_ice(error_message=subname, & -! file=__FILE__, line=__LINE__) -! end if - ! error check differences between internally generated lons and those read in - diff_lon = abs(lonMesh(n) - lon(n)) - if ( (diff_lon > 1.e2 .and. abs(diff_lon - 360.) > 1.e-1) .or.& - (diff_lon > 1.e-3 .and. diff_lon < c1) ) then - write(6,100)n,lonMesh(n),lon(n), diff_lon - !call abort_ice ('aborting due to mismatch of mesh lon and input cice lon') + diff_lon = abs(mod(lonMesh(n) - tmplon,360.0)) + if (diff_lon > eps_imesh ) then + write(6,100)n,lonMesh(n),tmplon, diff_lon + !call abort_ice(error_message=subname, file=__FILE__, line=__LINE__) end if - if (abs(latMesh(n) - lat(n)) > 1.e-1) then - write(6,101)n,latMesh(n),lat(n), abs(latMesh(n)-lat(n)) - !call abort_ice ('aborting due to mismatch of mesh lat and input cice lat') + diff_lat = abs(latMesh(n) - lat(n)) + if (diff_lat > eps_imesh) then + write(6,101)n,latMesh(n),lat(n), diff_lat + !call abort_ice(error_message=subname, file=__FILE__, line=__LINE__) end if - enddo enddo enddo From 545906ec2435bc12d5b055037848827e31a9d563 Mon Sep 17 00:00:00 2001 From: David Bailey Date: Thu, 2 Dec 2021 09:33:57 -0700 Subject: [PATCH 49/51] Put dragio in the namelist instead --- cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index cad480dd9..ba763b420 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -376,8 +376,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) depressT_in = 0.054_dbl_kind, & Tocnfrz_in = -34.0_dbl_kind*0.054_dbl_kind, & pi_in = SHR_CONST_PI, & - snowpatch_in = 0.005_dbl_kind, & - dragio_in = 0.00536_dbl_kind) + snowpatch_in = 0.005_dbl_kind) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & From 6db265a3c5794996a97ab696f8ae6a0d8ec6fda2 Mon Sep 17 00:00:00 2001 From: David Bailey Date: Mon, 6 Dec 2021 08:24:34 -0700 Subject: [PATCH 50/51] Remove redundant code --- cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 | 11 ----------- cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 | 12 ------------ 2 files changed, 23 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 index e365be231..338b25050 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 @@ -162,17 +162,6 @@ subroutine cice_init2() if (icepack_warnings_aborted()) call abort_ice(trim(subname), & file=__FILE__,line= __LINE__) - ! snow aging lookup table initialization - if (tr_snow) then ! advanced snow physics - call icepack_init_snow() - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - if (snw_aging_table(1:4) /= 'test') then - call init_snowtable() - endif - endif - if (tr_aero .or. tr_zaero) then call faero_optics !initialize aerosol optical property tables end if diff --git a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 index 2925a5d77..bd66185a1 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 @@ -201,17 +201,6 @@ subroutine ice_step call ice_timer_start(timer_column) ! column physics call ice_timer_start(timer_thermo) ! thermodynamics - !----------------------------------------------------------------- - ! snow redistribution and metamorphosis - !----------------------------------------------------------------- - - if (tr_snow) then ! advanced snow physics - do iblk = 1, nblocks - call step_snow (dt, iblk) - enddo - call update_state (dt) ! clean up - endif - !$OMP PARALLEL DO PRIVATE(iblk) do iblk = 1, nblocks @@ -386,7 +375,6 @@ subroutine ice_step if (tr_pond_topo) call write_restart_pond_topo if (tr_snow) call write_restart_snow if (tr_fsd) call write_restart_fsd - if (tr_snow) call write_restart_snow if (tr_iso) call write_restart_iso if (tr_aero) call write_restart_aero if (solve_zsal .or. skl_bgc .or. z_tracers) & From 5e6a27c8a77997f318aaf1a3488a51dc49f1604c Mon Sep 17 00:00:00 2001 From: David Bailey Date: Mon, 6 Dec 2021 09:01:22 -0700 Subject: [PATCH 51/51] Fix some indents --- cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 index bd66185a1..779adc65d 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 @@ -56,9 +56,9 @@ subroutine CICE_Run tr_iso, tr_aero, tr_zaero, skl_bgc, z_tracers, wave_spec, tr_fsd character(len=*), parameter :: subname = '(CICE_Run)' - !-------------------------------------------------------------------- - ! initialize error code and step timer - !-------------------------------------------------------------------- + !-------------------------------------------------------------------- + ! initialize error code and step timer + !-------------------------------------------------------------------- call ice_timer_start(timer_step) ! start timing entire run @@ -73,13 +73,13 @@ subroutine CICE_Run if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - !-------------------------------------------------------------------- - ! timestep loop - !-------------------------------------------------------------------- + !-------------------------------------------------------------------- + ! timestep loop + !-------------------------------------------------------------------- call ice_timer_start(timer_couple) ! atm/ocn coupling - call advance_timestep() ! advance timestep and update calendar data + call advance_timestep() ! advance timestep and update calendar data if (z_tracers) call get_atm_bgc ! biogeochemistry @@ -90,9 +90,9 @@ subroutine CICE_Run call ice_step - !-------------------------------------------------------------------- - ! end of timestep loop - !-------------------------------------------------------------------- + !-------------------------------------------------------------------- + ! end of timestep loop + !-------------------------------------------------------------------- call ice_timer_stop(timer_step) ! end timestepping loop timer