diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index e1c69cd7b..24b18683d 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -23,8 +23,8 @@ jobs: ESMF_VERSION: v8.6.1 PNETCDF_VERSION: checkpoint.1.12.3 NETCDF_FORTRAN_VERSION: v4.6.1 - PIO_VERSION: pio2_6_2 - CDEPS_VERSION: cdeps1.0.36 + PIO_VERSION: pio2_6_3 + CDEPS_VERSION: cdeps1.0.59 steps: - uses: actions/checkout@v4 # Build the ESMF library, if the cache contains a previous build diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index efec7ba88..fc75ec263 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -18,7 +18,7 @@ jobs: runs-on: ubuntu-latest strategy: matrix: - python-version: [ 3.10.9 ] + python-version: [ 3.x ] env: CC: mpicc FC: mpifort @@ -27,7 +27,7 @@ jobs: LDFLAGS: "-L/usr/lib/x86_64-linux-gnu -lnetcdf -lnetcdff -lpnetcdf" # Versions of all dependencies can be updated here ESMF_VERSION: v8.6.1 - PARALLELIO_VERSION: pio2_6_2 + PARALLELIO_VERSION: pio2_6_3 CIME_MODEL: cesm CIME_DRIVER: nuopc GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} @@ -78,13 +78,15 @@ jobs: # cpl7 is needed - i think that's a bug - name: checkout externals run: | + git config --global user.name "${GITHUB_ACTOR}" + git config --global user.email "${GITHUB_ACTOR_ID}+${GITHUB_ACTOR}@users.noreply.github.com" pushd cesm - ./bin/git-fleximod update ccs_config cdeps share mct parallelio + ./bin/git-fleximod update cime ccs_config cdeps share mct parallelio cd ccs_config git checkout main - cd ../ - git clone https://github.com/ESMCI/cime - cd cime + cd ../cime + git checkout master + git status if [[ ! -e "${PWD}/.gitmodules.bak" ]] then echo "Converting git@github.com to https://github.com urls in ${PWD}/.gitmodules" @@ -172,6 +174,6 @@ jobs: popd # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details - - name: Setup tmate session - if: ${{ failure() }} - uses: mxschmitt/action-tmate@v3 +# - name: Setup tmate session +# if: ${{ failure() }} +# uses: mxschmitt/action-tmate@v3 diff --git a/cesm/driver/esm_time_mod.F90 b/cesm/driver/esm_time_mod.F90 index 3b56bb953..c423b96fc 100644 --- a/cesm/driver/esm_time_mod.F90 +++ b/cesm/driver/esm_time_mod.F90 @@ -11,28 +11,26 @@ module esm_time_mod use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet, ESMF_TimeIntervalGet use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FAILURE, ESMF_LOGMSG_ERROR use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast - use ESMF , only : ESMF_VMAllReduce, ESMF_REDUCE_MAX + use ESMF , only : ESMF_VMAllReduce, ESMF_REDUCE_MAX, ESMF_ClockGetAlarm use ESMF , only : ESMF_LOGMSG_INFO, ESMF_FAILURE, ESMF_GridCompIsPetLocal use ESMF , only : operator(<), operator(/=), operator(+) use ESMF , only : operator(-), operator(*) , operator(>=) use ESMF , only : operator(<=), operator(>), operator(==) use NUOPC , only : NUOPC_CompAttributeGet use esm_utils_mod , only : chkerr - + use nuopc_shr_methods , only : AlarmInit + implicit none private ! default private - public :: esm_time_clockInit ! initialize driver clock (assumes default calendar) + public :: esm_time_clockinit ! initialize driver clock (assumes default calendar) -! private :: esm_time_timeInit - private :: esm_time_alarmInit private :: esm_time_date2ymd ! Clock and alarm options character(len=*), private, parameter :: & optNONE = "none" , & optNever = "never" , & - optNSteps = "nstep" , & optNSeconds = "nsecond" , & optNMinutes = "nminute" , & optNHours = "nhour" , & @@ -42,6 +40,7 @@ module esm_time_mod optMonthly = "monthly" , & optYearly = "yearly" , & optDate = "date" , & + optEnd = "end" , & optGLCCouplingPeriod = "glc_coupling_period" ! Module data @@ -53,8 +52,8 @@ module esm_time_mod contains !=============================================================================== - subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintask, rc) - + subroutine esm_time_clockinit(ensemble_driver, instance_driver, logunit, maintask, rc) + use nuopc_shr_methods, only : get_minimum_timestep, dtime_drv ! input/output variables type(ESMF_GridComp) :: ensemble_driver, instance_driver integer, intent(in) :: logunit @@ -81,20 +80,11 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintas integer :: stop_ymd ! Stop date (YYYYMMDD) integer :: stop_tod ! Stop time-of-day character(CS) :: stop_option ! Stop option units - integer :: atm_cpl_dt ! Atmosphere coupling interval - integer :: lnd_cpl_dt ! Land coupling interval - integer :: ice_cpl_dt ! Sea-Ice coupling interval - integer :: ocn_cpl_dt ! Ocean coupling interval - integer :: glc_cpl_dt ! Glc coupling interval - integer :: rof_cpl_dt ! Runoff coupling interval - integer :: wav_cpl_dt ! Wav coupling interval -! integer :: esp_cpl_dt ! Esp coupling interval character(CS) :: glc_avg_period ! Glc avering coupling period logical :: read_restart character(len=CL) :: restart_file character(len=CL) :: restart_pfile character(len=CL) :: cvalue - integer :: dtime_drv ! time-step to use integer :: yr, mon, day ! Year, month, day as integers integer :: unitn ! unit number integer :: ierr ! Return code @@ -105,6 +95,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintas logical :: isPresent logical :: inDriver logical, save :: firsttime=.true. + logical :: exists character(len=*), parameter :: subname = '('//__FILE__//':esm_time_clockInit) ' !------------------------------------------------------------------------------- @@ -122,44 +113,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintas if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) start_tod - !--------------------------------------------------------------------------- - ! Determine driver clock timestep - !--------------------------------------------------------------------------- - - call NUOPC_CompAttributeGet(ensemble_driver, name="atm_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) atm_cpl_dt - - call NUOPC_CompAttributeGet(ensemble_driver, name="lnd_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) lnd_cpl_dt - - call NUOPC_CompAttributeGet(ensemble_driver, name="ice_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) ice_cpl_dt - call NUOPC_CompAttributeGet(ensemble_driver, name="ocn_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) ocn_cpl_dt - - call NUOPC_CompAttributeGet(ensemble_driver, name="glc_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) glc_cpl_dt - - call NUOPC_CompAttributeGet(ensemble_driver, name="rof_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) rof_cpl_dt - - call NUOPC_CompAttributeGet(ensemble_driver, name="wav_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) wav_cpl_dt - - dtime_drv = minval((/atm_cpl_dt, lnd_cpl_dt, ocn_cpl_dt, ice_cpl_dt, glc_cpl_dt, rof_cpl_dt, wav_cpl_dt/)) - if(maintask) then - write(tmpstr,'(i10)') dtime_drv - call ESMF_LogWrite(trim(subname)//': driver time interval is : '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - write(logunit,*) trim(subname)//': driver time interval is : '// trim(tmpstr) - endif call ESMF_GridCompGet(ensemble_driver, vm=envm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -177,23 +131,20 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintas if (read_restart) then - call NUOPC_CompAttributeGet(instance_driver, name='drv_restart_pointer', value=restart_file, rc=rc) + call NUOPC_CompAttributeGet(instance_driver, name='drv_restart_pointer', value=restart_pfile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (trim(restart_file) /= 'none') then - - call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(isPresent) then - call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", value=inst_suffix, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - inst_suffix = "" - endif - - restart_pfile = trim(restart_file)//inst_suffix + if (trim(restart_pfile) /= 'none') then if (maintask) then + write(logunit,*) " read rpointer file = "//trim(restart_pfile) + inquire( file=trim(restart_pfile), exist=exists) + if (.not. exists) then + rc = ESMF_FAILURE + call ESMF_LogWrite(trim(subname)//' ERROR rpointer file '//trim(restart_pfile)//' not found', & + ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__) + return + endif call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), & ESMF_LOGMSG_INFO) open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old',iostat=ierr) @@ -282,6 +233,12 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintas call ESMF_TimeSet( RefTime, yy=yr, mm=mon, dd=day, s=ref_tod, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + dtime_drv = get_minimum_timestep(ensemble_driver, rc) + if(maintask) then + write(tmpstr,'(i10)') dtime_drv + call ESMF_LogWrite(trim(subname)//': driver time interval is : '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + write(logunit,*) trim(subname)//': driver time interval is : '// trim(tmpstr) + endif call ESMF_TimeIntervalSet( TimeStep, s=dtime_drv, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -335,7 +292,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintas write(logunit,*) trim(subname)//': driver stop_tod: '// trim(tmpstr) endif - call esm_time_alarmInit(clock, & + call alarmInit(clock, & alarm = alarm_stop, & option = stop_option, & opt_n = stop_n, & @@ -364,260 +321,8 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintas if (ChkErr(rc,__LINE__,u_FILE_u)) return firsttime = .false. endif - end subroutine esm_time_clockInit - - !=============================================================================== - - subroutine esm_time_alarmInit( clock, alarm, option, & - opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) - - ! Setup an alarm in a clock - ! Notes: The ringtime sent to AlarmCreate MUST be the next alarm - ! time. If you send an arbitrary but proper ringtime from the - ! past and the ring interval, the alarm will always go off on the - ! next clock advance and this will cause serious problems. Even - ! if it makes sense to initialize an alarm with some reference - ! time and the alarm interval, that reference time has to be - ! advance forward to be >= the current time. In the logic below - ! we set an appropriate "NextAlarm" and then we make sure to - ! advance it properly based on the ring interval. - - ! input/output variables - type(ESMF_Clock) , intent(inout) :: clock ! clock - type(ESMF_Alarm) , intent(inout) :: alarm ! alarm - character(len=*) , intent(in) :: option ! alarm option - integer , optional , intent(in) :: opt_n ! alarm freq - integer , optional , intent(in) :: opt_ymd ! alarm ymd - integer , optional , intent(in) :: opt_tod ! alarm tod (sec) - type(ESMF_Time) , optional , intent(in) :: RefTime ! ref time - character(len=*) , optional , intent(in) :: alarmname ! alarm name - integer , intent(inout) :: rc ! Return code - - ! local variables - type(ESMF_Calendar) :: cal ! calendar - integer :: lymd ! local ymd - integer :: ltod ! local tod - integer :: cyy,cmm,cdd,csec ! time info - character(len=64) :: lalarmname ! local alarm name - logical :: update_nextalarm ! update next alarm - type(ESMF_Time) :: CurrTime ! Current Time - type(ESMF_Time) :: NextAlarm ! Next restart alarm time - type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval - character(len=*), parameter :: subname = '(med_time_alarmInit): ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - lalarmname = 'alarm_unknown' - if (present(alarmname)) lalarmname = trim(alarmname) - ltod = 0 - if (present(opt_tod)) ltod = opt_tod - lymd = -1 - if (present(opt_ymd)) lymd = opt_ymd - - call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! initial guess of next alarm, this will be updated below - if (present(RefTime)) then - NextAlarm = RefTime - else - NextAlarm = CurrTime - endif - - ! Get calendar from clock - call ESMF_ClockGet(clock, calendar=cal, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Error checks - if (trim(option) == optdate) then - if (.not. present(opt_ymd)) then - call ESMF_LogWrite(trim(subname)//trim(option)//' requires opt_ymd', ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - end if - if (lymd < 0 .or. ltod < 0) then - call ESMF_LogWrite(subname//trim(option)//'opt_ymd, opt_tod invalid', ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - end if - else if (& - trim(option) == optNSteps .or. trim(option) == trim(optNSteps)//'s' .or. & - trim(option) == optNSeconds .or. trim(option) == trim(optNSeconds)//'s' .or. & - trim(option) == optNMinutes .or. trim(option) == trim(optNMinutes)//'s' .or. & - trim(option) == optNHours .or. trim(option) == trim(optNHours)//'s' .or. & - trim(option) == optNDays .or. trim(option) == trim(optNDays)//'s' .or. & - trim(option) == optNMonths .or. trim(option) == trim(optNMonths)//'s' .or. & - trim(option) == optNYears .or. trim(option) == trim(optNYears)//'s' ) then - if (.not.present(opt_n)) then - call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - end if - if (opt_n <= 0) then - call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - end if - end if - - ! Determine inputs for call to create alarm - selectcase (trim(option)) - - case (optNONE) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optDate) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call esm_time_date2ymd(opt_ymd, cyy, cmm, cdd) - - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=cdd, s=ltod, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optNever) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optNSteps,trim(optNSteps)//'s') - call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNSeconds,trim(optNSeconds)//'s') - call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMinutes,trim(optNMinutes)//'s') - call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNHours,trim(optNHours)//'s') - call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNDays,trim(optNDays)//'s') - call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMonths,trim(optNMonths)//'s') - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optMonthly) - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .true. - - case (optNYears, trim(optNYears)//'s') - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optYearly) - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .true. - - case default - call ESMF_LogWrite(subname//'unknown option '//trim(option), ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - - end select - - ! -------------------------------------------------------------------------------- - ! --- AlarmInterval and NextAlarm should be set --- - ! -------------------------------------------------------------------------------- - - ! --- advance Next Alarm so it won't ring on first timestep for - ! --- most options above. go back one alarminterval just to be careful - - if (update_nextalarm) then - NextAlarm = NextAlarm - AlarmInterval - do while (NextAlarm <= CurrTime) - NextAlarm = NextAlarm + AlarmInterval - enddo - endif - - alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, & - ringInterval=AlarmInterval, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - end subroutine esm_time_alarmInit - - !=============================================================================== -#ifdef UNUSEDFUNCTION - subroutine esm_time_timeInit( Time, ymd, cal, tod, desc, logunit ) - - ! Create the ESMF_Time object corresponding to the given input time, given in - ! YMD (Year Month Day) and TOD (Time-of-day) format. - ! Set the time by an integer as YYYYMMDD and integer seconds in the day - - ! input/output parameters: - type(ESMF_Time) , intent(inout) :: Time ! ESMF time - integer , intent(in) :: ymd ! year, month, day YYYYMMDD - type(ESMF_Calendar) , intent(in) :: cal ! ESMF calendar - integer , intent(in), optional :: tod ! time of day in seconds - character(len=*) , intent(in), optional :: desc ! description of time to set - integer , intent(in), optional :: logunit - - ! local variables - integer :: yr, mon, day ! Year, month, day as integers - integer :: ltod ! local tod - character(len=256) :: ldesc ! local desc - integer :: rc ! return code - character(len=*), parameter :: subname = '(esm_time_m_ETimeInit) ' - !------------------------------------------------------------------------------- - - ltod = 0 - if (present(tod)) ltod = tod - ldesc = '' - if (present(desc)) ldesc = desc - - if ( (ymd < 0) .or. (ltod < 0) .or. (ltod > SecPerDay) )then - if (present(logunit)) then - write(logunit,*) subname//': ERROR yymmdd is a negative number or '// & - 'time-of-day out of bounds', ymd, ltod - end if - call ESMF_LogWrite( subname//'ERROR: Bad input' , ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - end if - - call esm_time_date2ymd (ymd,yr,mon,day) - - call ESMF_TimeSet( Time, yy=yr, mm=mon, dd=day, s=ltod, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + end subroutine esm_time_clockinit - end subroutine esm_time_timeInit -#endif !=============================================================================== subroutine esm_time_date2ymd (date, year, month, day) diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 deleted file mode 100644 index 9062b27f1..000000000 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ /dev/null @@ -1,859 +0,0 @@ -module nuopc_shr_methods - - use ESMF , only : operator(<), operator(/=), operator(+) - use ESMF , only : operator(-), operator(*) , operator(>=) - use ESMF , only : operator(<=), operator(>), operator(==) - use ESMF , only : ESMF_LOGERR_PASSTHRU, ESMF_LogFoundError, ESMF_LOGMSG_ERROR, ESMF_MAXSTR - use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FAILURE - use ESMF , only : ESMF_State, ESMF_StateGet - use ESMF , only : ESMF_Field, ESMF_FieldGet - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_GridCompSet - use ESMF , only : ESMF_GeomType_Flag, ESMF_FieldStatus_Flag - use ESMF , only : ESMF_Mesh, ESMF_MeshGet - use ESMF , only : ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID, ESMF_FIELDSTATUS_COMPLETE - use ESMF , only : ESMF_Clock, ESMF_ClockCreate, ESMF_ClockGet, ESMF_ClockSet - use ESMF , only : ESMF_ClockPrint, ESMF_ClockAdvance - use ESMF , only : ESMF_Alarm, ESMF_AlarmCreate, ESMF_AlarmGet, ESMF_AlarmSet - use ESMF , only : ESMF_Calendar, ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN - use ESMF , only : ESMF_Time, ESMF_TimeGet, ESMF_TimeSet - use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet, ESMF_TimeIntervalGet - use ESMF , only : ESMF_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 shr_log_mod , only : shr_log_setLogUnit - - implicit none - private - - public :: memcheck - public :: get_component_instance - public :: set_component_logging - public :: log_clock_advance - public :: state_getscalar - public :: state_setscalar - public :: state_diagnose - public :: alarmInit - public :: chkerr - - private :: timeInit - private :: field_getfldptr - - ! Clock and alarm options - character(len=*), private, parameter :: & - optNONE = "none" , & - optNever = "never" , & - optNSteps = "nsteps" , & - optNStep = "nstep" , & - optNSeconds = "nseconds" , & - optNSecond = "nsecond" , & - optNMinutes = "nminutes" , & - optNMinute = "nminute" , & - optNHours = "nhours" , & - optNHour = "nhour" , & - optNDays = "ndays" , & - optNDay = "nday" , & - optNMonths = "nmonths" , & - optNMonth = "nmonth" , & - optNYears = "nyears" , & - optNYear = "nyear" , & - optMonthly = "monthly" , & - optYearly = "yearly" , & - optEnd = "end" , & - optDate = "date" - - - ! Module data - integer, parameter :: SecPerDay = 86400 ! Seconds per day - integer, parameter :: memdebug_level=1 - character(len=1024) :: msgString - character(len=*), parameter :: u_FILE_u = & - __FILE__ - -!=============================================================================== -contains -!=============================================================================== - - subroutine memcheck(string, level, maintask) - - ! input/output variables - character(len=*) , intent(in) :: string - integer , intent(in) :: level - logical , intent(in) :: maintask - - ! local variables - integer :: ierr -#ifdef CESMCOUPLED - integer, external :: GPTLprint_memusage -#endif - !----------------------------------------------------------------------- - -#ifdef CESMCOUPLED - if ((maintask .and. memdebug_level > level) .or. memdebug_level > level+1) then - ierr = GPTLprint_memusage(string) - endif -#endif - - end subroutine memcheck - -!=============================================================================== - - subroutine get_component_instance(gcomp, inst_suffix, inst_index, rc) - - ! input/output variables - type(ESMF_GridComp) :: gcomp - character(len=*) , intent(out) :: inst_suffix - integer , intent(out) :: inst_index - integer , intent(out) :: rc - - ! local variables - logical :: isPresent - character(len=4) :: cvalue - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", isPresent=isPresent, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (isPresent) then - call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", value=inst_suffix, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - cvalue = inst_suffix(2:) - read(cvalue, *) inst_index - else - inst_suffix = "" - inst_index=1 - endif - - end subroutine get_component_instance - -!=============================================================================== - subroutine set_component_logging(gcomp, maintask, logunit, shrlogunit, rc) - use NUOPC, only: NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd - ! input/output variables - type(ESMF_GridComp) :: gcomp - logical, intent(in) :: maintask - integer, intent(out) :: logunit - integer, intent(out) :: shrlogunit - integer, intent(out) :: rc - - ! local variables - character(len=CL) :: diro - character(len=CL) :: logfile - character(len=CL) :: inst_suffix - integer :: inst_index ! Not used here - integer :: n - character(len=CL) :: name - character(len=*), parameter :: subname = "("//__FILE__//": set_component_logging)" - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - if (maintask) 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 - call get_component_instance(gcomp, inst_suffix, inst_index, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Multiinstance logfile name needs a correction - if(len_trim(inst_suffix) > 0) then - n = index(logfile, '.') - logfile = logfile(1:n-1)//trim(inst_suffix)//logfile(n:) - endif - - open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) - - else - logUnit = 6 - endif - - call ESMF_GridCompGet(gcomp, name=name, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(trim(subname)//": setting logunit for component: "//trim(name), ESMF_LOGMSG_INFO) - call NUOPC_CompAttributeAdd(gcomp, (/"logunit"/), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, "logunit", logunit, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_log_setLogUnit (logunit) - ! Still need to set this return value - shrlogunit = logunit - call ESMF_LogWrite(trim(subname)//": done for component "//trim(name), ESMF_LOGMSG_INFO) - end subroutine set_component_logging - -!=============================================================================== - - subroutine log_clock_advance(clock, component, logunit, rc) - - ! input/output variables - type(ESMF_Clock) :: clock - character(len=*) , intent(in) :: component - integer , intent(in) :: logunit - integer , intent(out) :: rc - - ! local variables - character(len=CL) :: cvalue, prestring - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - write(prestring, *) "------>Advancing ",trim(component)," from: " - call ESMF_ClockPrint(clock, options="currTime", unit=cvalue, preString=trim(prestring), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - write(logunit, *) trim(cvalue) - - call ESMF_ClockPrint(clock, options="stopTime", unit=cvalue, & - preString="--------------------------------> to: ", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - write(logunit, *) trim(cvalue) - - end subroutine log_clock_advance - -!=============================================================================== - - subroutine state_getscalar(state, scalar_id, scalar_value, flds_scalar_name, flds_scalar_num, rc) - - ! ---------------------------------------------- - ! Get scalar data from State for a particular name and broadcast it to all other pets - ! ---------------------------------------------- - - ! input/output variables - type(ESMF_State), intent(in) :: state - integer, intent(in) :: scalar_id - real(r8), intent(out) :: scalar_value - character(len=*), intent(in) :: flds_scalar_name - integer, intent(in) :: flds_scalar_num - integer, intent(inout) :: rc - - ! local variables - integer :: mytask, ierr, len - type(ESMF_VM) :: vm - type(ESMF_Field) :: field - real(r8), pointer :: farrayptr(:,:) - real(r8) :: tmp(1) - character(len=*), parameter :: subname='(state_getscalar)' - ! ---------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_VMGetCurrent(vm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm, localPet=mytask, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=field, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (mytask == 0) then - call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (scalar_id < 0 .or. scalar_id > flds_scalar_num) then - call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - endif - tmp(:) = farrayptr(scalar_id,:) - endif - call ESMF_VMBroadCast(vm, tmp, 1, 0, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - scalar_value = tmp(1) - - end subroutine state_getscalar - -!================================================================================ - - subroutine state_setscalar(scalar_value, scalar_id, State, flds_scalar_name, flds_scalar_num, rc) - - ! ---------------------------------------------- - ! Set scalar data from State for a particular name - ! ---------------------------------------------- - - ! input/output arguments - real(r8), intent(in) :: scalar_value - integer, intent(in) :: scalar_id - type(ESMF_State), intent(inout) :: State - character(len=*), intent(in) :: flds_scalar_name - integer, intent(in) :: flds_scalar_num - integer, intent(inout) :: rc - - ! local variables - integer :: mytask - type(ESMF_Field) :: lfield - type(ESMF_VM) :: vm - real(r8), pointer :: farrayptr(:,:) - character(len=*), parameter :: subname='(state_setscalar)' - ! ---------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_VMGetCurrent(vm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm, localPet=mytask, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (mytask == 0) then - call ESMF_FieldGet(lfield, farrayPtr = farrayptr, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (scalar_id < 0 .or. scalar_id > flds_scalar_num) then - call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - endif - farrayptr(scalar_id,1) = scalar_value - endif - - end subroutine state_setscalar - -!=============================================================================== - - subroutine state_diagnose(State, string, rc) - - ! ---------------------------------------------- - ! Diagnose status of State - ! ---------------------------------------------- - - type(ESMF_State), intent(in) :: state - character(len=*), intent(in) :: string - integer , intent(out) :: rc - - ! local variables - integer :: i,j,n - type(ESMf_Field) :: lfield - integer :: fieldCount, lrank - character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) - real(r8), pointer :: dataPtr1d(:) - real(r8), pointer :: dataPtr2d(:,:) - character(len=*),parameter :: subname='(state_diagnose)' - ! ---------------------------------------------- - - call ESMF_StateGet(state, itemCount=fieldCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(lfieldnamelist(fieldCount)) - - call ESMF_StateGet(state, itemNameList=lfieldnamelist, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - do n = 1, fieldCount - - call ESMF_StateGet(state, itemName=lfieldnamelist(n), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call field_getfldptr(lfield, fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (lrank == 0) then - ! no local data - elseif (lrank == 1) then - if (size(dataPtr1d) > 0) then - write(msgString,'(A,a)') trim(string)//': for 1d field '//trim(lfieldnamelist(n)) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - write(msgString,'(A,3g14.7,i8)') trim(string)//': 1d field '//trim(lfieldnamelist(n)), & - minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - else - write(msgString,'(A,a)') trim(string)//': '//trim(lfieldnamelist(n))," no data" - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - endif - elseif (lrank == 2) then - if (size(dataPtr2d) > 0) then - write(msgString,'(A,a)') trim(string)//': for 2d field '//trim(lfieldnamelist(n)) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - write(msgString,'(A,3g14.7,i8)') trim(string)//': 2d field '//trim(lfieldnamelist(n)), & - minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - else - write(msgString,'(A,a)') trim(string)//': '//trim(lfieldnamelist(n))," no data" - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - endif - else - call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - endif - enddo - - deallocate(lfieldnamelist) - - end subroutine state_diagnose - -!=============================================================================== - - subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) - - ! ---------------------------------------------- - ! for a field, determine rank and return fldptr1 or fldptr2 - ! abort is true by default and will abort if fldptr is not yet allocated in field - ! rank returns 0, 1, or 2. 0 means fldptr not allocated and abort=false - ! ---------------------------------------------- - - ! input/output variables - type(ESMF_Field) , intent(in) :: field - real(r8), pointer , intent(inout), optional :: fldptr1(:) - real(r8), pointer , intent(inout), optional :: fldptr2(:,:) - integer , intent(out) , optional :: rank - logical , intent(in) , optional :: abort - integer , intent(out) , optional :: rc - - ! local variables - type(ESMF_GeomType_Flag) :: geomtype - type(ESMF_FieldStatus_Flag) :: status - type(ESMF_Mesh) :: lmesh - integer :: lrank, nnodes, nelements - logical :: labort - character(len=*), parameter :: subname='(field_getfldptr)' - ! ---------------------------------------------- - - if (.not.present(rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR rc not present ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return - endif - - rc = ESMF_SUCCESS - - labort = .true. - if (present(abort)) then - labort = abort - endif - lrank = -99 - - call ESMF_FieldGet(field, status=status, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (status /= ESMF_FIELDSTATUS_COMPLETE) then - lrank = 0 - if (labort) then - call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_FAILURE - return - else - call ESMF_LogWrite(trim(subname)//": WARNING data not allocated ", ESMF_LOGMSG_INFO, rc=rc) - endif - else - - call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (geomtype == ESMF_GEOMTYPE_GRID) then - call ESMF_FieldGet(field, rank=lrank, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - elseif (geomtype == ESMF_GEOMTYPE_MESH) then - call ESMF_FieldGet(field, rank=lrank, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, mesh=lmesh, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (nnodes == 0 .and. nelements == 0) lrank = 0 - else - call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", & - ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_FAILURE - return - endif ! geomtype - - if (lrank == 0) then - call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", & - ESMF_LOGMSG_INFO) - elseif (lrank == 1) then - if (.not.present(fldptr1)) then - call ESMF_LogWrite(trim(subname)//": ERROR missing rank=1 array ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return - endif - call ESMF_FieldGet(field, farrayPtr=fldptr1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - elseif (lrank == 2) then - if (.not.present(fldptr2)) then - call ESMF_LogWrite(trim(subname)//": ERROR missing rank=2 array ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return - endif - call ESMF_FieldGet(field, farrayPtr=fldptr2, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - call ESMF_LogWrite(trim(subname)//": ERROR in rank ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return - endif - - endif ! status - - if (present(rank)) then - rank = lrank - endif - - end subroutine field_getfldptr - -!=============================================================================== - - subroutine alarmInit( clock, alarm, option, & - opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) - - ! Setup an alarm in a clock - ! Notes: The ringtime sent to AlarmCreate MUST be the next alarm - ! time. If you send an arbitrary but proper ringtime from the - ! past and the ring interval, the alarm will always go off on the - ! next clock advance and this will cause serious problems. Even - ! if it makes sense to initialize an alarm with some reference - ! time and the alarm interval, that reference time has to be - ! advance forward to be >= the current time. In the logic below - ! we set an appropriate "NextAlarm" and then we make sure to - ! advance it properly based on the ring interval. - - ! input/output variables - type(ESMF_Clock) , intent(inout) :: clock ! clock - type(ESMF_Alarm) , intent(inout) :: alarm ! alarm - character(len=*) , intent(in) :: option ! alarm option - integer , optional , intent(in) :: opt_n ! alarm freq - integer , optional , intent(in) :: opt_ymd ! alarm ymd - integer , optional , intent(in) :: opt_tod ! alarm tod (sec) - type(ESMF_Time) , optional , intent(in) :: RefTime ! ref time - character(len=*) , optional , intent(in) :: alarmname ! alarm name - integer , intent(inout) :: rc ! Return code - - ! local variables - type(ESMF_Calendar) :: cal ! calendar - integer :: lymd ! local ymd - integer :: ltod ! local tod - integer :: cyy,cmm,cdd,csec ! time info - character(len=64) :: lalarmname ! local alarm name - logical :: update_nextalarm ! update next alarm - type(ESMF_Time) :: CurrTime ! Current Time - type(ESMF_Time) :: NextAlarm ! Next restart alarm time - type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval - integer :: sec - character(len=*), parameter :: subname = '(set_alarmInit): ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - lalarmname = 'alarm_unknown' - if (present(alarmname)) lalarmname = trim(alarmname) - ltod = 0 - if (present(opt_tod)) ltod = opt_tod - lymd = -1 - if (present(opt_ymd)) lymd = opt_ymd - - call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! initial guess of next alarm, this will be updated below - if (present(RefTime)) then - NextAlarm = RefTime - else - NextAlarm = CurrTime - endif - - ! Determine calendar - call ESMF_ClockGet(clock, calendar=cal) - - ! Determine inputs for call to create alarm - selectcase (trim(option)) - - case (optNONE) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optNever) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optEnd) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optDate) - if (.not. present(opt_ymd)) then - call shr_sys_abort(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') - end if - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call timeInit(NextAlarm, lymd, cal, ltod, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optNSteps) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - 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') - call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNSeconds) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNSecond) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - 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') - end if - if (opt_n <= 0) then - call shr_sys_abort(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') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNHours) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNHour) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNDays) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNDay) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMonths) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMonth) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optMonthly) - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .true. - - case (optNYears) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNYear) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optYearly) - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .true. - - case default - call shr_sys_abort(subname//'unknown option '//trim(option)) - - end select - - ! -------------------------------------------------------------------------------- - ! --- AlarmInterval and NextAlarm should be set --- - ! -------------------------------------------------------------------------------- - - ! --- advance Next Alarm so it won't ring on first timestep for - ! --- most options above. go back one alarminterval just to be careful - - if (update_nextalarm) then - NextAlarm = NextAlarm - AlarmInterval - do while (NextAlarm <= CurrTime) - NextAlarm = NextAlarm + AlarmInterval - enddo - endif - alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, & - ringInterval=AlarmInterval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - end subroutine alarmInit - -!=============================================================================== - - subroutine timeInit( Time, ymd, cal, tod, rc) - - ! Create the ESMF_Time object corresponding to the given input time, - ! given in YMD (Year Month Day) and TOD (Time-of-day) format. - ! Set the time by an integer as YYYYMMDD and integer seconds in the day - - ! input/output parameters: - type(ESMF_Time) , intent(inout) :: Time ! ESMF time - integer , intent(in) :: ymd ! year, month, day YYYYMMDD - type(ESMF_Calendar) , intent(in) :: cal ! ESMF calendar - integer , intent(in) :: tod ! time of day in seconds - integer , intent(out) :: rc - - ! local variables - integer :: year, mon, day ! year, month, day as integers - integer :: tdate ! temporary date - character(len=*), parameter :: subname='(timeInit)' - !------------------------------------------------------------------------------- - - 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' ) - end if - - tdate = abs(ymd) - year = int(tdate/10000) - if (ymd < 0) year = -year - mon = int( mod(tdate,10000)/ 100) - day = mod(tdate, 100) - - call ESMF_TimeSet( Time, yy=year, mm=mon, dd=day, s=tod, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - end subroutine timeInit - -!=============================================================================== - - logical function chkerr(rc, line, file) - - integer, intent(in) :: rc - integer, intent(in) :: line - character(len=*), intent(in) :: file - - integer :: lrc - - chkerr = .false. - lrc = rc - if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then - chkerr = .true. - endif - end function chkerr - -end module nuopc_shr_methods diff --git a/cime_config/buildnml b/cime_config/buildnml index bc8585d8c..40b726e09 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -43,6 +43,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config["MACH"] = case.get_value("MACH") config["MPILIB"] = case.get_value("MPILIB") config["OS"] = case.get_value("OS") + config["TESTCASE"] = case.get_value("TESTCASE") config["glc_nec"] = ( 0 if case.get_value("GLC_NEC") == 0 else case.get_value("GLC_NEC") ) @@ -50,9 +51,13 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config["continue_run"] = ".true." if case.get_value("CONTINUE_RUN") else ".false." config["flux_epbal"] = "ocn" if case.get_value("CPL_EPBAL") == "ocn" else "off" config["mask_grid"] = case.get_value("MASK_GRID") - config["rest_option"] = case.get_value("REST_OPTION") + for val in ("HIST", "REST", "STOP"): + config[val.lower()+"_option"] = case.get_value(val+"_OPTION") + + config["comp_ocn"] = case.get_value("COMP_OCN") + atm_grid = case.get_value("ATM_GRID") lnd_grid = case.get_value("LND_GRID") ice_grid = case.get_value("ICE_GRID") @@ -72,6 +77,8 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): atm_mesh = case.get_value("ATM_DOMAIN_MESH") lnd_mesh = case.get_value("LND_DOMAIN_MESH") rof_mesh = case.get_value("ROF_DOMAIN_MESH") + ocn_mesh = case.get_value("OCN_DOMAIN_MESH") + wav_mesh = case.get_value("WAV_DOMAIN_MESH") config["samegrid_atm_lnd"] = ( "true" if atm_mesh == case.get_value("LND_DOMAIN_MESH") else "false" ) @@ -85,6 +92,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): "true" if atm_mesh == case.get_value("WAV_DOMAIN_MESH") else "false" ) config["samegrid_lnd_rof"] = "true" if lnd_mesh == rof_mesh else "false" + config["samegrid_wav_ocn"] = "true" if ocn_mesh == wav_mesh else "false" # determine if need to set atm_domainfile scol_lon = float(case.get_value("PTS_LON")) @@ -98,7 +106,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): else: config["single_column"] = "false" - # needed for determining the run sequence as well as glc_renormalize_smb + # needed for determining the run sequence config["COMP_ATM"] = case.get_value("COMP_ATM") config["COMP_ICE"] = case.get_value("COMP_ICE") config["COMP_GLC"] = case.get_value("COMP_GLC") @@ -107,7 +115,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config["COMP_ROF"] = case.get_value("COMP_ROF") config["COMP_WAV"] = case.get_value("COMP_WAV") config["CAMDEV"] = "True" if "CAM70" in case.get_value("COMPSET") else "False" - + if ( ( case.get_value("COMP_ROF") == "mosart" @@ -129,6 +137,12 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config['wav_ice_coupling'] = 'ww3' in config['COMP_WAV'] and config['COMP_ICE'] == 'cice' + if config["COMP_OCN"] == "blom": + if "ecosys" in case.get_value("BLOM_TRACER_MODULES"): + config["dms_from_ocn"] = "on" + else: + config["dms_from_ocn"] = "off" + # ---------------------------------------------------- # Initialize namelist defaults # ---------------------------------------------------- @@ -150,7 +164,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): add_gusts = literal_to_python_value(nmlgen.get_value("add_gusts"), type_="logical") if add_gusts: expect("CAM70" in case.get_value("COMPSET"),"ERROR: add_gusts can only be set if CAM70 in compset {}".format(case.get_value("COMPSET"))) - + # -------------------------------- # Overwrite: set component coupling frequencies # -------------------------------- @@ -199,6 +213,19 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): coupling_times[comp.lower() + "_cpl_dt"] = cpl_dt mindt = min(mindt, cpl_dt) + # Here we convert "nsteps" to "nseconds", this simplifies the fortran + + for val in ("REST", "HIST", "STOP"): + if case.get_value(val+"_OPTION") == "nsteps": + nsteps = case.get_value(val+"_N") + if val == "REST": + nmlgen.set_value("restart_n", value=mindt*nsteps) + elif val == "HIST": + nmlgen.set_value("history_n", value=mindt*nsteps) + else: + nmlgen.set_value("stop_n", value=mindt*nsteps) + + # sanity check comp_atm = case.get_value("COMP_ATM") if comp_atm is not None and comp_atm not in ("datm", "xatm", "satm"): @@ -305,7 +332,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): for item in case.get_values("COMP_CLASSES"): comp = case.get_value("COMP_" + item) - if case.get_value(f"PIO_ASYNC_INTERFACE", {"compclass":item}): + if case.get_value("PIO_ASYNC_INTERFACE", {"compclass":item}): asyncio = True valid = True @@ -366,8 +393,6 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): nmlgen.set_value( "component_list", value=valid_comps_string.replace("CPL", "MED") ) - # the driver restart pointer will look like a mediator is present even if it is not - nmlgen.set_value("drv_restart_pointer", value="rpointer.cpl") logger.info("Writing nuopc_runconfig for components {}".format(valid_comps)) nuopc_config_file = os.path.join(confdir, "nuopc.runconfig") @@ -608,8 +633,6 @@ def buildnml(case, caseroot, component): if component != "drv": raise AttributeError - # Do a check here of ESMF VERSION, requires 8.1.0 or newer (8.2.0 or newer for esmf_aware_threading) - esmf_aware_threading = case.get_value("ESMF_AWARE_THREADING") esmfmkfile = os.getenv("ESMFMKFILE") expect( esmfmkfile and os.path.isfile(esmfmkfile), @@ -665,7 +688,7 @@ def buildnml(case, caseroot, component): create_namelist_infile(case, user_nl_file, namelist_infile, infile_text) infile = [namelist_infile] - + # create the files nuopc.runconfig, nuopc.runseq, drv_in and drv_flds_in _create_drv_namelists(case, infile, confdir, nmlgen, files) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 33add8b2b..8d5cb5dda 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -334,7 +334,7 @@ run_begin_stop_restart env_run.xml - Run start time-of-day + Run start time-of-day, units are seconds with values from 0 to 86400. @@ -402,6 +402,17 @@ + + char + rpointer.cpl + run_begin_stop_restart + env_run.xml + + Name of the restart pointer file, this can be used to restart from an + intermediate restart by appending the restart date and time in format YYYY-MM-DD-SSSSS + + + char none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears @@ -795,20 +806,38 @@ char - - + none,a100 + none build_def env_build.xml If set will compile and submit with this gpu type enabled - - char - - + + logical + TRUE,FALSE + FALSE + build_def + env_build.xml + True=>compile the GPU code with OpenACC GPU flags + + + + logical + TRUE,FALSE + FALSE + build_def + env_build.xml + True=>compile the GPU code with OpenMP GPU flags + + + + logical + TRUE,FALSE + FALSE build_def env_build.xml - If set will compile and submit with this gpu offload method enabled + True=>compile the GPU code with KOKKOS GPU target @@ -818,7 +847,7 @@ build_def env_build.xml If set will attach this script to the MPI run command, mapping - different MPI ranks to different GPUs within the same compute node + different MPI ranks to different GPUs within the same compute node @@ -1405,6 +1434,24 @@ rof2ocn runoff mapping file + + char + idmap + run_domain + env_run.xml + ocn2wav state mapping file + + + + char + + unset + + run_domain + env_run.xml + wav2ocn state mapping file + + char 1.0e-02 @@ -1753,36 +1800,55 @@ pes or cores per node for accounting purposes + + integer + 0 + mach_pes_last + env_mach_pes.xml + minimum memory request per node (currently only used on derecho) + + + + integer + 0 + mach_pes_last + env_mach_pes.xml + maximum memory request per node (currently only used on derecho) + + integer 0 - - 1 - mach_pes_last env_mach_pes.xml - Number of CPU cores per GPU node used for simulation + Number of CPU cores per GPU node used for simulation + + + + logical + TRUE,FALSE + FALSE + mach_pes + env_mach_pes.xml + False=>assign only one MPI task per GPU; True=>assign multiple MPI tasks per GPU integer 0 - - 1 - mach_pes env_mach_pes.xml - Number of GPUs per node used for simulation + Number of GPUs per node used for simulation - + integer 0 mach_pes_last env_mach_pes.xml - maximum number of GPUs allowed per node + Maximum number of GPUs allowed per node - + integer $MAX_MPITASKS_PER_NODE @@ -1986,15 +2052,15 @@ https://www.unidata.ucar.edu/software/netcdf/docs/data_type.html - 64bit_offset - 64bit_offset - 64bit_offset - 64bit_offset - 64bit_offset - 64bit_offset - 64bit_offset - 64bit_offset - 64bit_offset + 64bit_data + 64bit_data + 64bit_data + 64bit_data + 64bit_data + 64bit_data + 64bit_data + 64bit_data + 64bit_data @@ -2412,6 +2478,19 @@ + + + + + + char + + case_git + env_build.xml + Remote git repository used for this case + + + diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index 4dd12e1e4..b801f156e 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -109,8 +109,8 @@ none CO2A CO2A - CO2A - CO2A + CO2A + CO2A CO2A CO2A CO2C @@ -236,15 +236,12 @@ - 24 24 24 - 24 - 144 24 24 24 @@ -330,11 +327,6 @@ 24 24 - 1 - 24 - 24 - 48 - 48 1 24 @@ -386,7 +378,6 @@ integer 8 - 1 $ATM_NCPL $ATM_NCPL $ATM_NCPL @@ -475,11 +466,8 @@ TIGHT OPTION2 - OPTION2 OPTION1 OPTION1 - OPTION1 - OPTION1 OPTION2 OPTION2 OPTION2 @@ -537,10 +525,10 @@ FALSE TRUE - TRUE + TRUE TRUE TRUE - TRUE + TRUE TRUE TRUE @@ -555,8 +543,7 @@ 284.7 367.0 - 284.317 - 284.7 + 284.317 run_co2 env_run.xml diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 222a15b26..8835c53b8 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -162,7 +162,7 @@ - + char expdef DRIVER_attributes @@ -170,7 +170,7 @@ Driver restart pointer file to initialize time info - rpointer.cpl + $DRV_RESTART_POINTER @@ -233,20 +233,6 @@ - - - - - - logical - nuopc - ALLCOMP_attributes - - .false. - .true. - - - char nuopc @@ -256,6 +242,10 @@ + + + + char orbital @@ -843,32 +833,26 @@ char control MED_attributes - on,off,on_if_glc_coupled_fluxes + on,off Whether to renormalize the surface mass balance (smb) sent from lnd to glc so that the global integral on the glc grid agrees with the global integral on the lnd grid. - Unlike most fluxes, smb is remapped with bilinear rather than conservative mapping weights, - so this option is needed for conservation. However, conservation is not required in many - cases, since we often run glc as a diagnostic (one-way-coupled) component. + Unlike most fluxes, smb is remapped with bilinear rather than conservative mapping + weights, so this option is needed for conservation. However, this can be turned off + in non-fully-coupled configurations where conservation isn't important (e.g., + glc-only configurations - T compsets) to avoid the global correction that comes with + this renormalization. Allowable values are: - 'on': always do this renormalization - 'off': never do this renormalization (see WARNING below) - 'on_if_glc_coupled_fluxes': Determine at runtime whether to do this renormalization. - Does the renormalization if we're running a two-way-coupled glc that sends fluxes - to other components (which is the case where we need conservation). - Does NOT do the renormalization if we're running a one-way-coupled glc, or if - we're running a glc-only compset (T compsets). - (In these cases, conservation is not important.) + 'on': do this renormalization + 'off': do not do this renormalization; note that this will break conservation so + typically should not be used in fully-coupled cases - Only used if running with a prognostic GLC component. - - WARNING: Setting this to 'off' will break conservation when running with an - evolving, two-way-coupled glc. + Only used if running with a GLC component. - on_if_glc_coupled_fluxes + on off @@ -893,7 +877,7 @@ .false. - + integer @@ -929,7 +913,10 @@ default: ogrid - ogrid + xgrid + + ogrid @@ -1123,13 +1110,12 @@ char time ALLCOMP_attributes - none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end + none,never,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator history snapshot option (used with history_n and history_ymd) set by HIST_OPTION in env_run.xml. history_option alarms are: [none/never], turns option off - [nsteps] , history snapshot every history_n nsteps , relative to current run start time [nseconds] , history snapshot every history_n nseconds, relative to current run start time [nminutes] , history snapshot every history_n nminutes, relative to current run start time [nhours] , history snapshot every history_n nhours , relative to current run start time @@ -1142,6 +1128,7 @@ $HIST_OPTION + nseconds @@ -2303,6 +2290,34 @@ + + char + mapping + abs + MED_attributes + + ocn to wav state mapping file for states + + + idmap + $OCN2WAV_SMAPNAME + + + + + char + mapping + abs + MED_attributes + + wav to ocn state mapping file for states + + + idmap + $WAV2OCN_SMAPNAME + + + @@ -2426,7 +2441,7 @@ - + logical flds ALLCOMP_attributes @@ -2435,10 +2450,11 @@ .false. + .true. - + logical flds ALLCOMP_attributes @@ -2726,12 +2742,11 @@ char time CLOCK_attributes - none,never,nsteps,nseconds,nminutes,nhours,ndays,monthly,nmonths,nyears,date,end + none,never,nseconds,nminutes,nhours,ndays,monthly,nmonths,nyears,date,end sets the run length with stop_n and stop_ymd stop_option alarms are: [none/never] , turns option off - [nsteps] , stops every stop_n nsteps , relative to current run start time [nseconds] , stops every stop_n nseconds, relative to current run start time [nminutes] , stops every stop_n nminutes, relative to current run start time [nhours] , stops every stop_n nhours , relative to current run start time @@ -2745,6 +2760,7 @@ $STOP_OPTION + nseconds @@ -2790,12 +2806,11 @@ char time CLOCK_attributes - none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end + none,never,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end sets the restart frequency with restart_n and restart_ymd restart_option alarms are: [none/never], turns option off - [nsteps] , restarts every restart_n nsteps , relative to current run start time [nseconds] , restarts every restart_n nseconds, relative to current run start time [nminutes] , restarts every restart_n nminutes, relative to current run start time [nhours] , restarts every restart_n nhours , relative to current run start time @@ -2809,6 +2824,7 @@ $REST_OPTION + nseconds @@ -2837,7 +2853,7 @@ - + logical time CLOCK_attributes @@ -2846,10 +2862,15 @@ forces a restart write at the end of the run in addition to any setting associated with rest_option. default=true. this setting will be set to false if restart_option is none or never. - default: false + default: true - .false. + .true. + .false. + .false. + .false. + .false. + .false. diff --git a/cime_config/runseq/driver_config.py b/cime_config/runseq/driver_config.py index 7b8756e10..dfdadc75f 100644 --- a/cime_config/runseq/driver_config.py +++ b/cime_config/runseq/driver_config.py @@ -64,7 +64,7 @@ def __compute_glc(self, case, coupling_times): # However will still need to call the exchange at the end if the stop_option # is nsteps or days - or otherwise just every ndays # Note that nsteps is the minimum component coupling time - if (comp_glc == 'cism'): + if comp_glc == 'cism': glc_coupling_time = coupling_times["glc_cpl_dt"] if not case.get_value("CISM_EVOLVE"): stop_option = case.get_value('STOP_OPTION') @@ -77,13 +77,7 @@ def __compute_glc(self, case, coupling_times): glc_coupling_time = stop_n * 86400 else: glc_coupling_time = 86400 - elif (comp_glc == 'dglc'): - glc_coupling_time = coupling_times["glc_cpl_dt"] - stop_option = case.get_value('STOP_OPTION') - stop_n = case.get_value('STOP_N') - if stop_option == 'nsteps': - glc_coupling_time = stop_n*coupling_times["atm_cpl_dt"] - elif (comp_glc == 'xglc'): + elif comp_glc == 'dglc' or comp_glc == 'xglc': glc_coupling_time = coupling_times["glc_cpl_dt"] else: glc_coupling_time = 0 diff --git a/cime_config/testdefs/testlist_drv.xml b/cime_config/testdefs/testlist_drv.xml index e17b2ffcf..948bd267b 100644 --- a/cime_config/testdefs/testlist_drv.xml +++ b/cime_config/testdefs/testlist_drv.xml @@ -65,6 +65,16 @@ + + + + + + + + + + diff --git a/cime_config/testdefs/testmods_dirs/drv/aoflux_ogrid/user_nl_cpl b/cime_config/testdefs/testmods_dirs/drv/aoflux_ogrid/user_nl_cpl new file mode 100644 index 000000000..91228d3fe --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/drv/aoflux_ogrid/user_nl_cpl @@ -0,0 +1 @@ +aoflux_grid = "ogrid" diff --git a/doc/source/addendum/req_attributes_cesm.rst b/doc/source/addendum/req_attributes_cesm.rst index c8d6ff7fa..475b845f7 100644 --- a/doc/source/addendum/req_attributes_cesm.rst +++ b/doc/source/addendum/req_attributes_cesm.rst @@ -101,24 +101,19 @@ Mediator land-ice component attribtes Whether to renormalize the surface mass balance (smb) sent from lnd to glc so that the global integral on the glc grid agrees with the global integral on the lnd grid. - Unlike most fluxes, smb is remapped with bilinear rather than conservative mapping weights, - so this option is needed for conservation. However, conservation is not required in many - cases, since we often run glc as a diagnostic (one-way-coupled) component. + Unlike most fluxes, smb is remapped with bilinear rather than conservative mapping + weights, so this option is needed for conservation. However, this can be turned off in + non-fully-coupled configurations where conservation isn't important (e.g., glc-only + configurations - T compsets) to avoid the global correction that comes with this + renormalization. Allowable values are: - ``on``: always do this renormalization - - ``off``: never do this renormalization (see WARNING below) - - ``on_if_glc_coupled_fluxes``: Determine at runtime whether to do this renormalization. - Does the renormalization if we're running a two-way-coupled glc that sends fluxes - to other components (which is the case where we need conservation). - Does NOT do the renormalization if we're running a one-way-coupled glc, or if - we're running a glc-only compset (T compsets). - (In these cases, conservation is not important.) - Only used if running with a prognostic GLC component. - WARNING: Setting this to 'off' will break conservation when running with an - evolving, two-way-coupled glc. + ``on``: do this renormalization + + ``off``: do not do this renormalization; note that this will break conservation so + typically should not be used in fully-coupled cases + + Only used if running with a GLC component. **glc_avg_period** Period at which coupler averages fields sent to GLC (the land-ice component). diff --git a/mediator/CMakeLists.txt b/mediator/CMakeLists.txt index 9630b5e23..80be3d2e8 100644 --- a/mediator/CMakeLists.txt +++ b/mediator/CMakeLists.txt @@ -4,7 +4,7 @@ set(SRCFILES esmFldsExchange_cesm_mod.F90 med_fraction_mod.F90 med_methods_mod.F90 med_phases_prep_ice_mod.F90 med_phases_restart_mod.F90 esmFldsExchange_hafs_mod.F90 med_internalstate_mod.F90 med_phases_aofluxes_mod.F90 - med_phases_prep_lnd_mod.F90 med_time_mod.F90 + med_phases_prep_lnd_mod.F90 esmFldsExchange_ufs_mod.F90 med_io_mod.F90 med_phases_history_mod.F90 med_phases_prep_ocn_mod.F90 med_utils_mod.F90 esmFlds.F90 med_kind_mod.F90 diff --git a/mediator/Makefile b/mediator/Makefile index 990fe58eb..a353ff9a5 100644 --- a/mediator/Makefile +++ b/mediator/Makefile @@ -39,7 +39,7 @@ esmFldsExchange_hafs_mod.o : med_kind_mod.o med_methods_mod.o esmFlds.o med_inte med.o : med_kind_mod.o med_phases_profile_mod.o med_utils_mod.o med_phases_prep_rof_mod.o med_phases_aofluxes_mod.o \ med_phases_prep_ice_mod.o med_fraction_mod.o med_map_mod.o med_constants_mod.o med_phases_prep_wav_mod.o \ med_phases_prep_lnd_mod.o med_phases_history_mod.o med_phases_ocnalb_mod.o med_phases_restart_mod.o \ - med_time_mod.o med_internalstate_mod.o med_phases_prep_atm_mod.o esmFldsExchange_cesm_mod.o esmFldsExchange_ufs_mod.o \ + med_internalstate_mod.o med_phases_prep_atm_mod.o esmFldsExchange_cesm_mod.o esmFldsExchange_ufs_mod.o \ esmFldsExchange_hafs_mod.o med_phases_prep_glc_mod.o esmFlds.o med_io_mod.o med_methods_mod.o med_phases_prep_ocn_mod.o \ med_phases_post_atm_mod.o med_phases_post_ice_mod.o med_phases_post_lnd_mod.o med_phases_post_glc_mod.o med_phases_post_rof_mod.o \ med_phases_post_wav_mod.o @@ -50,7 +50,7 @@ med_map_mod.o : med_kind_mod.o med_internalstate_mod.o med_constants_mod.o med_m med_merge_mod.o : med_kind_mod.o med_constants_mod.o med_internalstate_mod.o esmFlds.o med_methods_mod.o med_utils_mod.o med_methods_mod.o : med_kind_mod.o med_utils_mod.o med_constants_mod.o med_phases_aofluxes_mod.o : med_kind_mod.o med_utils_mod.o med_map_mod.o med_constants_mod.o med_internalstate_mod.o esmFlds.o med_methods_mod.o -med_phases_history_mod.o : med_kind_mod.o med_utils_mod.o med_time_mod.o med_internalstate_mod.o med_constants_mod.o med_map_mod.o med_methods_mod.o med_io_mod.o esmFlds.o +med_phases_history_mod.o : med_kind_mod.o med_utils_mod.o med_internalstate_mod.o med_constants_mod.o med_map_mod.o med_methods_mod.o med_io_mod.o esmFlds.o med_phases_ocnalb_mod.o : med_kind_mod.o med_utils_mod.o med_map_mod.o med_constants_mod.o med_internalstate_mod.o esmFlds.o med_methods_mod.o med_phases_prep_atm_mod.o : med_kind_mod.o esmFlds.o med_methods_mod.o med_merge_mod.o med_map_mod.o med_constants_mod.o med_phases_ocnalb_mod.o med_internalstate_mod.o med_utils_mod.o med_phases_prep_glc_mod.o : med_kind_mod.o med_utils_mod.o med_internalstate_mod.o med_map_mod.o med_constants_mod.o med_methods_mod.o esmFlds.o @@ -68,6 +68,5 @@ med_phases_post_rof_mod.o : med_kind_mod.o esmFlds.o med_methods_mod.o med_map_m med_phases_post_wav_mod.o : med_kind_mod.o esmFlds.o med_methods_mod.o med_map_mod.o med_constants_mod.o med_internalstate_mod.o med_utils_mod.o med_phases_profile_mod.o : med_kind_mod.o med_utils_mod.o med_constants_mod.o med_internalstate_mod.o med_time_mod.o med_phases_restart_mod.o : med_kind_mod.o med_utils_mod.o med_constants_mod.o med_internalstate_mod.o esmFlds.o med_io_mod.o -med_time_mod.o : med_kind_mod.o med_utils_mod.o med_constants_mod.o med_utils_mod.o : med_kind_mod.o -med_diag_mod.o : med_kind_mod.o med_time_mod.o med_utils_mod.o med_methods_mod.o med_internalstate_mod.o +med_diag_mod.o : med_kind_mod.o med_utils_mod.o med_methods_mod.o med_internalstate_mod.o diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index a521deaa1..b3b305668 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -75,6 +75,10 @@ module esmFldsExchange_cesm_mod character(len=CX) :: rof2lnd_map = 'unset' character(len=CX) :: lnd2rof_map = 'unset' + ! optional mapping files + character(len=CX) :: wav2ocn_map ='unset' + character(len=CX) :: ocn2wav_map = 'unset' + ! no mapping files (value is 'idmap' or 'unset') character(len=CX) :: atm2ice_map = 'unset' character(len=CX) :: atm2ocn_map = 'unset' @@ -84,9 +88,7 @@ module esmFldsExchange_cesm_mod character(len=CX) :: ice2wav_map = 'unset' character(len=CX) :: lnd2atm_map = 'unset' character(len=CX) :: ocn2atm_map = 'unset' - character(len=CX) :: ocn2wav_map = 'unset' character(len=CX) :: rof2ocn_map = 'unset' - character(len=CX) :: wav2ocn_map = 'unset' logical :: mapuv_with_cart3d ! Map U/V vector wind fields from ATM to OCN/ICE by rotating in Cartesian 3D space and then back logical :: flds_i2o_per_cat ! Ice thickness category fields passed to OCN @@ -95,6 +97,7 @@ module esmFldsExchange_cesm_mod logical :: flds_co2c ! Pass CO2 from ATM to surface (OCN/LND) and back from them to ATM logical :: flds_wiso ! Pass water isotop fields logical :: flds_r2l_stream_channel_depths ! Pass channel depths from ROF to LND + logical :: add_gusts ! Whether to include fields related to the gustiness parameterization character(*), parameter :: u_FILE_u = & __FILE__ @@ -202,6 +205,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (maintask) write(logunit, '(a)') trim(subname)//'rof2ocn_ice_rmapname = '// trim(rof2ocn_ice_rmap) + call NUOPC_CompAttributeGet(gcomp, name='wav2ocn_smapname', value=wav2ocn_map, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (maintask) write(logunit, '(a)') trim(subname)//'wav2ocn_smapname = '// trim(wav2ocn_map) + call NUOPC_CompAttributeGet(gcomp, name='ocn2wav_smapname', value=ocn2wav_map, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (maintask) write(logunit, '(a)') trim(subname)//'ocn2wav_smapname = '// trim(ocn2wav_map) + + ! uv cart3d mapping call NUOPC_CompAttributeGet(gcomp, name='mapuv_with_cart3d', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -232,6 +243,11 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_r2l_stream_channel_depths + ! are fields related to the gustiness parameterization enabled? + call NUOPC_CompAttributeGet(gcomp, name='add_gusts', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) add_gusts + ! write diagnostic output if (maintask) then write(logunit,'(a)' ) ' flds_co2a: prognostic and diagnostic CO2 at lowest atm level is sent to lnd and ocn' @@ -246,6 +262,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) write(logunit,'(a,l7)') trim(subname)//' flds_wiso = ',flds_wiso write(logunit,'(a,l7)') trim(subname)//' flds_i2o_per_cat = ',flds_i2o_per_cat write(logunit,'(a,l7)') trim(subname)//' flds_r2l_stream_channel_depths = ',flds_r2l_stream_channel_depths + write(logunit,'(a,l7)') trim(subname)//' add_gusts = ', add_gusts write(logunit,'(a,l7)') trim(subname)//' mapuv_with_cart3d = ',mapuv_with_cart3d end if @@ -1414,17 +1431,19 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to atm: unmerged ugust_out from ocn ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_aoflux('So_ugustOut') - call addfld_to(compatm, 'So_ugustOut') - else - if ( fldchk(is_local%wrap%FBexp(compatm), 'So_ugustOut', rc=rc)) then - if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_ugustOut', rc=rc)) then - if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap_aoflux('So_ugustOut', compatm, mapconsf, 'ofrac', ocn2atm_map) + if (add_gusts) then + if (phase == 'advertise') then + call addfld_aoflux('So_ugustOut') + call addfld_to(compatm, 'So_ugustOut') + else + if ( fldchk(is_local%wrap%FBexp(compatm), 'So_ugustOut', rc=rc)) then + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_ugustOut', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap_aoflux('So_ugustOut', compatm, mapconsf, 'ofrac', ocn2atm_map) + end if + call addmrg_to(compatm , 'So_ugustOut', & + mrg_from=compmed, mrg_fld='So_ugustOut', mrg_type='merge', mrg_fracname='ofrac') end if - call addmrg_to(compatm , 'So_ugustOut', & - mrg_from=compmed, mrg_fld='So_ugustOut', mrg_type='merge', mrg_fracname='ofrac') end if end if end if @@ -1432,17 +1451,19 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to atm: 10 m winds including/excluding gust component ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_aoflux('So_u10withGust') - call addfld_to(compatm, 'So_u10withGust') - else - if ( fldchk(is_local%wrap%FBexp(compatm), 'So_u10withGust', rc=rc)) then - if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_u10withGust', rc=rc)) then - if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap_aoflux('So_u10withGust', compatm, mapconsf, 'ofrac', ocn2atm_map) + if (add_gusts) then + if (phase == 'advertise') then + call addfld_aoflux('So_u10withGust') + call addfld_to(compatm, 'So_u10withGust') + else + if ( fldchk(is_local%wrap%FBexp(compatm), 'So_u10withGust', rc=rc)) then + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_u10withGust', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap_aoflux('So_u10withGust', compatm, mapconsf, 'ofrac', ocn2atm_map) + end if + call addmrg_to(compatm , 'So_u10withGust', & + mrg_from=compmed, mrg_fld='So_u10withGust', mrg_type='merge', mrg_fracname='ofrac') end if - call addmrg_to(compatm , 'So_u10withGust', & - mrg_from=compmed, mrg_fld='So_u10withGust', mrg_type='merge', mrg_fracname='ofrac') end if end if end if @@ -1700,7 +1721,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_fdms_ocn', rc=rc) .and. & fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_fdms_ocn', rc=rc)) then - call addmap_from(compocn, 'Faoo_fdms_ocn', compocn, mapconsd, 'one', ocn2atm_map) + call addmap_from(compocn, 'Faoo_fdms_ocn', compatm, mapconsd, 'one', ocn2atm_map) ! custom merge in med_phases_prep_atm end if end if @@ -1714,7 +1735,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_fbrf_ocn', rc=rc) .and. & fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_fbrf_ocn', rc=rc)) then - call addmap_from(compocn, 'Faoo_fbrf_ocn', compocn, mapconsd, 'one', ocn2atm_map) + call addmap_from(compocn, 'Faoo_fbrf_ocn', compatm, mapconsd, 'one', ocn2atm_map) ! custom merge in med_phases_prep_atm end if end if @@ -1728,7 +1749,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_fn2o_ocn', rc=rc) .and. & fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_fn2o_ocn', rc=rc)) then - call addmap_from(compocn, 'Faoo_fn2o_ocn', compocn, mapconsd, 'one', ocn2atm_map) + call addmap_from(compocn, 'Faoo_fn2o_ocn', compatm, mapconsd, 'one', ocn2atm_map) ! custom merge in med_phases_prep_atm end if end if @@ -1742,7 +1763,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_fnh3_ocn', rc=rc) .and. & fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_fnh3_ocn', rc=rc)) then - call addmap_from(compocn, 'Faoo_fnh3_ocn', compocn, mapconsd, 'one', ocn2atm_map) + call addmap_from(compocn, 'Faoo_fnh3_ocn', compatm, mapconsd, 'one', ocn2atm_map) ! custom merge in med_phases_prep_atm end if end if @@ -3012,23 +3033,21 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBexp(compwav) , 'Si_ifrac', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_ifrac', rc=rc)) then ! By default will be using a custom map - but if one is not available, use a generated bilinear instead - call addmap_from(compice, 'Si_ifrac', compwav, mapbilnr, 'one', ice2wav_map) + call addmap_from(compice, 'Si_ifrac', compwav, mapbilnr_nstod, 'one', ice2wav_map) call addmrg_to(compwav, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') end if end if !---------------------------------------------------------- ! to wav: ice thickness from ice !---------------------------------------------------------- - if (wav_coupling_to_cice) then - if (phase == 'advertise') then - call addfld_from(compice, 'Si_thick') - call addfld_to(compwav, 'Si_thick') - else - if (fldchk(is_local%wrap%FBexp(compwav) , 'Si_thick', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_thick', rc=rc)) then - call addmap_from(compice, 'Si_thick', compwav, mapbilnr, 'one', ice2wav_map) - call addmrg_to(compwav, 'Si_thick', mrg_from=compice, mrg_fld='Si_thick', mrg_type='copy') - end if + if (phase == 'advertise') then + call addfld_from(compice, 'Si_thick') + call addfld_to(compwav, 'Si_thick') + else + if ( fldchk(is_local%wrap%FBexp(compwav) , 'Si_thick', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_thick', rc=rc)) then + call addmap_from(compice, 'Si_thick', compwav, mapbilnr_nstod, 'one', ice2wav_map) + call addmrg_to(compwav, 'Si_thick', mrg_from=compice, mrg_fld='Si_thick', mrg_type='copy') end if end if !---------------------------------------------------------- @@ -3041,7 +3060,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if (fldchk(is_local%wrap%FBexp(compwav) , 'Si_floediam', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_floediam', rc=rc)) then - call addmap_from(compice, 'Si_floediam', compwav, mapbilnr, 'one', ice2wav_map) + call addmap_from(compice, 'Si_floediam', compwav, mapbilnr_nstod, 'one', ice2wav_map) call addmrg_to(compwav, 'Si_floediam', mrg_from=compice, mrg_fld='Si_floediam', mrg_type='copy') end if end if diff --git a/mediator/med.F90 b/mediator/med.F90 index 3133c7f88..89cc2f917 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -38,12 +38,11 @@ module MED use med_methods_mod , only : FB_getFieldN => med_methods_FB_getFieldN use med_methods_mod , only : clock_timeprint => med_methods_clock_timeprint use med_utils_mod , only : memcheck => med_memcheck - use med_time_mod , only : med_time_alarmInit use med_internalstate_mod , only : InternalState, med_internalstate_init, med_internalstate_coupling use med_internalstate_mod , only : med_internalstate_defaultmasks, logunit, maintask use med_internalstate_mod , only : ncomps, compname use med_internalstate_mod , only : compmed, compatm, compocn, compice, complnd, comprof, compwav, compglc - use med_internalstate_mod , only : coupling_mode, aoflux_code, aoflux_ccpp_suite + use med_internalstate_mod , only : coupling_mode, aoflux_code, aoflux_ccpp_suite, write_dststatus use esmFlds , only : med_fldList_GetocnalbfldList, med_fldList_type use esmFlds , only : med_fldList_GetNumFlds, med_fldList_GetFldNames, med_fldList_GetFldInfo use esmFlds , only : med_fldList_Document_Mapping, med_fldList_Document_Merging @@ -59,14 +58,15 @@ module MED public SetServices public SetVM private InitializeP0 - private AdvertiseFields ! advertise fields + private AdvertiseFields ! advertise fields private RealizeFieldsWithTransferProvided ! realize connected Fields with transfer action "provide" - private ModifyDecompofMesh ! optionally modify the decomp/distr of transferred Grid/Mesh - private RealizeFieldsWithTransferAccept ! realize all Fields with transfer action "accept" - private DataInitialize ! finish initialization and resolve data dependencies + private ModifyDecompofMesh ! optionally modify the decomp/distr of transferred Grid/Mesh + private RealizeFieldsWithTransferAccept ! realize all Fields with transfer action "accept" + private DataInitialize ! finish initialization and resolve data dependencies private SetRunClock private med_meshinfo_create private med_grid_write + private med_dststatus_write private med_finalize character(len=*), parameter :: u_FILE_u = & @@ -2178,6 +2178,14 @@ subroutine DataInitialize(gcomp, rc) call med_diag_zero(mode='all', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + !--------------------------------------- + ! write dstStatus fields if requested + !--------------------------------------- + if (write_dststatus) then + call med_dststatus_write(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + !--------------------------------------- ! read mediator restarts !--------------------------------------- @@ -2261,7 +2269,9 @@ subroutine SetRunClock(gcomp, rc) use ESMF , only : ESMF_ClockGetAlarmList use NUOPC , only : NUOPC_CompCheckSetClock, NUOPC_CompAttributeGet use NUOPC_Mediator , only : NUOPC_MediatorGet - + ! NUOPC_shr_methods is now in cesm_share and cdeps + use nuopc_shr_methods, only : AlarmInit + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -2318,7 +2328,7 @@ subroutine SetRunClock(gcomp, rc) call NUOPC_CompAttributeGet(gcomp, name="stop_ymd", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stop_ymd - call med_time_alarmInit(mclock, stop_alarm, stop_option, opt_n=stop_n, opt_ymd=stop_ymd, & + call AlarmInit(mclock, stop_alarm, stop_option, opt_n=stop_n, opt_ymd=stop_ymd, & alarmname='alarm_stop', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return stopalarmcreated = .true. @@ -2562,6 +2572,132 @@ subroutine med_grid_write(grid, fileName, rc) end subroutine med_grid_write + !----------------------------------------------------------------------------- + subroutine med_dststatus_write (gcomp, rc) + + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_SUCCESS, ESMF_VM + use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleDestroy + use ESMF , only : ESMF_FieldBundleAdd, ESMF_Array, ESMF_Field, ESMF_MeshGet + use ESMF , only : ESMF_FieldGet, ESMF_FieldCreate, ESMF_FieldDestroy + use ESMF , only : ESMF_Mesh, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8, ESMF_TYPEKIND_I4 + use ESMF , only : ESMF_LOGMSG_INFO, ESMF_LogWrite + use NUOPC , only : NUOPC_CompAttributeGet + use med_kind_mod , only : I4=>SHR_KIND_I4, R8=>SHR_KIND_R8 + use med_internalstate_mod , only : ncomps, compname + use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close + use pio , only : file_desc_t + use med_methods_mod , only : med_methods_FB_getFieldN + + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(file_desc_t) :: io_file + type(InternalState) :: is_local + type(ESMF_VM) :: vm + type(ESMF_Mesh) :: mesh_dst + type(ESMF_Field) :: flddst, lfield + type(ESMF_Field) :: maskfield + type(ESMF_Array) :: maskarray + integer(I4), pointer :: meshmask(:) + real(R8), pointer :: r8ptr(:) + integer :: m,n1,n2 + character(CL) :: case_name, dststatusfile + logical :: elementMaskIsPresent + logical :: whead(2) = (/.true. , .false./) + logical :: wdata(2) = (/.false., .true. /) + character(len=*), parameter :: subname = '('//__FILE__//':med_dststatus_write)' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Create dststatus file + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + dststatusfile = trim(case_name)//'.dststatus.nc' + + ! add mesh masks for any destination component in the dststatusFB + do n2 = 2,ncomps + if (is_local%wrap%comp_present(n2)) then + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBdststatus(n2),rc=rc)) then + call med_methods_FB_getFieldN(is_local%wrap%FBdststatus(n2), 1, flddst, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(flddst, mesh=mesh_dst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MeshGet(mesh_dst, elementMaskIsPresent=elementMaskIsPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (elementMaskIsPresent) then + maskfield = ESMF_FieldCreate(mesh_dst, ESMF_TYPEKIND_I4, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! get mask Array + call ESMF_FieldGet(maskfield, array=maskarray, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(mesh_dst, elemMaskArray=maskarray, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(maskfield, localDe=0, farrayPtr=meshmask, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! now create an R8 mask for writing + lfield = ESMF_FieldCreate(mesh_dst, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(compname(n2))//'mask', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=r8ptr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + r8ptr = real(meshmask,R8) + call ESMF_FieldBundleAdd(is_local%wrap%FBdststatus(n2), (/lfield/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldDestroy(maskfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + end if + end do + + ! write the FB + call med_io_wopen(trim(dststatusfile), io_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Loop over whead/wdata phases + do m = 1,2 + if (m == 2) then + call med_io_enddef(io_file) + end if + + ! write dststatusfields for each dst component + do n2 = 2,ncomps + if (is_local%wrap%comp_present(n2)) then + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBdststatus(n2),rc=rc)) then + call med_io_write(io_file, is_local%wrap%FBdststatus(n2), whead(m), wdata(m), & + is_local%wrap%nx(n2), is_local%wrap%ny(n2), pre='dst'//trim(compname(n2)), & + use_float=.true., ntile=is_local%wrap%ntile(n2), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + end if + end do + end do ! do m = 1,2 + ! Close file + call med_io_close(io_file, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Destroy the dststatus FBs + do n2 = 2,ncomps + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBdststatus(n2),rc=rc)) then + call ESMF_FieldBundleDestroy(is_local%wrap%FBdststatus(n2), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + end do + + end subroutine med_dststatus_write + !----------------------------------------------------------------------------- subroutine med_finalize(gcomp, rc) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 8bad9d5c8..bb0139ccb 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -31,7 +31,6 @@ module med_diag_mod use med_methods_mod , only : fldbun_getdata2d => med_methods_FB_getdata2d use med_methods_mod , only : fldbun_getdata1d => med_methods_FB_getdata1d use med_methods_mod , only : fldbun_fldChk => med_methods_FB_FldChk - use med_time_mod , only : alarmInit => med_time_alarmInit use med_utils_mod , only : chkerr => med_utils_ChkErr use perf_mod , only : t_startf, t_stopf @@ -150,8 +149,6 @@ module med_diag_mod integer :: f_heat_cond = unset_index ! heat : heat content of evaporation integer :: f_heat_rofl = unset_index ! heat : heat content of liquid runoff integer :: f_heat_rofi = unset_index ! heat : heat content of ice runoff - integer :: f_heat_rofl_glc = unset_index ! heat : heat content of liquid glc runoff - integer :: f_heat_rofi_glc = unset_index ! heat : heat content of ice glc runoff integer :: f_watr_frz = unset_index ! water: freezing integer :: f_watr_melt = unset_index ! water: melting @@ -332,16 +329,14 @@ subroutine med_diag_init(gcomp, rc) f_heat_beg = f_heat_frz ! field first index for heat f_heat_end = f_heat_sen ! field last index for heat else if (trim(budget_table_version) == 'v1') then - call add_to_budget_diag(budget_diags%fields, f_heat_rain ,'hrain' ) ! field heat : enthalpy of rain - call add_to_budget_diag(budget_diags%fields, f_heat_snow ,'hsnow' ) ! field heat : enthalpy of snow - call add_to_budget_diag(budget_diags%fields, f_heat_evap ,'hevap' ) ! field heat : enthalpy of evaporation - call add_to_budget_diag(budget_diags%fields, f_heat_cond ,'hcond' ) ! field heat : enthalpy of evaporation - call add_to_budget_diag(budget_diags%fields, f_heat_rofl ,'hrofl' ) ! field heat : enthalpy of liquid runoff - call add_to_budget_diag(budget_diags%fields, f_heat_rofi ,'hrofi' ) ! field heat : enthalpy of ice runoff - call add_to_budget_diag(budget_diags%fields, f_heat_rofl_glc,'hrofl_glc' ) ! field heat : enthalpy of liquid glc runoff - call add_to_budget_diag(budget_diags%fields, f_heat_rofi_glc,'hrofi_glc' ) ! field heat : enthalpy of ice glc runoff + call add_to_budget_diag(budget_diags%fields, f_heat_rain ,'hrain' ) ! field heat : enthalpy of rain + call add_to_budget_diag(budget_diags%fields, f_heat_snow ,'hsnow' ) ! field heat : enthalpy of snow + call add_to_budget_diag(budget_diags%fields, f_heat_evap ,'hevap' ) ! field heat : enthalpy of evaporation + call add_to_budget_diag(budget_diags%fields, f_heat_cond ,'hcond' ) ! field heat : enthalpy of evaporation + call add_to_budget_diag(budget_diags%fields, f_heat_rofl ,'hrofl' ) ! field heat : enthalpy of liquid runoff + call add_to_budget_diag(budget_diags%fields, f_heat_rofi ,'hrofi' ) ! field heat : enthalpy of ice runoff f_heat_beg = f_heat_frz ! field first index for heat - f_heat_end = f_heat_rofi_glc ! field last index for heat + f_heat_end = f_heat_rofi ! field last index for heat end if ! ----------------------------------------- @@ -1208,7 +1203,7 @@ subroutine med_phases_diag_rof( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if ( fldbun_fldchk(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofl_glc', rc=rc)) then - call diag_rof(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofi_glc' , f_watr_roff, ic, areas, budget_local, minus=.true., rc=rc) + call diag_rof(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofl_glc' , f_watr_roff, ic, areas, budget_local, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if ( fldbun_fldchk(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofi_glc', rc=rc)) then @@ -1365,12 +1360,10 @@ subroutine med_phases_diag_glc( gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !------------------------------- ! from glc to mediator !------------------------------- - ! TODO: this will not be correct if there is more than 1 ice sheet ic = c_glc_recv ip = period_inst @@ -1605,10 +1598,6 @@ subroutine med_phases_diag_ocn( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', f_heat_rofi , ic, areas, sfrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofl_glc', f_heat_rofl_glc, ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofi_glc', f_heat_rofi_glc , ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return budget_local(f_heat_latf,ic,ip) = -budget_local(f_watr_snow,ic,ip)*shr_const_latice budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice @@ -2127,8 +2116,6 @@ subroutine med_phases_diag_print(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (ESMF_AlarmIsRinging(stop_alarm, rc=rc)) then output_level = max(output_level, budget_print_ltend) - call ESMF_AlarmRingerOff( stop_alarm, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return endif endif diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index d09903be5..6f7c49f73 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -106,7 +106,7 @@ module med_internalstate_mod type(ESMF_Field) :: field_fracdst end type packed_data_type - logical, public :: dststatus_print = .false. + logical, public :: write_dststatus = .false. ! Mesh info type, public :: mesh_info_type @@ -189,6 +189,8 @@ module med_internalstate_mod ! Data type(ESMF_FieldBundle) , pointer :: FBData(:) ! Background data for various components, on their grid, provided by CDEPS inline + ! DstStatus + type(ESMF_FieldBundle) , pointer :: FBDstStatus(:) ! DstStatus fields for components for each source component and maptype ! Accumulators for export field bundles type(ESMF_FieldBundle) :: FBExpAccumOcn ! Accumulator for Ocn export on Ocn grid @@ -429,12 +431,15 @@ subroutine med_internalstate_init(gcomp, rc) write(logunit,*) end if - ! Obtain dststatus_print setting if present - call NUOPC_CompAttributeGet(gcomp, name='dststatus_print', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + ! Allocate dststatus FB if needed + call NUOPC_CompAttributeGet(gcomp, name='write_dststatus', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) dststatus_print=(trim(cvalue) == "true") - write(msgString,*) trim(subname)//': Mediator dststatus_print is ',dststatus_print + if (isPresent .and. isSet) write_dststatus=(trim(cvalue) == "true") + write(msgString,*) trim(subname)//': Mediator write_dststatus is ',write_dststatus call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + if (write_dststatus) then + allocate(is_local%wrap%FBDstStatus(ncomps)) + end if ! Initialize flag for background fill using data is_local%wrap%med_data_active(:,:) = .false. diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 3d888bcfa..6282ddc3e 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -78,14 +78,15 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LogFlush use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_Field use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_FieldBundleCreate - use ESMF , only : ESMF_FieldBundleIsCreated + use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleAdd use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate, ESMF_FieldDestroy use ESMF , only : ESMF_Mesh, ESMF_TYPEKIND_R8, ESMF_MESHLOC_ELEMENT + use ESMF , only : ESMF_TYPEKIND_I4, ESMF_FieldIsCreated use med_methods_mod , only : med_methods_FB_getFieldN, med_methods_FB_getNameN use med_constants_mod , only : czero => med_constants_czero use esmFlds , only : med_fldList_GetfldListFr, med_fldlist_type use esmFlds , only : med_fld_GetFldInfo, med_fldList_entry_type - use med_internalstate_mod , only : mapunset, compname + use med_internalstate_mod , only : mapunset, compname, write_dststatus use med_internalstate_mod , only : ncomps, nmappers, compname, mapnames, mapfcopy ! input/output variables @@ -98,6 +99,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun type(InternalState) :: is_local type(ESMF_Field) :: fldsrc type(ESMF_Field) :: flddst + type(ESMF_Field) :: dstatfield integer :: n1,n2 integer :: nf integer :: fieldCount @@ -155,9 +157,10 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun else call med_methods_FB_getFieldN(is_local%wrap%FBImp(n1,n2), 1, flddst, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - end if + end if + - ! Loop over fields + ! Loop over fields fldListFr => med_fldList_getFldListFr(n1) fldptr => fldListFr%fields nf = 0 @@ -169,21 +172,31 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun ! determine if route handle has already been created mapexists = med_map_RH_is_created(is_local%wrap%RH,n1,n2,mapindex,rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Create route handle for target mapindex if route handle is required ! (i.e. mapindex /= mapunset) and route handle has not already been created if (.not. mapexists) then call med_fld_GetFldInfo(fldptr, compsrc=n2, mapfile=mapfile) call med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, & - mapindex, is_local%wrap%rh(n1,n2,:), mapfile=trim(mapfile), rc=rc) + mapindex, is_local%wrap%rh(n1,n2,:), mapfile=trim(mapfile), & + dstatfield=dstatfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - end if + ! Save the FBdststatus fields + if (write_dststatus) then + if (mapindex /= mapfcopy) then + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBDststatus(n2), rc=rc)) then + is_local%wrap%FBDstStatus(n2) = ESMF_FieldBundleCreate(name='dstStatus'//trim(compname(n2)), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + call ESMF_FieldBundleAdd(is_local%wrap%FBDststatus(n2), (/dstatfield/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + end if end if ! end if mapindex is mapunset fldptr => fldptr%next end do ! loop over fields - end if ! if coupling active end if ! if n1 not equal to n2 end do ! loop over n2 @@ -263,7 +276,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun //trim(mapnames(mapindex)) end if end if - end do ! end of loop over map_indiex mappers + end do ! end of loop over map_index mappers end if ! end of if block for creating destination field end do ! end of loop over n2 @@ -331,7 +344,8 @@ subroutine med_map_routehandles_initfrom_fieldbundle(n1, n2, FBsrc, FBdst, mapin end subroutine med_map_routehandles_initfrom_fieldbundle !================================================================================ - subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, routehandles, mapfile, rc) + subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, routehandles, & + mapfile, dstatfield, rc) use ESMF , only : ESMF_RouteHandle, ESMF_RouteHandlePrint, ESMF_Field, ESMF_MAXSTR use ESMF , only : ESMF_PoleMethod_Flag, ESMF_POLEMETHOD_ALLAVG, ESMF_POLEMETHOD_NONE @@ -343,13 +357,13 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, use ESMF , only : ESMF_EXTRAPMETHOD_NEAREST_STOD use ESMF , only : ESMF_Mesh, ESMF_MeshLoc, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_I4 use ESMF , only : ESMF_MeshGet, ESMF_DistGridGet, ESMF_DistGrid, ESMF_TYPEKIND_R8 - use ESMF , only : ESMF_FieldGet, ESMF_FieldCreate, ESMF_FieldWrite, ESMF_FieldDestroy + use ESMF , only : ESMF_FieldGet, ESMF_FieldCreate, ESMF_FieldDestroy use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch, mappatch_uv3d, mapbilnr_uv3d, mapfcopy use med_internalstate_mod , only : mapunset, mapnames, nmappers use med_internalstate_mod , only : mapnstod, mapnstod_consd, mapnstod_consf, mapnstod_consd use med_internalstate_mod , only : mapfillv_bilnr, mapbilnr_nstod, mapconsf_aofrac use med_internalstate_mod , only : compocn, compwav, complnd, compname, compatm - use med_internalstate_mod , only : coupling_mode, dststatus_print + use med_internalstate_mod , only : coupling_mode use med_internalstate_mod , only : defaultMasks use med_constants_mod , only : ispval_mask => med_constants_ispval_mask @@ -361,21 +375,21 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, integer , intent(in) :: mapindex type(ESMF_RouteHandle) , intent(inout) :: routehandles(:) character(len=*), optional , intent(in) :: mapfile + type(ESMF_Field), optional , intent(out) :: dstatfield integer , intent(out) :: rc ! local variables - type(ESMF_Mesh) :: dstmesh - type(ESMF_Field) :: dststatusfield, doffield - type(ESMF_DistGrid) :: distgrid + type(ESMF_Mesh) :: mesh_dst + type(ESMF_Field) :: lfield character(len=CS) :: string character(len=CS) :: mapname - character(len=CL) :: fname + character(len=CS) :: dstatname integer :: srcMaskValue integer :: dstMaskValue + real(R8), pointer :: r8ptr(:) + integer(I4), pointer :: i4ptr(:) character(len=ESMF_MAXSTR) :: lmapfile - logical :: rhprint = .false., ldstprint = .false. - integer :: ns - integer(I4), pointer :: dof(:) + logical :: rhprint = .false. integer :: srcTermProcessing_Value = 0 type(ESMF_PoleMethod_Flag) :: polemethod character(len=*), parameter :: subname=' (module_med_map: med_map_routehandles_initfrom_field) ' @@ -390,12 +404,11 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, call ESMF_LogWrite(trim(subname)//": mapname "//trim(mapname), ESMF_LOGMSG_INFO) ! create a field to retrieve the dststatus field - call ESMF_FieldGet(flddst, mesh=dstmesh, rc=rc) + dstatname = trim(compname(n1))//'_'//trim(compname(n2))//'_'//mapname + call ESMF_FieldGet(flddst, mesh=mesh_dst, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - dststatusfield = ESMF_FieldCreate(dstmesh, ESMF_TYPEKIND_I4, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + lfield = ESMF_FieldCreate(mesh_dst, ESMF_TYPEKIND_I4, meshloc=ESMF_MESHLOC_ELEMENT, name=trim(dstatname), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! set local flag to false - ldstprint = .false. ! set src and dst masking using defaults srcMaskValue = defaultMasks(n1,1) @@ -466,10 +479,9 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, polemethod=polemethod, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & - dstStatusField=dststatusfield, & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ldstprint = .true. end if else if (mapindex == mapfillv_bilnr) then if (maintask) then @@ -482,10 +494,9 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, polemethod=polemethod, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & - dstStatusField=dststatusfield, & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ldstprint = .true. else if (mapindex == mapbilnr_nstod) then if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) @@ -498,10 +509,9 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, polemethod=polemethod, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & - dstStatusField=dststatusfield, & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ldstprint = .true. else if (mapindex == mapconsf .or. mapindex == mapnstod_consf) then if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) @@ -513,11 +523,10 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, normType=ESMF_NORMTYPE_FRACAREA, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & - dstStatusField=dststatusfield, & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ldstprint = .true. else if (mapindex == mapconsf_aofrac) then if (.not. ESMF_RouteHandleIsCreated(routehandles(mapconsf))) then if (maintask) then @@ -530,11 +539,10 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, normType=ESMF_NORMTYPE_FRACAREA, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & - dstStatusField=dststatusfield, & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ldstprint = .true. else ! Copy existing consf RH if (maintask) then @@ -554,11 +562,10 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, normType=ESMF_NORMTYPE_DSTAREA, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & - dstStatusField=dststatusfield, & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ldstprint = .true. else if (mapindex == mappatch .or. mapindex == mappatch_uv3d) then if (.not. ESMF_RouteHandleIsCreated(routehandles(mappatch))) then if (maintask) then @@ -571,10 +578,9 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, polemethod=polemethod, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & - dstStatusField=dststatusfield, & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ldstprint = .true. end if else if (maintask) then @@ -586,31 +592,6 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, return end if - ! Output destination status field to file if requested - if (dststatus_print .and. ldstprint) then - fname = 'dststatus.'//trim(compname(n1))//'.'//trim(compname(n2))//'.'//trim(mapname)//'.nc' - call ESMF_LogWrite(trim(subname)//": writing dstStatusField to "//trim(fname), ESMF_LOGMSG_INFO) - - call ESMF_FieldWrite(dststatusfield, filename=trim(fname), variableName='dststatus', & - overwrite=.true., rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! the sequence index in order to sort the dststatus field - call ESMF_MeshGet(dstmesh, elementDistgrid=distgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_DistGridGet(distgrid, localDE=0, elementCount=ns, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(dof(ns)) - call ESMF_DistGridGet(distgrid, localDE=0, seqIndexList=dof, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - doffield = ESMF_FieldCreate(dstmesh, dof, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldWrite(doffield, fileName='dof.'//trim(compname(n2))//'.nc', variableName='dof', & - overwrite=.true., rc=rc) - deallocate(dof) - call ESMF_FieldDestroy(doffield, rc=rc, noGarbage=.true.) - end if - ! consd_nstod method requires a second routehandle if (mapindex == mapnstod .or. mapindex == mapnstod_consd .or. mapindex == mapnstod_consf) then call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapnstod), & @@ -619,20 +600,10 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, regridmethod=ESMF_REGRIDMETHOD_NEAREST_STOD, & srcTermProcessing=srcTermProcessing_Value, & ignoreDegenerate=.true., & - dstStatusField=dststatusfield, & + dstStatusField=lfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ldstprint = .true. - - ! Output destination status field to file if requested - if (dststatus_print .and. ldstprint) then - fname = 'dststatus.'//trim(compname(n1))//'.'//trim(compname(n2))//'.'//trim(mapname)//'_2.nc' - call ESMF_LogWrite(trim(subname)//": writing dstStatusField to "//trim(fname), ESMF_LOGMSG_INFO) - - call ESMF_FieldWrite(dststatusfield, filename=trim(fname), variableName='dststatus', overwrite=.true., rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if end if ! Output route handle to file if requested @@ -644,7 +615,19 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, if (chkerr(rc,__LINE__,u_FILE_u)) return endif - call ESMF_FieldDestroy(dststatusfield, rc=rc, noGarbage=.true.) + ! Copy R8 values into a returned field + if (present(dstatfield)) then + dstatfield = ESMF_FieldCreate(mesh_dst, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, & + name=trim(dstatname), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=i4ptr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(dstatfield, farrayPtr=r8ptr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + r8ptr = real(i4ptr,R8) + call ESMF_FieldDestroy(lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if end subroutine med_map_routehandles_initfrom_field diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index a85d76bcb..6cf7280e7 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -780,7 +780,7 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Mesh) :: xch_mesh real(r8), pointer :: dataptr(:) integer :: fieldcount - integer :: stp ! srcTermProcessing is declared inout and must have variable not constant + integer :: srcTermProcessing_Value ! srcTermProcessing is declared inout and must have variable not constant type(ESMF_CoordSys_Flag) :: coordSys real(ESMF_KIND_R8) ,allocatable :: garea(:) character(len=*),parameter :: subname=' (med_aofluxes_init_xgrid) ' @@ -788,6 +788,8 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) rc = ESMF_SUCCESS + srcTermProcessing_Value = 0 + ! Get the internal state from the mediator Component. nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) @@ -877,23 +879,26 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) dataptr(:) = 1.0_r8 ! create agrid->xgrid route handles - call ESMF_FieldRegridStore(xgrid, field_a, field_x, routehandle=rh_agrid2xgrid, rc=rc) + call ESMF_FieldRegridStore(xgrid, field_a, field_x, routehandle=rh_agrid2xgrid, & + srcTermProcessing=srcTermProcessing_Value, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldRegridStore(xgrid, field_a, field_x, routehandle=rh_agrid2xgrid_2ndord, & - regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, rc=rc) + regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, srcTermProcessing=srcTermProcessing_Value, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (trim(coupling_mode) == 'cesm') then - stp = 1 call ESMF_FieldRegridStore(field_a, field_x, routehandle=rh_agrid2xgrid_bilinr, & - regridmethod=ESMF_REGRIDMETHOD_BILINEAR, dstMaskValues=(/0/), srcTermProcessing=stp, rc=rc) + regridmethod=ESMF_REGRIDMETHOD_BILINEAR, dstMaskValues=(/0/), & + srcTermProcessing=srcTermProcessing_Value, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldRegridStore(field_a, field_x, routehandle=rh_agrid2xgrid_patch, & - regridmethod=ESMF_REGRIDMETHOD_PATCH, dstMaskValues=(/0/), srcTermProcessing=stp, rc=rc) + regridmethod=ESMF_REGRIDMETHOD_PATCH, dstMaskValues=(/0/), & + srcTermProcessing=srcTermProcessing_Value, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if ! create xgrid->zgrid route handle - call ESMF_FieldRegridStore(xgrid, field_x, field_a, routehandle=rh_xgrid2agrid, rc=rc) + call ESMF_FieldRegridStore(xgrid, field_x, field_a, routehandle=rh_xgrid2agrid, & + srcTermProcessing=srcTermProcessing_Value, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! destroy temporary field @@ -911,12 +916,14 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) call ESMF_FieldGet(field_o, farrayptr=dataptr, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return dataptr(:) = 1.0_r8 - call ESMF_FieldRegridStore(xgrid, field_o, field_x, routehandle=rh_ogrid2xgrid, rc=rc) + call ESMF_FieldRegridStore(xgrid, field_o, field_x, routehandle=rh_ogrid2xgrid, & + srcTermProcessing=srcTermProcessing_Value, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldRegridStore(xgrid, field_x, field_o, routehandle=rh_xgrid2ogrid, rc=rc) + call ESMF_FieldRegridStore(xgrid, field_x, field_o, routehandle=rh_xgrid2ogrid, & + srcTermProcessing=srcTermProcessing_Value, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! call ESMF_FieldRegridStore(xgrid, field_o, field_x, routehandle=rh_ogrid2xgrid_2ndord, & - ! regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, rc=rc) + ! regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, srcTermProcessing=srcTermProcessing_Value, rc=rc) ! if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldDestroy(field_o, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1637,7 +1644,13 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (chkerr(rc,__LINE__,u_FILE_u)) return end if - if (FB_fldchk(fldbun_a, 'Sa_pslv', rc=rc)) then + ! The following conditional captures the cases where aoflux_in%psfc is needed in calls + ! to flux_atmocn / flux_atmocn_ccpp. Note that coupling_mode=='cesm' is equivalent to + ! the CESMCOUPLED CPP token, and coupling_mode(1:3)=='ufs' is roughly equivalent to + ! the UFS_AOFLUX CPP token (noting that we should only be in this subroutine if using + ! one of the aoflux variants of the ufs coupling_mode). + if ((trim(coupling_mode) == 'cesm') .or. & + (coupling_mode(1:3) == 'ufs' .and. trim(aoflux_code) == 'ccpp')) then call fldbun_getfldptr(fldbun_a, 'Sa_pslv', aoflux_in%psfc, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if @@ -1646,10 +1659,6 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (compute_atm_dens .or. compute_atm_thbot) then call fldbun_getfldptr(fldbun_a, 'Sa_pbot', aoflux_in%pbot, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (trim(coupling_mode) == 'ufs.frac.aoflux') then - call fldbun_getfldptr(fldbun_a, 'Sa_pslv', aoflux_in%psfc, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if end if if (flds_wiso) then @@ -1720,9 +1729,6 @@ subroutine set_aoflux_out_pointers(fldbun, lsize, aoflux_out, xgrid, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun, 'So_duu10n', aoflux_out%duu10n, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - - call fldbun_getfldptr(fldbun, 'So_u10withGust', aoflux_out%u10_withGust, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun, 'So_u10res', aoflux_out%u10res, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun, 'Faox_taux', aoflux_out%taux, xgrid=xgrid, rc=rc) @@ -1753,8 +1759,11 @@ subroutine set_aoflux_out_pointers(fldbun, lsize, aoflux_out, xgrid, rc) if (add_gusts) then call fldbun_getfldptr(fldbun, 'So_ugustOut', aoflux_out%ugust_out, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call fldbun_getfldptr(fldbun, 'So_u10withGust', aoflux_out%u10_withGust, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return else allocate(aoflux_out%ugust_out(lsize)); aoflux_out%ugust_out(:) = 0._R8 + allocate(aoflux_out%u10_withGust(lsize)); aoflux_out%u10_withGust(:) = 0._R8 end if end subroutine set_aoflux_out_pointers diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index c895d6c42..6859a6c9a 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -21,7 +21,6 @@ module med_phases_history_mod use med_utils_mod , only : chkerr => med_utils_ChkErr use med_internalstate_mod , only : ncomps, compname use med_internalstate_mod , only : InternalState, maintask, logunit - use med_time_mod , only : med_time_alarmInit use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close use perf_mod , only : t_startf, t_stopf use pio , only : file_desc_t @@ -153,6 +152,7 @@ subroutine med_phases_history_write(gcomp, rc) use ESMF , only : ESMF_Alarm, ESMF_AlarmSet use ESMF , only : ESMF_FieldBundleIsCreated use med_internalstate_mod, only : compocn, compatm + use nuopc_shr_methods , only : alarmInit ! input/output variables type(ESMF_GridComp) :: gcomp @@ -184,6 +184,7 @@ subroutine med_phases_history_write(gcomp, rc) type(ESMF_TimeInterval) :: ringInterval integer :: ringInterval_length logical :: first_time = .true. + character(len=*), parameter :: subname='(med_phases_history_write)' !--------------------------------------- @@ -221,7 +222,7 @@ subroutine med_phases_history_write(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGet(mclock, startTime=starttime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_time_alarmInit(mclock, alarm, option=hist_option_all_inst, opt_n=hist_n_all_inst, & + call alarmInit(mclock, alarm, option=hist_option_all_inst, opt_n=hist_n_all_inst, & reftime=starttime, alarmname=alarmname, rc=rc) call ESMF_AlarmSet(alarm, clock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1550,7 +1551,7 @@ subroutine med_phases_history_init_histclock(gcomp, hclock, alarm, alarmname, hi use NUOPC_Mediator, only : NUOPC_MediatorGet use ESMF , only : ESMF_ClockCreate, ESMF_ClockGet, ESMF_ClockSet - use med_time_mod , only : med_time_alarmInit + use nuopc_shr_methods, only: AlarmInit ! input/output variables type(ESMF_GridComp) , intent(in) :: gcomp @@ -1593,9 +1594,7 @@ subroutine med_phases_history_init_histclock(gcomp, hclock, alarm, alarmname, hi hclock = ESMF_ClockCreate(mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Initialize history alarm and advance history clock to trigger - ! alarms then reset history clock back to mcurrtime - call med_time_alarmInit(hclock, alarm, option=hist_option, opt_n=hist_n, & + call alarmInit(hclock, alarm, option=hist_option, opt_n=hist_n, & reftime=StartTime, alarmname=trim(alarmname), advance_clock=.true., rc=rc) ! Write diagnostic info diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 304d0c7fd..18d709cdd 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -634,9 +634,9 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, maintask, eccen, ob type(ESMF_Time) :: CurrTime ! current time integer :: year ! model year at current time integer :: orb_year ! orbital year for current orbital computation + integer, save :: prev_orb_year=0 character(len=CL) :: msgstr ! temporary logical :: lprint - logical :: first_time = .true. character(len=*) , parameter :: subname = "(med_phases_ocnalb_orbital_update)" !------------------------------------------- @@ -648,19 +648,18 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, maintask, eccen, ob 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 = maintask else orb_year = orb_iyear - if (first_time) then - lprint = maintask - first_time = .false. - else - lprint = .false. - end if end if eccen = orb_eccen shr_log_unit = logunit + + if(orb_year .ne. prev_orb_year) then + prev_orb_year = orb_year + lprint = maintask + end if + 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. & diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 1681aa9b1..4eff5966f 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -39,7 +39,7 @@ module med_phases_prep_glc_mod use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d use med_methods_mod , only : fldchk => med_methods_FB_FldChk use med_utils_mod , only : chkerr => med_utils_ChkErr - use med_time_mod , only : med_time_alarmInit + use nuopc_shr_methods , only : alarmInit use glc_elevclass_mod , only : glc_get_num_elevation_classes use glc_elevclass_mod , only : glc_get_elevation_classes use glc_elevclass_mod , only : glc_get_fractional_icecov @@ -135,7 +135,6 @@ subroutine med_phases_prep_glc_init(gcomp, rc) type(ESMF_Mesh) :: mesh_o type(ESMF_Field) :: lfield character(len=CS) :: glc_renormalize_smb - logical :: glc_coupled_fluxes integer :: ungriddedUBound_output(1) ! currently the size must equal 1 for rank 2 fieldds character(len=*),parameter :: subname=' (med_phases_prep_glc_init) ' !--------------------------------------- @@ -234,25 +233,11 @@ subroutine med_phases_prep_glc_init(gcomp, rc) call NUOPC_CompAttributeGet(gcomp, name='glc_renormalize_smb', value=glc_renormalize_smb, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! TODO: talk to Bill Sacks to determine if this is the correct logic - glc_coupled_fluxes = is_local%wrap%med_coupling_active(compglc(1),complnd) - ! Note glc_coupled_fluxes should be false in the no_evolve cases - ! Goes back to the zero-gcm fluxes variable - if zero-gcm fluxes is true than do not renormalize - ! The user can set this to true in an evolve cases - select case (glc_renormalize_smb) case ('on') smb_renormalize = .true. case ('off') smb_renormalize = .false. - case ('on_if_glc_coupled_fluxes') - if (.not. glc_coupled_fluxes) then - ! Do not renormalize if med_coupling_active is not true for compglc->complnd - ! In this case, conservation is not important - smb_renormalize = .false. - else - smb_renormalize = .true. - end if case default write(logunit,*) subname,' ERROR: unknown value for glc_renormalize_smb: ', trim(glc_renormalize_smb) call ESMF_LogWrite(trim(subname)//' ERROR: unknown value for glc_renormalize_smb: '// trim(glc_renormalize_smb), & @@ -547,7 +532,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) call NUOPC_CompAttributeGet(gcomp, name="glc_avg_period", value=glc_avg_period, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (trim(glc_avg_period) == 'yearly') then - call med_time_alarmInit(prepglc_clock, glc_avg_alarm, 'yearly', alarmname='alarm_glc_avg', rc=rc) + call alarmInit(prepglc_clock, glc_avg_alarm, 'yearly', alarmname='alarm_glc_avg', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (maintask) then write(logunit,'(a,i10)') trim(subname)//& @@ -557,7 +542,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) call NUOPC_CompAttributeGet(gcomp, name="glc_cpl_dt", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) glc_cpl_dt - call med_time_alarmInit(prepglc_clock, glc_avg_alarm, 'nseconds', opt_n=glc_cpl_dt, alarmname='alarm_glc_avg', rc=rc) + call alarmInit(prepglc_clock, glc_avg_alarm, 'nseconds', opt_n=glc_cpl_dt, alarmname='alarm_glc_avg', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (maintask) then write(logunit,'(a,i10)') trim(subname)//& diff --git a/mediator/med_phases_profile_mod.F90 b/mediator/med_phases_profile_mod.F90 index dee849ae8..75d7f4d91 100644 --- a/mediator/med_phases_profile_mod.F90 +++ b/mediator/med_phases_profile_mod.F90 @@ -9,7 +9,7 @@ module med_phases_profile_mod use med_utils_mod , only : med_utils_chkerr, med_memcheck use med_internalstate_mod , only : maintask, logunit use med_utils_mod , only : chkerr => med_utils_ChkErr - use med_time_mod , only : alarmInit => med_time_alarmInit + use nuopc_shr_methods , only : alarmInit use perf_mod , only : t_startf, t_stopf #ifdef CESMCOUPLED use shr_mem_mod , only : shr_mem_getusage @@ -53,7 +53,8 @@ subroutine med_phases_profile(gcomp, rc) ! local variables character(len=CS) :: cpl_inst_tag type(ESMF_Clock) :: clock - type(ESMF_Time) :: wallclockTime, nextTime + type(ESMF_Time), save :: wallclockTime + type(ESMF_Time) :: nextTime type(ESMF_Time) :: currTime type(ESMF_Time), save :: prevTime type(ESMF_TimeInterval) :: ringInterval, timestep @@ -119,6 +120,12 @@ subroutine med_phases_profile(gcomp, rc) call ESMF_TimeIntervalGet(timestep, d_r8=timestep_length, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! use gregorian calendar for wallclocktime + ! The s=0 is just to avoid an internal /0 error in esmf + call ESMF_TimeSet(wallclockTime, calkindflag=ESMF_CALKIND_GREGORIAN, s=0, rc=rc) + if (med_utils_chkerr(rc,__LINE__,u_FILE_u)) return + iterations = 1 else @@ -170,9 +177,6 @@ subroutine med_phases_profile(gcomp, rc) call ESMF_TimeGet(nexttime, timestring=nexttimestr, rc=rc) if (med_utils_ChkErr(rc,__LINE__,u_FILE_u)) return ! get current wall clock time - ! s=0 is to prevent an internal divide by 0 error in esmf - call ESMF_TimeSet(wallclockTime, calkindflag=ESMF_CALKIND_GREGORIAN, s=0, rc=rc) - if (med_utils_chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeSyncToRealTime(wallclockTime, rc=rc) if (med_utils_chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index b161f6b79..3248f5ee4 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -31,7 +31,6 @@ module med_phases_restart_mod #endif logical :: whead(2) = (/.true. , .false./) logical :: wdata(2) = (/.false., .true. /) - character(*), parameter :: u_FILE_u = & __FILE__ @@ -53,7 +52,7 @@ subroutine med_phases_restart_alarm_init(gcomp, rc) use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model , only : NUOPC_ModelGet - use med_time_mod , only : med_time_AlarmInit + use nuopc_shr_methods, only : AlarmInit ! input/output variables type(ESMF_GridComp) :: gcomp @@ -89,8 +88,10 @@ subroutine med_phases_restart_alarm_init(gcomp, rc) ! Set alarm for instantaneous mediator restart output call ESMF_ClockGet(mclock, currTime=mCurrTime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_time_alarmInit(mclock, alarm, option=restart_option, opt_n=restart_n, & + + call alarmInit(mclock, alarm, option=restart_option, opt_n=restart_n, & reftime=mcurrTime, alarmname='alarm_restart', rc=rc) + call ESMF_AlarmSet(alarm, clock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -147,7 +148,7 @@ subroutine med_phases_restart_write(gcomp, rc) use med_io_mod , only : med_io_close, med_io_date2yyyymmdd, med_io_sec2hms use med_phases_history_mod, only : auxcomp use med_constants_mod , only : SecPerDay => med_constants_SecPerDay - + use nuopc_shr_methods , only : shr_get_rpointer_name ! Input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -181,9 +182,9 @@ subroutine med_phases_restart_write(gcomp, rc) character(ESMF_MAXSTR) :: case_name ! case name character(ESMF_MAXSTR) :: restart_file ! Local path to restart filename character(ESMF_MAXSTR) :: restart_pfile ! Local path to restart pointer filename - character(ESMF_MAXSTR) :: cpl_inst_tag ! instance tag character(ESMF_MAXSTR) :: restart_dir ! Optional restart directory name character(ESMF_MAXSTR) :: cvalue ! attribute string + character(ESMF_MAXSTR) :: cpl_inst_tag ! instance tag logical :: alarmIsOn ! generic alarm flag real(R8) :: tbnds(2) ! CF1.0 time bounds logical :: isPresent @@ -207,14 +208,6 @@ subroutine med_phases_restart_write(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(isPresent) then - call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', value=cpl_inst_tag, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - cpl_inst_tag = "" - endif call NUOPC_CompAttributeGet(gcomp, name='restart_dir', isPresent=isPresent, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if(isPresent) then @@ -311,12 +304,20 @@ subroutine med_phases_restart_write(gcomp, rc) ! Use nexttimestr rather than currtimestr here since that is the time at the end of ! the timestep and is preferred for restart file names !--------------------------------------- + call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', isPresent=isPresent, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', value=cpl_inst_tag, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + cpl_inst_tag = "" + endif write(restart_file,"(6a)") trim(restart_dir)//trim(case_name),'.cpl', trim(cpl_inst_tag),'.r.',& trim(nexttimestr),'.nc' if (maintask) then - restart_pfile = "rpointer.cpl"//trim(cpl_inst_tag) + call shr_get_rpointer_name(gcomp, 'cpl', next_ymd, next_tod, restart_pfile, 'write', rc) call ESMF_LogWrite(trim(subname)//" write rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO) open(newunit=unitn, file=restart_pfile, form='FORMATTED') write(unitn,'(a)') trim(restart_file) @@ -495,13 +496,14 @@ subroutine med_phases_restart_read(gcomp, rc) ! Read mediator restart - use ESMF , only : ESMF_GridComp, ESMF_VM, ESMF_Clock, ESMF_Time, ESMF_MAXSTR - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE - use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_VMBroadCast - use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_ClockPrint - use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_TimeGet - use NUOPC , only : NUOPC_CompAttributeGet - use med_io_mod , only : med_io_read + use ESMF , only : ESMF_GridComp, ESMF_VM, ESMF_Clock, ESMF_Time, ESMF_MAXSTR + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_VMBroadCast + use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_ClockPrint + use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_TimeGet + use NUOPC , only : NUOPC_CompAttributeGet + use med_io_mod , only : med_io_read + use nuopc_shr_methods, only : shr_get_rpointer_name ! Input/output variables type(ESMF_GridComp) :: gcomp @@ -516,10 +518,10 @@ subroutine med_phases_restart_read(gcomp, rc) integer :: n integer :: ierr, unitn integer :: yr,mon,day,sec ! time units + integer :: curr_ymd character(ESMF_MAXSTR) :: case_name ! case name character(ESMF_MAXSTR) :: restart_file ! Local path to restart filename character(ESMF_MAXSTR) :: restart_pfile ! Local path to restart pointer filename - character(ESMF_MAXSTR) :: cpl_inst_tag ! instance tag logical :: isPresent character(len=*), parameter :: subname='(med_phases_restart_read)' !--------------------------------------- @@ -535,14 +537,6 @@ subroutine med_phases_restart_read(gcomp, rc) ! Get case name and inst suffix call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', value=cpl_inst_tag, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - cpl_inst_tag = "" - endif ! Get the clock info call ESMF_GridCompGet(gcomp, clock=clock) @@ -551,6 +545,8 @@ subroutine med_phases_restart_read(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ymd2date(yr,mon,day,curr_ymd) + write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO) @@ -561,15 +557,10 @@ subroutine med_phases_restart_read(gcomp, rc) endif ! Get the restart file name from the pointer file - restart_pfile = "rpointer.cpl"//trim(cpl_inst_tag) if (maintask) then + call shr_get_rpointer_name(gcomp, 'cpl', curr_ymd, sec, restart_pfile, 'read', rc) call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO) open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old', iostat=ierr) - if (ierr < 0) then - call ESMF_LogWrite(trim(subname)//' rpointer file open returns error', ESMF_LOGMSG_INFO) - rc=ESMF_Failure - return - end if read (unitn,'(a)', iostat=ierr) restart_file if (ierr < 0) then call ESMF_LogWrite(trim(subname)//' rpointer file read returns error', ESMF_LOGMSG_INFO) diff --git a/mediator/med_time_mod.F90 b/mediator/med_time_mod.F90 deleted file mode 100644 index 8a05c3671..000000000 --- a/mediator/med_time_mod.F90 +++ /dev/null @@ -1,302 +0,0 @@ -module med_time_mod - - use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_GridCompSet - use ESMF , only : ESMF_Clock, ESMF_ClockCreate, ESMF_ClockGet, ESMF_ClockSet - use ESMF , only : ESMF_ClockAdvance - use ESMF , only : ESMF_Alarm, ESMF_AlarmCreate, ESMF_AlarmGet, ESMF_AlarmSet - use ESMF , only : ESMF_Calendar, ESMF_CalKind_Flag, ESMF_CalendarCreate - use ESMF , only : ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN - use ESMF , only : ESMF_Time, ESMF_TimeGet, ESMF_TimeSet - use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet, ESMF_TimeIntervalGet - use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_FAILURE - use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast - use ESMF , only : ESMF_LOGMSG_INFO, ESMF_FAILURE, ESMF_LOGMSG_ERROR - use ESMF , only : operator(<), operator(/=), operator(+) - use ESMF , only : operator(-), operator(*) , operator(>=) - use ESMF , only : operator(<=), operator(>), operator(==) - use med_constants_mod , only : dbug_flag => med_constants_dbug_flag - use med_utils_mod , only : chkerr => med_utils_ChkErr - use med_internalstate_mod, only : maintask, logunit - - implicit none - private ! default private - - public :: med_time_alarmInit ! initialize an alarm - - ! Clock and alarm options - character(len=*), private, parameter :: & - optNONE = "none" , & - optNever = "never" , & - optNSteps = "nstep" , & - optNSeconds = "nsecond" , & - optNMinutes = "nminute" , & - optNHours = "nhour" , & - optNDays = "nday" , & - optNMonths = "nmonth" , & - optNYears = "nyear" , & - optMonthly = "monthly" , & - optYearly = "yearly" , & - optDate = "date" , & - optEnd = "end" , & - optGLCCouplingPeriod = "glc_coupling_period" - - ! Module data - integer, parameter :: SecPerDay = 86400 ! Seconds per day - character(len=*), parameter :: u_FILE_u = & - __FILE__ - -!=============================================================================== -contains -!=============================================================================== - - subroutine med_time_alarmInit( clock, alarm, option, & - opt_n, opt_ymd, opt_tod, reftime, alarmname, advance_clock, rc) - - ! Setup an alarm in a clock - ! Notes: The ringtime sent to AlarmCreate MUST be the next alarm - ! time. If you send an arbitrary but proper ringtime from the - ! past and the ring interval, the alarm will always go off on the - ! next clock advance and this will cause serious problems. Even - ! if it makes sense to initialize an alarm with some reference - ! time and the alarm interval, that reference time has to be - ! advance forward to be >= the current time. In the logic below - ! we set an appropriate "NextAlarm" and then we make sure to - ! advance it properly based on the ring interval. - - ! input/output variables - type(ESMF_Clock) , intent(inout) :: clock ! clock - type(ESMF_Alarm) , intent(inout) :: alarm ! alarm - character(len=*) , intent(in) :: option ! alarm option - integer , optional , intent(in) :: opt_n ! alarm freq - integer , optional , intent(in) :: opt_ymd ! alarm ymd - integer , optional , intent(in) :: opt_tod ! alarm tod (sec) - type(ESMF_Time) , optional , intent(in) :: reftime ! reference time - character(len=*) , optional , intent(in) :: alarmname ! alarm name - logical , optional , intent(in) :: advance_clock ! advance clock to trigger alarm - integer , intent(out) :: rc ! Return code - - ! local variables - type(ESMF_Calendar) :: cal ! calendar - integer :: lymd ! local ymd - integer :: ltod ! local tod - integer :: cyy,cmm,cdd,csec ! time info - character(len=64) :: lalarmname ! local alarm name - logical :: update_nextalarm ! update next alarm - type(ESMF_Time) :: CurrTime ! Current Time - type(ESMF_Time) :: NextAlarm ! Next alarm time - type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval - character(len=*), parameter :: subname = '(med_time_alarmInit): ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - lalarmname = 'alarm_unknown' - if (present(alarmname)) lalarmname = trim(alarmname) - ltod = 0 - if (present(opt_tod)) ltod = opt_tod - lymd = -1 - if (present(opt_ymd)) lymd = opt_ymd - - call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! initial guess of next alarm, this will be updated below - if (present(RefTime)) then - NextAlarm = RefTime - else - NextAlarm = CurrTime - endif - - ! Get calendar from clock - call ESMF_ClockGet(clock, calendar=cal) - - ! Error checks - if (trim(option) == optdate) then - if (.not. present(opt_ymd)) then - call ESMF_LogWrite(trim(subname)//trim(option)//' requires opt_ymd', ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - end if - if (lymd < 0 .or. ltod < 0) then - call ESMF_LogWrite(subname//trim(option)//'opt_ymd, opt_tod invalid', ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - end if - else if (& - trim(option) == optNSteps .or. trim(option) == trim(optNSteps)//'s' .or. & - trim(option) == optNSeconds .or. trim(option) == trim(optNSeconds)//'s' .or. & - trim(option) == optNMinutes .or. trim(option) == trim(optNMinutes)//'s' .or. & - trim(option) == optNHours .or. trim(option) == trim(optNHours)//'s' .or. & - trim(option) == optNDays .or. trim(option) == trim(optNDays)//'s' .or. & - trim(option) == optNMonths .or. trim(option) == trim(optNMonths)//'s' .or. & - trim(option) == optNYears .or. trim(option) == trim(optNYears)//'s' ) then - if (.not.present(opt_n)) then - call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - end if - if (opt_n <= 0) then - call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - end if - end if - - ! Determine inputs for call to create alarm - selectcase (trim(option)) - - case (optNONE) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optNever) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optEnd) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optDate) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_time_date2ymd(opt_ymd, cyy, cmm, cdd) - - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=cdd, s=ltod, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optNSteps,trim(optNSteps)//'s') - call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNSeconds,trim(optNSeconds)//'s') - call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMinutes,trim(optNMinutes)//'s') - call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNHours,trim(optNHours)//'s') - call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNDays,trim(optNDays)//'s') - call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMonths,trim(optNMonths)//'s') - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optMonthly) - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .true. - - case (optNYears, trim(optNYears)//'s') - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optYearly) - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .true. - case default - call ESMF_LogWrite(subname//'unknown option '//trim(option), ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - - end select - - ! -------------------------------------------------------------------------------- - ! --- AlarmInterval and NextAlarm should be set --- - ! -------------------------------------------------------------------------------- - - ! --- advance Next Alarm so it won't ring on first timestep for - ! --- most options above. go back one alarminterval just to be careful - - if (update_nextalarm) then - NextAlarm = NextAlarm - AlarmInterval - do while (NextAlarm <= CurrTime) - NextAlarm = NextAlarm + AlarmInterval - enddo - endif - - if (maintask) then - write(logunit,*) - write(logunit,'(a)') trim(subname) //' creating alarm '// trim(lalarmname) - end if - - alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, & - ringInterval=AlarmInterval, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Advance model clock to trigger alarm then reset model clock back to currtime - if (present(advance_clock)) then - if (advance_clock) then - call ESMF_AlarmSet(alarm, clock=clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(clock, currTime=CurrTime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockAdvance(clock,rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockSet(clock, currTime=currtime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end if - - end subroutine med_time_alarmInit - - !=============================================================================== - subroutine med_time_date2ymd (date, year, month, day) - - ! input/output variables - integer, intent(in) :: date ! coded-date (yyyymmdd) - integer, intent(out) :: year,month,day ! calendar year,month,day - - ! local variables - integer :: tdate ! temporary date - character(*),parameter :: subName = "(med_time_date2ymd)" - !------------------------------------------------------------------------------- - tdate = abs(date) - year = int(tdate/10000) - if (date < 0) then - year = -year - end if - month = int( mod(tdate,10000)/ 100) - day = mod(tdate, 100) - end subroutine med_time_date2ymd - -end module med_time_mod