diff --git a/cime_config/buildlib b/cime_config/buildlib index 08b3402..39a289b 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -19,6 +19,15 @@ from CIME.build import get_standard_makefile_args logger = logging.getLogger(__name__) +############################################################################### +def _get_osvar(key, default): +############################################################################### + if key in os.environ: + value = os.environ[key] + else: + value = default + return value + ############################################################################### def _build_mosart(): ############################################################################### @@ -35,6 +44,10 @@ def _build_mosart(): filepath_file = os.path.join(objroot,"rof","obj","Filepath") driver = case.get_value("COMP_INTERFACE").lower() + lilac_mode = _get_osvar('LILAC_MODE', 'off') + if lilac_mode == 'on': + driver = "lilac" + if not os.path.isfile(filepath_file): srcroot = case.get_value("SRCROOT") caseroot = case.get_value("CASEROOT") diff --git a/src/cpl/lilac/rof_comp_esmf.F90 b/src/cpl/lilac/rof_comp_esmf.F90 new file mode 100644 index 0000000..e97d151 --- /dev/null +++ b/src/cpl/lilac/rof_comp_esmf.F90 @@ -0,0 +1,646 @@ +module rof_comp_esmf + + !---------------------------------------------------------------------------- + ! This is the LILAC cap for MOSART + !---------------------------------------------------------------------------- + + ! external libraries + use ESMF + use shr_mpi_mod , only : shr_mpi_bcast + use mct_mod , only : mct_world_init + use perf_mod , only : t_startf, t_stopf, t_barrierf + + ! cime share code + use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl + use shr_sys_mod , only : shr_sys_abort + use shr_file_mod , only : shr_file_setLogUnit, shr_file_getLogUnit + use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date + use shr_nl_mod , only : shr_nl_find_group_name + + ! mosart code + use RtmVar , only : rtmlon, rtmlat, iulog + use RtmVar , only : nsrStartup, nsrContinue, nsrBranch + use RtmVar , only : inst_index, inst_suffix, inst_name, RtmVarSet + use RtmSpmd , only : RtmSpmdInit, masterproc, mpicom_rof, rofid, iam, npes + use RunoffMod , only : rtmCTL + use RtmMod , only : Rtmini, Rtmrun + use RtmTimeManager , only : timemgr_setup, get_curr_date, get_step_size, advance_timestep + use rof_import_export , only : import_fields, export_fields + use rof_shr_methods , only : chkerr, state_diagnose + + implicit none + private ! except + + ! Module routines + public :: rof_register ! register mosart initial, run, final methods + public :: rof_init ! mosart initialization + public :: rof_run ! mosart run phase + public :: rof_final ! mosart finalization/cleanup + + !-------------------------------------------------------------------------- + ! Private module data + !-------------------------------------------------------------------------- + + integer , parameter :: debug = 1 + character(*), parameter :: modName = "(rof_comp_esmf)" + character(*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine rof_register(comp, rc) + + ! Register the mosart initial, run, and final phase methods with ESMF. + + ! input/output argumenents + type(ESMF_GridComp) :: comp ! MOSART grid component + integer, intent(out) :: rc ! return status + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_LogSet ( flush =.true.) + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, rof_init, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, rof_run, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, rof_final, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_LogWrite("rof gridcompset entry points finished!", ESMF_LOGMSG_INFO) + + end subroutine rof_register + + !=============================================================================== + + subroutine rof_init(gcomp, importState, exportState, clock, rc) + + ! input/output variables + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + type(ESMF_VM) :: vm + integer :: mpicom_vm + logical :: flood_present ! flag + logical :: rof_prognostic ! flag + integer :: shrlogunit ! original log unit + integer :: lsize ! local size ofarrays + integer :: n,ni ! indices + integer :: lbnum ! input to memory diagnostic + integer :: nsrest ! restart type + integer :: ierr ! error code + character(CL) :: cvalue ! temporary + character(CL) :: caseid ! case identifier name + character(CL) :: starttype ! start-type (startup, continue, branch, hybrid) + + ! mesh generation + type(ESMF_Mesh) :: rof_mesh + character(ESMF_MAXSTR) :: rof_mesh_filename ! full filepath of river mesh file + type(ESMF_DistGrid) :: distgrid ! esmf global index space descriptor + integer :: fileunit ! input fileunit for reading mesh + integer , allocatable :: gindex(:) ! global index space on my processor + + ! generation of field bundles + type(ESMF_FieldBundle) :: c2r_fb ! field bundle in import state from river + type(ESMF_FieldBundle) :: r2c_fb ! field bundle in export state to river + + ! clock info + type(ESMF_Time) :: currTime ! Current time + type(ESMF_Time) :: startTime ! Start time + type(ESMF_Time) :: stopTime ! Stop time + type(ESMF_Time) :: refTime ! Ref time + type(ESMF_TimeInterval) :: timeStep ! Model timestep + type(ESMF_Calendar) :: esmf_calendar ! esmf calendar + type(ESMF_CalKind_Flag) :: esmf_caltype ! esmf calendar type + character(CL) :: calendar ! calendar type name + integer :: dtime_lilac + integer :: ref_ymd ! reference date (YYYYMMDD) + integer :: ref_tod ! reference time of day (sec) + integer :: yy,mm,dd ! Temporaries for time query + integer :: start_ymd ! start date (YYYYMMDD) + integer :: start_tod ! start time of day (sec) + integer :: stop_ymd ! stop date (YYYYMMDD) + integer :: stop_tod ! stop time of day (sec) + integer :: curr_ymd ! Start date (YYYYMMDD) + integer :: curr_tod ! Start time of day (sec) + + ! input namelist read for mosart mesh and run info + namelist /lilac_rof_input/ rof_mesh_filename + namelist /lilac_run_input/ caseid, starttype + + character(len=*), parameter :: subname=trim(modName)//':(rof_init) ' + !--------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + + !------------------------------------------------------------------------ + ! Query VM for local PET and mpi communicator + !------------------------------------------------------------------------ + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call ESMF_VMGet(vm, mpiCommunicator=mpicom_vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call ESMF_LogWrite(subname//"ESMF_VMGet", ESMF_LOGMSG_INFO) + + !---------------------------------------------------------------------------- + ! initialize MOSART MPI communicator + !---------------------------------------------------------------------------- + + ! The following call initializees the module variable mpicom_rof in RtmSpmd + call RtmSpmdInit(mpicom_vm) + + ! Set ROFID - needed for the mosart code that requires MCT + rofid = 1 + + !------------------------------------------------------------------------ + !--- Log File --- + !------------------------------------------------------------------------ + + ! TODO: by default iulog = 6 in mosart_varctl - this should be generalized so that we + ! can control the output log file for mosart running with a lilac driver + + inst_name = 'LND'; inst_index = 1; inst_suffix = "" + + ! Initialize io log unit + call shr_file_getLogUnit (shrlogunit) + if (.not. masterproc) then + iulog = shrlogunit ! All shr code output will go to iulog for masterproc + end if + call shr_file_setLogUnit (iulog) + + if (masterproc) then + write(iulog,*) "=========================================" + write(iulog,*) " starting (rof_comp_esmf): rof_comp_init " + write(iulog,*) " MOSART river model initialization" + end if + +#if (defined _MEMTRACE) + if (masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','rof_comp_esmf::',lbnum) + endif +#endif + + !---------------------- + ! Set time manager module variables + !---------------------- + + call ESMF_ClockGet( clock, & + currTime=currTime, startTime=startTime, stopTime=stopTime, refTime=RefTime, timeStep=timeStep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet( currTime, yy=yy, mm=mm, dd=dd, s=curr_tod, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yy,mm,dd,curr_ymd) + + call ESMF_TimeGet( startTime, yy=yy, mm=mm, dd=dd, s=start_tod, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yy,mm,dd,start_ymd) + + call ESMF_TimeGet( stopTime, yy=yy, mm=mm, dd=dd, s=stop_tod, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yy,mm,dd,stop_ymd) + + call ESMF_TimeGet( refTime, yy=yy, mm=mm, dd=dd, s=ref_tod, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_cal_ymd2date(yy,mm,dd,ref_ymd) + + call ESMF_TimeGet( currTime, calkindflag=esmf_caltype, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (esmf_caltype == ESMF_CALKIND_NOLEAP) then + calendar = shr_cal_noleap + else if (esmf_caltype == ESMF_CALKIND_GREGORIAN) then + calendar = shr_cal_gregorian + else + call shr_sys_abort( subname//'ERROR:: bad calendar for ESMF' ) + end if + + call timemgr_setup(& + calendar_in=calendar, & + start_ymd_in=start_ymd, & + start_tod_in=start_tod, & + ref_ymd_in=ref_ymd, & + ref_tod_in=ref_tod, & + stop_ymd_in=stop_ymd, & + stop_tod_in=stop_tod) + + !-------------------------------- + ! read in lilac_in namelists + !-------------------------------- + + if (masterproc) then + open(newunit=fileunit, status="old", file="lilac_in") + call shr_nl_find_group_name(fileunit, 'lilac_run_input', ierr) + if (ierr == 0) then + read(fileunit, lilac_run_input, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort( 'problem on read of lilac_run_input') + end if + end if + call shr_nl_find_group_name(fileunit, 'lilac_rof_input', ierr) + if (ierr == 0) then + read(fileunit, lilac_rof_input, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort( 'problem on read of lilac_rof_input') + end if + end if + close(fileunit) + end if + call shr_mpi_bcast(rof_mesh_filename, mpicom_rof) + call shr_mpi_bcast(starttype, mpicom_rof) + call shr_mpi_bcast(caseid, mpicom_rof) + + !-------------------------------- + ! Initialize RtmVar module variables + !-------------------------------- + + if (trim(starttype) == trim('startup')) then + nsrest = nsrStartup + else if (trim(starttype) == trim('continue') ) then + nsrest = nsrContinue + else + call shr_sys_abort( subname//' ERROR: unknown starttype' ) + end if + + !---------------------- + ! Read namelist, grid and surface data + !---------------------- + + if (masterproc) then + write(iulog,*) "MOSART river model initialization" + write(iulog,*) ' mosart npes = ',npes + write(iulog,*) ' mosart caseid = ',trim(caseid) + write(iulog,*) ' mosart nsrest = ',nsrest + endif + + call RtmVarSet(caseid_in=trim(caseid), ctitle_in=trim(caseid), nsrest_in=nsrest) + + !---------------------- + ! Initialize Mosart + !---------------------- + + ! - Read in mosart namelist + ! - Initialize mosart time manager + ! - Initialize number of mosart tracers + ! - Read input data (river direction file) (global) + ! - Deriver gridbox edges (global) + ! - Determine mosart ocn/land mask (global) + ! - Compute total number of basins and runoff ponts + ! - Compute river basins, actually compute ocean outlet gridcell + ! - Allocate basins to pes + ! - Count and distribute cells to rglo2gdc (determine rtmCTL%begr, rtmCTL%endr) + ! - Adjust area estimation from DRT algorithm for those outlet grids + ! - useful for grid-based representation only + ! - need to compute areas where they are not defined in input file + ! - Initialize runoff datatype (rtmCTL) + + ! TODO: are not handling rof_prognostic = .false. for now + + call ESMF_ClockGet( clock, timeStep=timeStep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeIntervalGet(timeStep, s=dtime_lilac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call Rtmini(rtm_active=rof_prognostic, flood_active=flood_present, dtime_driver=dtime_lilac) + + !-------------------------------- + ! generate the mesh and realize fields + !-------------------------------- + + ! determine global index array + lsize = rtmCTL%endr - rtmCTL%begr + 1 + allocate(gindex(lsize)) + ni = 0 + do n = rtmCTL%begr,rtmCTL%endr + ni = ni + 1 + gindex(ni) = rtmCTL%gindex(n) + end do + + ! create distGrid from global index array + DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + deallocate(gindex) + + ! create esmf mesh using distgrid and rof_mesh_filename + rof_mesh = ESMF_MeshCreate(filename=trim(rof_mesh_filename), fileformat=ESMF_FILEFORMAT_ESMFMESH, elementDistgrid=Distgrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (masterproc) then + write(iulog,*)'mesh file for domain is ',trim(rof_mesh_filename) + end if + call ESMF_LogWrite(subname//" Create Mesh using file ...."//trim(rof_mesh_filename), ESMF_LOGMSG_INFO) + + !-------------------------------- + ! Create mosart import state + !-------------------------------- + + ! create an empty field bundle of fields received from land + c2r_fb = ESMF_FieldBundleCreate (name='c2r_fb', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! now add fields on lnd_mesh to this field bundle + call fldbundle_add('Flrl_rofsur' , c2r_fb, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add('Flrl_rofgwl' , c2r_fb, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add('Flrl_rofsub' , c2r_fb, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add('Flrl_rofi' , c2r_fb, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add('Flrl_rof_irrig' , c2r_fb, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! add the field bundle to the import + call ESMF_StateAdd(importState, fieldbundleList = (/c2r_fb/)) + + !-------------------------------- + ! Create mosart export state + !-------------------------------- + + ! create an empty field bundle of field sent to alnd + r2c_fb = ESMF_FieldBundleCreate(name='r2c_fb', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create an empty field bundle for the import of rof fields + r2c_fb = ESMF_FieldBundleCreate (name='r2c_fb', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call fldbundle_add('Flrr_flood', r2c_fb, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add('Flrr_volr', r2c_fb, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbundle_add('Flrr_volrmch', r2c_fb, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! add the field bundle to the state + call ESMF_StateAdd(exportState, fieldbundleList = (/r2c_fb/)) + + !-------------------------------- + ! fill in mosart export state + !-------------------------------- + + call export_fields(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Add global size attributes to rof gridded component + call ESMF_AttributeAdd(gcomp, convention="custom", purpose="global grid sizes", rc=rc) + write(cvalue,*) dble(rtmlon) + call ESMF_AttributeSet(gcomp, "global_nx", cvalue, rc=rc) + write(cvalue,*) dble(rtmlat) + call ESMF_AttributeSet(gcomp, "global_ny", cvalue, rc=rc) + + !-------------------------------- + ! diagnostics + !-------------------------------- + + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + + if (debug > 1) then + call State_diagnose(exportState,subname//':ES',rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + +#if (defined _MEMTRACE) + if(masterproc) then + write(iulog,*) TRIM(Sub) // ':end::' + lbnum=1 + call memmon_dump_fort('memmon.out','rof_comp_esmf::',lbnum) + call memmon_reset_addr() + endif +#endif + + !--------------------------- + contains + !--------------------------- + + subroutine fldbundle_add(stdname, fieldbundle, rc) + !--------------------------- + ! Create an empty input field with name 'stdname' to add to fieldbundle + !--------------------------- + + ! input/output variables + character(len=*) , intent(in) :: stdname + type (ESMF_FieldBundle) , intent(inout) :: fieldbundle + integer , intent(out) :: rc + ! local variables + type(ESMF_Field) :: field + !------------------------------------------------------------------------------- + rc = ESMF_SUCCESS + field = ESMF_FieldCreate(rof_mesh, ESMF_TYPEKIND_R8 , meshloc=ESMF_MESHLOC_ELEMENT , name=trim(stdname), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleAdd(fieldbundle, (/field/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end subroutine fldbundle_add + + end subroutine rof_init + + !=============================================================================== + + subroutine rof_run(gcomp, import_state, export_state, clock, rc) + + !------------------------ + ! Run MOSART + !------------------------ + + ! input/output variables + type(ESMF_GridComp) :: gcomp ! MOSART gridded component + type(ESMF_State) :: import_state ! MOSART import state + type(ESMF_State) :: export_state ! MOSART export state + type(ESMF_Clock) :: clock ! ESMF synchronization clock + integer, intent(out) :: rc ! Return code + + ! local variables: + type(ESMF_Alarm) :: alarm + type(ESMF_Time) :: currTime + type(ESMF_Time) :: nextTime + character(CL) :: cvalue + integer :: dtime ! time step size + integer :: ymd_sync, ymd ! current date (YYYYMMDD) + integer :: yr_sync, yr ! current year + integer :: mon_sync, mon ! current month + integer :: day_sync, day ! current day + integer :: tod_sync, tod ! current time of day (sec) + logical :: rstwr ! .true. ==> write restart file before returning + logical :: nlend ! .true. ==> signaling last time-step + integer :: lbnum ! input to memory diagnostic + integer :: g,i ! indices + character(len=32) :: rdate ! date char string for restart file names + character(len=*),parameter :: subname=trim(modName)//':(rof_run) ' + !------------------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + +#if (defined _MEMTRACE) + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','runf_run:start::',lbnum) + endif +#endif + + !-------------------------------- + ! Unpack import state + !-------------------------------- + + call t_startf ('lc_mosart_import') + call import_fields(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf ('lc_mosart_import') + + !-------------------------------- + ! Determine if time to write restart + !-------------------------------- + + call ESMF_ClockGetAlarm(clock, alarmname='lilac_restart_alarm', alarm=alarm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + if (ChkErr(rc,__LINE__,u_FILE_u)) return + rstwr = .true. + call ESMF_AlarmRingerOff( alarm, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + rstwr = .false. + endif + + !-------------------------------- + ! Determine if time to stop + !-------------------------------- + + call ESMF_ClockGetAlarm(clock, alarmname='lilac_stop_alarm', alarm=alarm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + if (ChkErr(rc,__LINE__,u_FILE_u)) return + nlend = .true. + call ESMF_AlarmRingerOff( alarm, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + nlend = .false. + endif + + !-------------------------------- + ! Run MOSART + !-------------------------------- + + ! Restart File - 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 ESMF_ClockGetNextTime(clock, nextTime=nextTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet(nexttime, yy=yr_sync, mm=mon_sync, dd=day_sync, s=tod_sync, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_cal_ymd2date(yr_sync, mon_sync, day_sync, ymd_sync) + write(rdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr_sync, mon_sync, day_sync, tod_sync + + ! Advance mosart time + call advance_timestep() + + ! Run MOSART (export data is in rtmCTL and Trunoff data types) + call Rtmrun(rstwr, nlend, rdate) + + !-------------------------------- + ! Pack export state to mediator + !-------------------------------- + + ! (input is rtmCTL%runoff, output is r2x) + call t_startf ('lc_rof_export') + call export_fields(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf ('lc_rof_export') + + !-------------------------------- + ! Check that internal clock is in sync with master clock + !-------------------------------- + + dtime = get_step_size() + call get_curr_date( yr, mon, day, tod) + ymd = yr*10000 + mon*100 + day + tod = tod + + if ( (ymd /= ymd_sync) .and. (tod /= tod_sync) ) then + write(iulog,*)' mosart ymd=',ymd ,' mosart tod= ',tod + write(iulog,*)' sync ymd=',ymd_sync,' sync tod= ',tod_sync + rc = ESMF_FAILURE + call ESMF_LogWrite(subname//" MOSART clock not in sync with Master Sync clock",ESMF_LOGMSG_ERROR) + end if + + !-------------------------------- + ! diagnostics + !-------------------------------- + + if (debug > 1) then + call State_diagnose(export_state,subname//':ES',rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + end if + + if (masterproc) then + call ESMF_ClockPrint(clock, options="currTime", preString="------>Advancing ROF from: ", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call ESMF_ClockPrint(clock, options="stopTime", preString="--------------------------------> to: ", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + endif + +#if (defined _MEMTRACE) + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','rof_run:end::',lbnum) + call memmon_reset_addr() + endif +#endif + + end subroutine rof_run + + !=============================================================================== + + subroutine rof_final(gcomp, import_state, export_state, clock, rc) + + !--------------------------------- + ! Finalize MOSART + !--------------------------------- + + ! input/output variables + type(ESMF_GridComp) :: gcomp ! MOSART gridded component + type(ESMF_State) :: import_state ! MOSART import state + type(ESMF_State) :: export_state ! MOSART export state + type(ESMF_Clock) :: clock ! ESMF synchronization clock + integer, intent(out) :: rc ! Return code + + ! local variables + character(*), parameter :: F00 = "('(rof_final) ',8a)" + character(*), parameter :: F91 = "('(rof_final) ',73('-'))" + character(len=*),parameter :: subname=trim(modName)//':(ModelFinalize) ' + !------------------------------------------------------------------------------- + + !-------------------------------- + ! Finalize routine + !-------------------------------- + + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + + if (masterproc) then + write(iulog,F91) + write(iulog,F00) 'MOSART: end of main integration loop' + write(iulog,F91) + end if + + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + + end subroutine rof_final + +end module rof_comp_esmf diff --git a/src/cpl/lilac/rof_import_export.F90 b/src/cpl/lilac/rof_import_export.F90 new file mode 100644 index 0000000..332c043 --- /dev/null +++ b/src/cpl/lilac/rof_import_export.F90 @@ -0,0 +1,440 @@ +module rof_import_export + + use ESMF + use shr_kind_mod , only : r8 => shr_kind_r8, cx=>shr_kind_cx, cxx=>shr_kind_cxx, cs=>shr_kind_cs + use shr_sys_mod , only : shr_sys_abort + use rof_shr_methods , only : chkerr + use RunoffMod , only : rtmCTL, TRunoff + use RtmVar , only : iulog, nt_rtm, rtm_tracers + use RtmSpmd , only : masterproc + use RtmTimeManager , only : get_nstep + + implicit none + private ! except + + public :: import_fields + public :: export_fields + + private :: state_getimport + private :: state_setexport + private :: state_getfldptr + private :: check_for_nans + + integer ,parameter :: debug = 0 ! internal debug level + character(*),parameter :: F01 = "('(mosart_import_export) ',a,i5,2x,i8,2x,d21.14)" + character(*),parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine import_fields( gcomp, rc ) + + !--------------------------------------------------------------------------- + ! Obtain the runoff input from the mediator and convert from kg/m2s to m3/s + !--------------------------------------------------------------------------- + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! Local variables + type(ESMF_State) :: importState + integer :: n,nt + integer :: begr, endr + integer :: nliq, nfrz + character(len=*), parameter :: subname='(rof_import_export:import_fields)' + !--------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + + ! Get import state + call ESMF_GridCompGet(gcomp, importState=importState, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Set tracers + nliq = 0 + nfrz = 0 + do nt = 1,nt_rtm + if (trim(rtm_tracers(nt)) == 'LIQ') nliq = nt + if (trim(rtm_tracers(nt)) == 'ICE') nfrz = nt + enddo + if (nliq == 0 .or. nfrz == 0) then + write(iulog,*) trim(subname),': ERROR in rtm_tracers LIQ ICE ',nliq,nfrz,rtm_tracers + call shr_sys_abort() + endif + + begr = rtmCTL%begr + endr = rtmCTL%endr + + ! determine output array and scale by unit convertsion + ! NOTE: the call to state_getimport will convert from input kg/m2s to m3/s + + call state_getimport(importState, 'Flrl_rofsur', begr, endr, rtmCTL%area, output=rtmCTL%qsur(:,nliq), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'Flrl_rofsub', begr, endr, rtmCTL%area, output=rtmCTL%qsub(:,nliq), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'Flrl_rofgwl', begr, endr, rtmCTL%area, output=rtmCTL%qgwl(:,nliq), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'Flrl_rofi', begr, endr, rtmCTL%area, output=rtmCTL%qsur(:,nfrz), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_getimport(importState, 'Flrl_irrig', begr, endr, rtmCTL%area, output=rtmCTL%qirrig(:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + rtmCTL%qsub(begr:endr, nfrz) = 0.0_r8 + rtmCTL%qgwl(begr:endr, nfrz) = 0.0_r8 + + if (debug > 0 .and. masterproc .and. get_nstep() < 5) then + do n = begr,endr + write(iulog,F01)'import: nstep, n, Flrl_rofsur = ',get_nstep(),n,rtmCTL%qsur(n,nliq) + write(iulog,F01)'import: nstep, n, Flrl_rofsub = ',get_nstep(),n,rtmCTL%qsub(n,nliq) + write(iulog,F01)'import: nstep, n, Flrl_rofgwl = ',get_nstep(),n,rtmCTL%qgwl(n,nliq) + write(iulog,F01)'import: nstep, n, Flrl_rofi = ',get_nstep(),n,rtmCTL%qsur(n,nfrz) + write(iulog,F01)'import: nstep, n, Flrl_irrig = ',get_nstep(),n,rtmCTL%qirrig(n) + end do + end if + + end subroutine import_fields + + !==================================================================================== + + subroutine export_fields (gcomp, rc) + + !--------------------------------------------------------------------------- + ! Send the runoff model export state to the mediator and convert from m3/s to kg/m2s + !--------------------------------------------------------------------------- + + ! uses + use RtmVar, only : ice_runoff + + ! input/output/variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! Local variables + type(ESMF_State) :: exportState + integer :: n,nt + integer :: begr,endr + integer :: nliq, nfrz + real(r8), pointer :: rofl(:) + real(r8), pointer :: rofi(:) + real(r8), pointer :: flood(:) + real(r8), pointer :: volr(:) + real(r8), pointer :: volrmch(:) + logical, save :: first_time = .true. + character(len=*), parameter :: subname='(rof_import_export:export_fields)' + !--------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + + ! Get export state + call ESMF_GridCompGet(gcomp, exportState=exportState, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Set tracers + nliq = 0 + nfrz = 0 + do nt = 1,nt_rtm + if (trim(rtm_tracers(nt)) == 'LIQ') nliq = nt + if (trim(rtm_tracers(nt)) == 'ICE') nfrz = nt + enddo + if (nliq == 0 .or. nfrz == 0) then + write(iulog,*) trim(subname),': ERROR in rtm_tracers LIQ ICE ',nliq,nfrz,rtm_tracers + call shr_sys_abort() + endif + + if (first_time) then + if (masterproc) then + if ( ice_runoff )then + write(iulog,*)'Snow capping will flow out in frozen river runoff' + else + write(iulog,*)'Snow capping will flow out in liquid river runoff' + endif + endif + first_time = .false. + end if + + begr = rtmCTL%begr + endr = rtmCTL%endr + + allocate(rofl(begr:endr)) + allocate(rofi(begr:endr)) + allocate(flood(begr:endr)) + allocate(volr(begr:endr)) + allocate(volrmch(begr:endr)) + + if ( ice_runoff )then + ! separate liquid and ice runoff + do n = begr,endr + rofl(n) = rtmCTL%direct(n,nliq) / (rtmCTL%area(n)*0.001_r8) + rofi(n) = rtmCTL%direct(n,nfrz) / (rtmCTL%area(n)*0.001_r8) + if (rtmCTL%mask(n) >= 2) then + ! liquid and ice runoff are treated separately - this is what goes to the ocean + rofl(n) = rofl(n) + rtmCTL%runoff(n,nliq) / (rtmCTL%area(n)*0.001_r8) + rofi(n) = rofi(n) + rtmCTL%runoff(n,nfrz) / (rtmCTL%area(n)*0.001_r8) + end if + end do + else + ! liquid and ice runoff added to liquid runoff, ice runoff is zero + do n = begr,endr + rofl(n) = (rtmCTL%direct(n,nfrz) + rtmCTL%direct(n,nliq)) / (rtmCTL%area(n)*0.001_r8) + if (rtmCTL%mask(n) >= 2) then + rofl(n) = rofl(n) + (rtmCTL%runoff(n,nfrz) + rtmCTL%runoff(n,nliq)) / (rtmCTL%area(n)*0.001_r8) + endif + rofi(n) = 0._r8 + end do + end if + + ! Flooding back to land, sign convention is positive in land->rof direction + ! so if water is sent from rof to land, the flux must be negative. + ! scs: is there a reason for the wr+wt rather than volr (wr+wt+wh)? + ! volr(n) = (Trunoff%wr(n,nliq) + Trunoff%wt(n,nliq)) / rtmCTL%area(n) + + do n = begr, endr + flood(n) = -rtmCTL%flood(n) / (rtmCTL%area(n)*0.001_r8) + volr(n) = rtmCTL%volr(n,nliq)/ rtmCTL%area(n) + volrmch(n) = Trunoff%wr(n,nliq) / rtmCTL%area(n) + end do + + call state_setexport(exportState, 'Forr_rofl', begr, endr, input=rofl, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'Forr_rofi', begr, endr, input=rofi, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'Flrr_flood', begr, endr, input=flood, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'Flrr_volr', begr, endr, input=volr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call state_setexport(exportState, 'Flrr_volrmch', begr, endr, input=volrmch, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (debug > 0 .and. masterproc .and. get_nstep() < 5) then + do n = begr,endr + write(iulog,F01)'export: nstep, n, Flrr_flood = ',get_nstep(), n, flood(n) + write(iulog,F01)'export: nstep, n, Flrr_volr = ',get_nstep(), n, volr(n) + write(iulog,F01)'export: nstep, n, Flrr_volrmch = ',get_nstep(), n, volrmch(n) + write(iulog,F01)'export: nstep, n, Forr_rofl = ',get_nstep() ,n, rofl(n) + write(iulog,F01)'export: nstep, n, Forr_rofi = ',get_nstep() ,n, rofi(n) + end do + end if + + deallocate(rofl, rofi, flood, volr, volrmch) + + end subroutine export_fields + + !=============================================================================== + + subroutine state_getimport(state, fldname, begr, endr, area, output, rc) + + ! ---------------------------------------------- + ! Map import state field to output array + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State) , intent(in) :: state + character(len=*) , intent(in) :: fldname + integer , intent(in) :: begr + integer , intent(in) :: endr + real(r8) , intent(in) :: area(begr:endr) + real(r8) , intent(out) :: output(begr:endr) + integer , intent(out) :: rc + + ! local variables + integer :: g, i + real(R8), pointer :: fldptr(:) + type(ESMF_StateItem_Flag) :: itemFlag + character(len=*), parameter :: subname='(rof_import_export:state_getimport)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + ! Determine if field with name fldname exists in state + call ESMF_StateGet(state, trim(fldname), itemFlag, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! if field exists then create output array - else do nothing + if (itemflag /= ESMF_STATEITEM_NOTFOUND) then + + ! get field pointer + call state_getfldptr(state, trim(fldname), fldptr, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! determine output array and scale by unit convertsion + do g = begr,endr + output(g) = fldptr(g-begr+1) * area(g)*0.001_r8 + end do + + ! write debug output if appropriate + if (masterproc .and. debug > 0 .and. get_nstep() < 5) then + do g = begr,endr + i = 1 + g - begr + if (output(g) /= 0._r8) then + ! write(iulog,F01)'import: nstep, n, '//trim(fldname)//' = ',get_nstep(),g,output(g) + end if + end do + end if + + ! check for nans + call check_for_nans(fldptr, trim(fldname), begr) + end if + + end subroutine state_getimport + + !=============================================================================== + + subroutine state_setexport(state, fldname, begr, endr, input, rc) + + use shr_const_mod, only : fillvalue=>SHR_CONST_SPVAL + + ! ---------------------------------------------- + ! Map input array to export state field + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State) , intent(inout) :: state + character(len=*) , intent(in) :: fldname + integer , intent(in) :: begr + integer , intent(in) :: endr + real(r8) , intent(in) :: input(begr:endr) + integer , intent(out) :: rc + + ! local variables + integer :: g, i + real(R8), pointer :: fldptr(:) + type(ESMF_StateItem_Flag) :: itemFlag + character(len=*), parameter :: subname='(rof_import_export:state_setexport)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + ! Determine if field with name fldname exists in state + call ESMF_StateGet(state, trim(fldname), itemFlag, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! if field exists then create output array - else do nothing + if (itemflag /= ESMF_STATEITEM_NOTFOUND) then + + ! get field pointer + call state_getfldptr(state, trim(fldname), fldptr, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + fldptr(:) = 0._r8 + + ! set fldptr values to input array + do g = begr,endr + fldptr(g-begr+1) = input(g) + end do + + ! write debug output if appropriate + if (masterproc .and. debug > 0 .and. get_nstep() < 5) then + do g = begr,endr + i = 1 + g - begr + if (input(g) /= 0._r8) then +! write(iulog,F01)'export: nstep, n, '//trim(fldname)//' = ',get_nstep(),i,input(g) + end if + end do + end if + + ! check for nans + call check_for_nans(fldptr, trim(fldname), begr) + end if + + end subroutine state_setexport + + !=============================================================================== + + subroutine state_getfldptr(State, fldname, fldptr, rc) + + ! ---------------------------------------------- + ! Get pointer to a state field + ! ---------------------------------------------- + + type(ESMF_State), intent(in) :: State + character(len=*), intent(in) :: fldname + real(R8), pointer, intent(out) :: fldptr(:) + integer, intent(out) :: rc + + ! local variables + type(ESMF_FieldStatus_Flag) :: status + type(ESMF_Field) :: lfield + type(ESMF_Mesh) :: lmesh + integer :: nnodes, nelements + character(len=*), parameter :: subname='(rof_import_export:state_getfldptr)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + + call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(lfield, status=status, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (status /= ESMF_FIELDSTATUS_COMPLETE) then + call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + else + call ESMF_FieldGet(lfield, 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) then + call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif ! status + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + + end subroutine state_getfldptr + + !=============================================================================== + + subroutine check_for_nans(array, fname, begg) + + ! uses + use shr_infnan_mod, only : isnan => shr_infnan_isnan + + ! input/output variables + real(r8), pointer :: array(:) + character(len=*) , intent(in) :: fname + integer , intent(in) :: begg + + ! local variables + integer :: i + !------------------------------------------------------------------------------- + + ! Check if any input from mediator or output to mediator is NaN + + if (any(isnan(array))) then + write(iulog,*) '# of NaNs = ', count(isnan(array)) + write(iulog,*) 'Which are NaNs = ', isnan(array) + do i = 1, size(array) + if (isnan(array(i))) then + write(iulog,*) "NaN found in field ", trim(fname), ' at gridcell index ',begg+i-1 + end if + end do + call shr_sys_abort(' ERROR: One or more of the output from MOSART to the coupler are NaN ' ) + end if + end subroutine check_for_nans + +end module rof_import_export diff --git a/src/cpl/lilac/rof_shr_methods.F90 b/src/cpl/lilac/rof_shr_methods.F90 new file mode 100644 index 0000000..aab0fc3 --- /dev/null +++ b/src/cpl/lilac/rof_shr_methods.F90 @@ -0,0 +1,217 @@ +module rof_shr_methods + + use ESMF + 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 + + implicit none + private + + public :: state_diagnose + public :: chkerr + + private :: field_getfldptr + + ! Module data + character(len=1024) :: msgString + character(len=*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + 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,3g14.7,i8)') trim(string)//': '//trim(lfieldnamelist(n)), & + minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) + else + write(msgString,'(A,a)') trim(string)//': '//trim(lfieldnamelist(n))," no data" + endif + elseif (lrank == 2) then + if (size(dataPtr2d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(string)//': '//trim(lfieldnamelist(n)), & + minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) + else + write(msgString,'(A,a)') trim(string)//': '//trim(lfieldnamelist(n))," no data" + endif + else + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + 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 + +!=============================================================================== + + 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 rof_shr_methods diff --git a/src/riverroute/RtmMod.F90 b/src/riverroute/RtmMod.F90 index 494a2b6..7ef88d0 100644 --- a/src/riverroute/RtmMod.F90 +++ b/src/riverroute/RtmMod.F90 @@ -101,37 +101,20 @@ module RtmMod ! !EOP !----------------------------------------------------------------------- - contains - !----------------------------------------------------------------------- -!BOP -! -! !IROUTINE: Rtmini -! -! !INTERFACE: - subroutine Rtmini(rtm_active,flood_active) -! -! !DESCRIPTION: -! Initialize MOSART grid, mask, decomp -! -! !USES: -! -! !ARGUMENTS: - implicit none + + subroutine Rtmini(rtm_active,flood_active, dtime_driver) + + ! !DESCRIPTION: + ! Initialize MOSART grid, mask, decomp + + ! input/output variables logical, intent(out) :: rtm_active logical, intent(out) :: flood_active -! -! !CALLED FROM: -! subroutine initialize in module initializeMod -! -! !REVISION HISTORY: -! Author: Sam Levis -! Update: T Craig, Dec 2006 -! -! -! !LOCAL VARIABLES: -!EOP + integer, intent(in), optional :: dtime_driver + + ! local variables real(r8) :: effvel0 = 10.0_r8 ! default velocity (m/s) real(r8) :: effvel(nt_rtm) ! downstream velocity (m/s) real(r8) :: edgen ! North edge of the direction file @@ -273,12 +256,17 @@ subroutine Rtmini(rtm_active,flood_active) runtyp(nsrContinue + 1) = 'restart' runtyp(nsrBranch + 1) = 'branch ' + if (present(dtime_driver)) then + ! overwrite dtime with coupling_period instead of what is being used in the namelist + if (masterproc) then + write(iulog,*) 'WARNING: using coupling_period is set from dtime_driver rather than from what is read in the namelist' + end if + coupling_period = dtime_driver + end if + if (masterproc) then write(iulog,*) 'define run:' write(iulog,*) ' run type = ',runtyp(nsrest+1) - !write(iulog,*) ' case title = ',trim(ctitle) - !write(iulog,*) ' username = ',trim(username) - !write(iulog,*) ' hostname = ',trim(hostname) write(iulog,*) ' coupling_period = ',coupling_period write(iulog,*) ' delt_mosart = ',delt_mosart write(iulog,*) ' decomp option = ',trim(decomp_option) diff --git a/src/riverroute/RtmVar.F90 b/src/riverroute/RtmVar.F90 index 744cf01..eab9d90 100644 --- a/src/riverroute/RtmVar.F90 +++ b/src/riverroute/RtmVar.F90 @@ -80,22 +80,22 @@ subroutine RtmVarSet( caseid_in, ctitle_in, brnch_retain_casename_in, & ! Set input control variables. ! ! !ARGUMENTS: - character(len=CL), optional, intent(IN) :: caseid_in ! case id - character(len=CL), optional, intent(IN) :: ctitle_in ! case title - integer , optional, intent(IN) :: nsrest_in ! 0: initial run. 1: restart: 3: branch - character(len=CL), optional, intent(IN) :: version_in ! model version - character(len=CL), optional, intent(IN) :: hostname_in ! hostname running on - character(len=CL), optional, intent(IN) :: username_in ! username running job - character(len=CL), optional, intent(IN) :: model_doi_url_in ! web address of Digital Object Identifier (DOI) for model version - logical , optional, intent(IN) :: brnch_retain_casename_in ! true => allow case name to + character(len=*) , optional, intent(in) :: caseid_in ! case id + character(len=*) , optional, intent(in) :: ctitle_in ! case title + integer , optional, intent(in) :: nsrest_in ! 0: initial run. 1: restart: 3: branch + character(len=*) , optional, intent(in) :: version_in ! model version + character(len=*) , optional, intent(in) :: hostname_in ! hostname running on + character(len=*) , optional, intent(in) :: username_in ! username running job + character(len=*) , optional, intent(in) :: model_doi_url_in ! web address of Digital Object Identifier (DOI) for model version + logical , optional, intent(in) :: brnch_retain_casename_in ! true => allow case name to !----------------------------------------------------------------------- if ( RtmVar_isset )then call shr_sys_abort( 'RtmVarSet ERROR:: control variables already set -- EXIT' ) end if - if (present(caseid_in)) caseid = caseid_in - if (present(ctitle_in)) ctitle = ctitle_in + if (present(caseid_in)) caseid = trim(caseid_in) + if (present(ctitle_in)) ctitle = trim(ctitle_in) if (present(nsrest_in)) nsrest = nsrest_in if (present(version_in)) version = version_in if (present(username_in)) username = username_in