diff --git a/cime_config/config_archive.xml b/cime_config/config_archive.xml new file mode 100644 index 0000000000..ce663aeb91 --- /dev/null +++ b/cime_config/config_archive.xml @@ -0,0 +1,22 @@ + + + + r + rh\d* + h\d*.*\.nc$ + locfnh + + rpointer.rof$NINST_STRING + $CASE.mosart$NINST_STRING.r.$DATENAME.nc + + + rpointer.rof + rpointer.rof_9999 + casename.mosart.r.1976-01-01-00000.nc + casename.mosart.rh4.1976-01-01-00000.nc + casename.mosart.h0.1976-01-01-00000.nc + casename.mosart.h0.1976-01-01-00000.nc.base + + + + diff --git a/src/cpl/rof_comp_esmf.F90 b/src/cpl/rof_comp_esmf.F90 deleted file mode 100644 index 29df9ba3a0..0000000000 --- a/src/cpl/rof_comp_esmf.F90 +++ /dev/null @@ -1,797 +0,0 @@ -module rof_comp_esmf - -#ifdef ESMF_INTERFACE -!=============================================================================== -! Interface of the active river runoff componetn (mosart) model component of CESM -! with the main CESM driver. This is a thin interface taking CESM driver information -! in MCT (Model Coupling Toolkit) format and converting it to use by RTM and outputing -! if in ESMF (Earth System Modelling Framework) format. -! -! !DESCRIPTION: -! -! !USES: - use shr_kind_mod , only : r8 => shr_kind_r8, SHR_KIND_CL - use shr_file_mod , only : shr_file_setLogUnit, shr_file_setLogLevel, & - shr_file_getLogUnit, shr_file_getLogLevel, & - shr_file_getUnit, shr_file_setIO - use shr_const_mod , only : SHR_CONST_REARTH - use shr_sys_mod - use seq_timemgr_mod , only : seq_timemgr_EClockGetData, seq_timemgr_StopAlarmIsOn, & - seq_timemgr_RestartAlarmIsOn, seq_timemgr_EClockDateInSync - use seq_infodata_mod , only : seq_infodata_start_type_cont, & - seq_infodata_start_type_brnch, & - seq_infodata_start_type_start - use seq_comm_mct , only : seq_comm_suffix, seq_comm_inst, seq_comm_name - use seq_flds_mod - use esmf - use esmfshr_mod - use RunoffMod , only : rtmCTL, TRunoff - use RtmVar , only : rtmlon, rtmlat, ice_runoff, iulog, & - nsrStartup, nsrContinue, nsrBranch, & - inst_index, inst_suffix, inst_name, RtmVarSet - use RtmSpmd , only : masterproc, iam, npes, RtmSpmdInit, ROFID - use RtmMod , only : Rtmini, Rtmrun - use RtmTimeManager , only : timemgr_setup, get_curr_date, get_step_size, advance_timestep - use rof_cpl_indices , only : rof_cpl_indices_set, nt_rtm, rtm_tracers, & - index_r2x_Forr_rofl, index_r2x_Forr_rofi, & - index_x2r_Flrl_rofi, index_x2r_Flrl_rofsur, & - index_x2r_Flrl_rofgwl, index_x2r_Flrl_rofsub, & - index_r2x_Flrr_flood, & - index_r2x_Flrr_volr, index_r2x_Flrr_volrmch - use perf_mod , only : t_startf, t_stopf, t_barrierf -! -! !PUBLIC MEMBER FUNCTIONS: - implicit none - SAVE - private ! By default make data private -! -! !PUBLIC MEMBER FUNCTIONS: -! - public :: rof_register_esmf ! register rtm initial, run, final methods - public :: rof_init_esmf ! rtm initialization - public :: rof_run_esmf ! rtm run phase - public :: rof_final_esmf ! rtm finalization/cleanup -! -! ! PUBLIC DATA MEMBERS: None -! -! !REVISION HISTORY: -! Author: Mariana Vertenstein -! -! !PRIVATE MEMBER FUNCTIONS: - private :: rof_DistGrid_esmf ! Distribute river runoff grid - private :: rof_domain_esmf ! Set the river runoff model domain information - private :: rof_import_esmf ! Import data from the CESM coupler to the river runoff model - private :: rof_export_esmf ! Export the river runoff model data to the CESM coupler -! -! ! PRIVATE DATA MEMBERS: -! - -!=============================================================================== -contains -!=============================================================================== - - subroutine rof_register_esmf(comp, rc) - - !----------------------------------------------------------------------- - ! !DESCRIPTION: - ! Register the rof initial, run, and final phase methods with ESMF. - ! - ! !ARGUMENTS: - implicit none - type(ESMF_GridComp) :: comp ! CLM grid component - integer, intent(out) :: rc ! return status - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - rof_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - rof_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - rof_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - end subroutine rof_register_esmf - -!=============================================================================== - - subroutine rof_init_esmf(comp, import_state, export_state, EClock, rc) - - !--------------------------------------------------------------------------- - ! !DESCRIPTION: - ! Initialize runoff model (mosart) - ! - ! !ARGUMENTS: - implicit none - type(ESMF_GridComp) :: comp ! MOSART gridded component - type(ESMF_State) :: import_state ! MOSART import state - type(ESMF_State) :: export_state ! MOSART export state - type(ESMF_Clock) :: EClock ! ESMF synchronization clock - integer, intent(out) :: rc ! Return code - ! - ! !LOCAL VARIABLES: - logical :: rof_prognostic ! flag - logical :: flood_present ! flag - integer :: mpicom_rof, mpicom_vm, gsize - type(ESMF_DistGrid) :: distgrid - type(ESMF_Array) :: dom, x2r, r2x - type(ESMF_VM) :: vm - integer :: lsize ! size of attribute vector - integer :: g,i,j,n ! indices - logical :: exists ! true if file exists - integer :: nsrest ! restart type - integer :: ref_ymd ! reference date (YYYYMMDD) - integer :: ref_tod ! reference time of day (sec) - 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) - logical :: brnch_retain_casename ! flag if should retain the case name on a branch start type - integer :: lbnum ! input to memory diagnostic - integer :: shrlogunit,shrloglev ! old values for log unit and log level - integer :: begr, endr ! beg and end per-proc runoff indices - character(len=SHR_KIND_CL) :: caseid ! case identifier name - character(len=SHR_KIND_CL) :: ctitle ! case description title - character(len=SHR_KIND_CL) :: starttype ! start-type (startup, continue, branch, hybrid) - character(len=SHR_KIND_CL) :: calendar ! calendar type name - character(len=SHR_KIND_CL) :: hostname ! hostname of machine running on - character(len=SHR_KIND_CL) :: version ! Model version - character(len=SHR_KIND_CL) :: username ! user running the model - character(len=32), parameter :: sub = 'rof_init_esmf' - character(len=*), parameter :: format = "('("//trim(sub)//") :',A)" - character(ESMF_MAXSTR) :: convCIM, purpComp - !----------------------------------------------------------------------- - - ! Determine indices - - call rof_cpl_indices_set() - - rc = ESMF_SUCCESS - - ! Duplicate the mpi communicator from the current VM - - call ESMF_VMGetCurrent(vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_VMGet(vm, mpiCommunicator=mpicom_vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call MPI_Comm_dup(mpicom_vm, mpicom_rof, rc) - if(rc /= 0) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - ! Initialize mosart MPI communicator - - call ESMF_AttributeGet(export_state, name="ID", value=ROFID, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call RtmSpmdInit(mpicom_rof) - -#if (defined _MEMTRACE) - if(masterproc) then - lbnum=1 - call memmon_dump_fort('memmon.out','rof_init_esmf:start::',lbnum) - endif -#endif - - ! Initialize io log unit - - inst_name = seq_comm_name(ROFID) - inst_index = seq_comm_inst(ROFID) - inst_suffix = seq_comm_suffix(ROFID) - - call shr_file_getLogUnit (shrlogunit) - if (masterproc) then - inquire(file='rof_modelio.nml'//trim(inst_suffix),exist=exists) - if (exists) then - iulog = shr_file_getUnit() - call shr_file_setIO('rof_modelio.nml'//trim(inst_suffix),iulog) - end if - write(iulog,format) "MOSART model initialization" - else - iulog = shrlogunit - end if - - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (iulog) - - if (masterproc) then - write(iulog,*) ' mosart npes = ',npes - write(iulog,*) ' mosart iam = ',iam - write(iulog,*) ' mosart ROFID = ',ROFID - write(iulog,*) ' mosart name = ',trim(inst_name) - write(iulog,*) ' mosart inst = ',inst_index - write(iulog,*) ' mosart suffix = ',trim(inst_suffix) - endif - - ! Initialize MOSART - - call seq_timemgr_EClockGetData(EClock, & - start_ymd=start_ymd, & - start_tod=start_tod, ref_ymd=ref_ymd, & - ref_tod=ref_tod, stop_ymd=stop_ymd, & - stop_tod=stop_tod, & - calendar=calendar ) - - call ESMF_AttributeGet(export_state, name="case_name", value=caseid, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeGet(export_state, name="case_desc", value=ctitle, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeGet(export_state, name="brnch_retain_casename", & - value=brnch_retain_casename, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeGet(export_state, name="start_type", value=starttype, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeGet(export_state, name="model_version", value=version, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeGet(export_state, name="hostname", value=hostname, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeGet(export_state, name="username", value=username, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - 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) - - if ( trim(starttype) == trim(seq_infodata_start_type_start)) then - nsrest = nsrStartup - else if (trim(starttype) == trim(seq_infodata_start_type_cont) ) then - nsrest = nsrContinue - else if (trim(starttype) == trim(seq_infodata_start_type_brnch)) then - nsrest = nsrBranch - else - call shr_sys_abort( sub//' ERROR: unknown starttype' ) - end if - - call RtmVarSet(caseid_in=caseid, ctitle_in=ctitle, & - brnch_retain_casename_in=brnch_retain_casename, & - nsrest_in=nsrest, version_in=version, & - hostname_in=hostname, username_in=username) - - ! Initialize mosart and determine if mosart will be active - - call Rtmini(rtm_active=rof_prognostic,flood_active=flood_present) - - if ( rof_prognostic ) then - begr = rtmCTL%begr - endr = rtmCTL%endr - - ! Initialize rof distgrid and domain - - distgrid = rof_DistGrid_esmf(gsize, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="gsize", value=gsize, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - dom = mct2esmf_init(distgrid, attname=seq_flds_dom_fields, name="domain", rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call rof_domain_esmf( dom, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - ! Initialize rof import and export states - - r2x = mct2esmf_init(distgrid, attname=seq_flds_r2x_fields, name="d2x", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - x2r = mct2esmf_init(distgrid, attname=seq_flds_x2r_fields, name="x2d", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateAdd(export_state, (/dom/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateAdd(import_state, (/x2r/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateAdd(export_state, (/r2x/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - ! Create river runoff export state - - call rof_export_esmf(r2x, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - endif ! rof_prognostic - - call ESMF_AttributeSet(export_state, name="rof_present", value=rof_prognostic, rc=rc) - if( rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="rof_prognostic", value=rof_prognostic, rc=rc) - if( rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="rof_nx", value=rtmlon, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="rof_ny", value=rtmlat, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="flood_present", value=flood_present, rc=rc) - if( rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - - ! Reset shr logging to original values - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - -#if (defined _MEMTRACE) - if(masterproc) then - write(iulog,*) TRIM(Sub) // ':end::' - lbnum=1 - call memmon_dump_fort('memmon.out','rof_int_esmf:end::',lbnum) - call memmon_reset_addr() - endif -#endif - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "MOSART", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "River Runoff from MOSART", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "Description", & - "The MOSART component is " // & - "the river runoff model used in the CESM1.1. " // & - "More information on the MOSART project " // & - "and access to previous MOSART model versions and " // & - "documentation can be found via the MOSART Web Page.", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2012", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Runoff", & - convention=convCIM, purpose=purpComp, rc=rc) - - ! call ESMF_AttributeSet(comp, "Name", "Sam Levis", & - ! convention=convCIM, purpose=purpComp, rc=rc) - ! call ESMF_AttributeSet(comp, "EmailAddress", & - ! "slevis@ucar.edu", & - ! convention=convCIM, purpose=purpComp, rc=rc) - ! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & - ! convention=convCIM, purpose=purpComp, rc=rc) -#endif - - end subroutine rof_init_esmf - -!=============================================================================== - - subroutine rof_run_esmf(comp, import_state, export_state, EClock, rc) - - !--------------------------------------------------------------------------- - ! !DESCRIPTION: - ! Run mosart model - ! - ! !ARGUMENTS: - implicit none - type(ESMF_GridComp) :: comp ! MOSART gridded component - type(ESMF_State) :: import_state ! MOSART import state - type(ESMF_State) :: export_state ! MOSART export state - type(ESMF_Clock) :: EClock ! ESMF synchronization clock - integer, intent(out) :: rc ! Return code - ! - ! !LOCAL VARIABLES: - type(ESMF_Array) :: x2r, r2x, dom - integer :: ymd_sync ! Sync date (YYYYMMDD) - integer :: yr_sync ! Sync current year - integer :: mon_sync ! Sync current month - integer :: day_sync ! Sync current day - integer :: tod_sync ! Sync current time of day (sec) - integer :: ymd ! MOSART current date (YYYYMMDD) - integer :: yr ! MOSART current year - integer :: mon ! MOSART current month - integer :: day ! MOSART current day - integer :: tod ! MOSART current time of day (sec) - logical :: rstwr_sync ! .true. ==> write restart file before returning - logical :: rstwr ! .true. ==> write restart file before returning - logical :: nlend_sync ! Flag signaling last time-step - logical :: nlend ! .true. ==> last time-step - integer :: shrlogunit,shrloglev ! old values - integer :: begg, endg ! Beginning and ending gridcell index numbers - integer :: lbnum ! input to memory diagnostic - integer :: g,i,kf ! counters - character(len=32) :: rdate ! date char string for restart file names - character(len=32), parameter :: sub = "rof_run_esmf" - !--------------------------------------------------------------------------- - - call t_startf ('lc_rof_run1') - rc = ESMF_SUCCESS - -#if (defined _MEMTRACE) - if(masterproc) then - lbnum=1 - call memmon_dump_fort('memmon.out','rof_run_esmf:start::',lbnum) - endif -#endif - - ! Reset shr logging to my log file - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (iulog) - - call seq_timemgr_EClockGetData(EClock, & - curr_ymd=ymd, curr_tod=tod_sync, & - curr_yr=yr_sync, curr_mon=mon_sync, curr_day=day_sync) - - ! Map ESMF to mosart input (rof) data type - - call t_startf ('lc_rof_import') - call ESMF_StateGet(import_state, itemName="x2d", array=x2r, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call rof_import_esmf( x2r, rc=rc ) - call t_stopf ('lc_rof_import') - - ! Run mosart (input is *runin, output is rtmCTL%runoff) - ! First advance mosart time step - - write(rdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr_sync,mon_sync,day_sync,tod_sync - nlend = seq_timemgr_StopAlarmIsOn( EClock ) - rstwr = seq_timemgr_RestartAlarmIsOn( EClock ) - call advance_timestep() - call Rtmrun(rstwr,nlend,rdate) - - ! Map roff data to MCT datatype (input is rtmCTL%runoff, output is r2x_r) - - call t_startf ('lc_rof_export') - call ESMF_StateGet(export_state, itemName="d2x", array=r2x, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call rof_export_esmf( r2x, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call t_stopf ('lc_rof_export') - - call get_curr_date( yr, mon, day, tod) - ymd = yr*10000 + mon*100 + day - tod = tod - if ( .not. seq_timemgr_EClockDateInSync( EClock, ymd, tod ) )then - call seq_timemgr_EclockGetData( EClock, curr_ymd=ymd_sync, curr_tod=tod_sync ) - write(iulog,*)' mosart ymd=',ymd ,' mosart tod= ',tod - write(iulog,*)'sync ymd=',ymd_sync,' sync tod= ',tod_sync - call shr_sys_abort( sub//":: MOSART clock not in sync with Master Sync clock" ) - end if - - ! Reset shr logging to my original values - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - -#if (defined _MEMTRACE) - if(masterproc) then - lbnum=1 - call memmon_dump_fort('memmon.out','rof_run_esmf:end::',lbnum) - call memmon_reset_addr() - endif -#endif - - end subroutine rof_run_esmf - -!=============================================================================== - - subroutine rof_final_esmf(comp, import_state, export_state, EClock, rc) - - !------------------------------------------------------------------------------ - ! !DESCRIPTION: - ! Finalize mosart - ! - ! !ARGUMENTS: - implicit none - type(ESMF_GridComp) :: comp ! MOSART gridded component - type(ESMF_State) :: import_state ! MOSART import state - type(ESMF_State) :: export_state ! MOSART export state - type(ESMF_Clock) :: EClock ! ESMF synchronization clock - integer, intent(out) :: rc ! Return code - !--------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! Destroy ESMF objects - call esmfshr_util_StateArrayDestroy(export_state,'domain',rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call esmfshr_util_StateArrayDestroy(export_state,'d2x',rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call esmfshr_util_StateArrayDestroy(import_state,'x2d',rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - end subroutine rof_final_esmf - -!=============================================================================== - - function rof_DistGrid_esmf(gsize, rc) - - !--------------------------------------------------------------------------- - ! !DESCRIPTION: - ! Set the ESMF distributed grid for the runoff model - ! - ! RETURN - implicit none - type(ESMF_DistGrid) :: rof_DistGrid_esmf - ! - ! ARGUMENTS: - integer, intent(out) :: gsize ! Grid size - integer, intent(out) :: rc ! Return code - ! - ! Local Variables - integer,allocatable :: gindex(:) ! indexing for runoff grid cells - integer :: n, ni ! indices - integer :: lsize ! size of runoff data and number of grid cells - integer :: begr, endr ! beg, end runoff indices - integer :: ier ! error code - character(len=32), parameter :: sub = 'rof_DistGrid_esmf' - !------------------------------------------------------------------- - - ! Build the rof grid numbering - ! NOTE: Numbering scheme is: West to East and South to North - ! starting at south pole. Should be the same as what's used in SCRIP - - rc = ESMF_SUCCESS - - begr = rtmCTL%begr - endr = rtmCTL%endr - lsize = rtmCTL%lnumr - gsize = rtmlon*rtmlat - - ! Check - ni = 0 - do n = begr,endr - ni = ni + 1 - if (ni > lsize) then - write(iulog,*) sub, ' : ERROR runoff count',n,ni,rtmCTL%lnumr - call shr_sys_abort( sub//' ERROR: runoff > expected' ) - endif - end do - if (ni /= lsize) then - write(iulog,*) sub, ' : ERROR runoff total count',ni,rtmCTL%lnumr - call shr_sys_abort( sub//' ERROR: runoff not equal to expected' ) - endif - - ! Determine rof distgrid - allocate(gindex(lsize),stat=ier) - ni = 0 - do n = begr,endr - ni = ni + 1 - gindex(ni) = rtmCTL%gindex(n) - end do - rof_DistGrid_esmf = mct2esmf_init(gindex, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - deallocate(gindex) - - end function rof_DistGrid_esmf - -!=============================================================================== - - subroutine rof_domain_esmf( dom, rc ) - - !--------------------------------------------------------------------------- - ! !DESCRIPTION: - ! - ! Send the runoff model domain information to the coupler - ! - ! !ARGUMENTS: - implicit none - type(ESMF_Array), intent(inout) :: dom ! Domain information - integer, intent(out) :: rc ! Return code - ! - ! Local Variables - integer :: n, ni ! index - integer :: klon,klat,karea,kmask,kfrac ! domain fields - real(r8) :: re = SHR_CONST_REARTH*0.001_r8 ! radius of earth (km) - real(R8), pointer :: fptr(:,:) - character(len=32), parameter :: sub = 'rof_domain_esmf' - !------------------------------------------------------------------- - ! - ! Initialize domain type - ! lat/lon in degrees, area in radians^2 - ! - rc = ESMF_SUCCESS - - call ESMF_ArrayGet(dom, localDe=0, farrayPtr=fptr, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - ! Fill in correct values for domain components - klon = esmfshr_util_ArrayGetIndex(dom,'lon ',rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - klat = esmfshr_util_ArrayGetIndex(dom,'lat ',rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - karea = esmfshr_util_ArrayGetIndex(dom,'area',rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - kmask = esmfshr_util_ArrayGetIndex(dom,'mask',rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - kfrac = esmfshr_util_ArrayGetIndex(dom,'frac',rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - ! Fill in correct values for domain components - ! Note aream will be filled in in the atm-lnd mapper - - fptr(:,:) = -9999.0_R8 - ni = 0 - do n = rtmCTL%begr,rtmCTL%endr - ni = ni + 1 - fptr(klon , ni) = rtmCTL%lonc(n) - fptr(klat , ni) = rtmCTL%latc(n) - fptr(karea, ni) = rtmCTL%area(n)*1.0e-6_r8/(re*re) - fptr(kmask, ni) = 1.0_r8 - fptr(kfrac, ni) = 1.0_r8 - end do - - end subroutine rof_domain_esmf - -!==================================================================================== - - subroutine rof_import_esmf( x2r_array, rc) - - !--------------------------------------------------------------------------- - ! DESCRIPTION: - ! Obtain the runoff input from the coupler - ! convert from kg/m2s to m3/s - ! - ! ARGUMENTS: - implicit none - type(ESMF_Array), intent(inout) :: x2r_array - integer , intent(out) :: rc - ! - ! LOCAL VARIABLES - real(R8), pointer :: fptr(:, :) - integer :: n2, n, nt, begr, endr, nliq, nfrz - character(len=32), parameter :: sub = 'rof_import_mct' - !--------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - nliq = 0 - nfrz = 0 - do nt = 1,nt_rtm - if (trim(rtm_tracers(nt)) == 'LIQ') then - nliq = nt - endif - if (trim(rtm_tracers(nt)) == 'ICE') then - nfrz = nt - endif - enddo - if (nliq == 0 .or. nfrz == 0) then - write(iulog,*) sub,': ERROR in rtm_tracers LIQ ICE ',nliq,nfrz,rtm_tracers - call shr_sys_abort() - endif - - call ESMF_ArrayGet(x2r_array, localDe=0, farrayPtr=fptr, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - begr = rtmCTL%begr - endr = rtmCTL%endr - do n = begr,endr - n2 = n - begr + 1 - - rtmCTL%qsur(n,nliq) = fptr(index_x2r_Flrl_rofsur,n2) * (rtmCTL%area(n)*0.001_r8) - rtmCTL%qsub(n,nliq) = fptr(index_x2r_Flrl_rofsub,n2) * (rtmCTL%area(n)*0.001_r8) - rtmCTL%qgwl(n,nliq) = fptr(index_x2r_Flrl_rofgwl,n2) * (rtmCTL%area(n)*0.001_r8) - rtmCTL%qsur(n,nfrz) = fptr(index_x2r_Flrl_rofi,n2) * (rtmCTL%area(n)*0.001_r8) - rtmCTL%qsub(n,nfrz) = 0.0_r8 - rtmCTL%qgwl(n,nfrz) = 0.0_r8 - - enddo - - end subroutine rof_import_esmf - -!==================================================================================== - - subroutine rof_export_esmf( r2x_array, rc) - - !--------------------------------------------------------------------------- - ! !DESCRIPTION: - ! Send the mosart export state to the CESM coupler - ! convert from kg/m2s to m3/s - ! - ! !ARGUMENTS: - implicit none - type(ESMF_Array), intent(inout) :: r2x_array - integer, intent(out) :: rc - ! - ! Local variables - integer :: ni, n, nt, nliq, nfrz - real(R8), pointer :: fptr(:, :) - logical,save :: first_time = .true. - character(len=*), parameter :: sub = 'rof_export_esmf' - !--------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - nliq = 0 - nfrz = 0 - do nt = 1,nt_rtm - if (trim(rtm_tracers(nt)) == 'LIQ') then - nliq = nt - endif - if (trim(rtm_tracers(nt)) == 'ICE') then - nfrz = nt - endif - enddo - if (nliq == 0 .or. nfrz == 0) then - write(iulog,*)'RtmUpdateInput: ERROR in rtm_tracers LIQ ICE ',nliq,nfrz,rtm_tracers - call shr_sys_abort() - endif - - call ESMF_ArrayGet(r2x_array, localDe=0, farrayPtr=fptr, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - fptr(:,:) = 0._r8 - - 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 - - ni = 0 - if ( ice_runoff )then - ! separate liquid and ice runoff - do n = rtmCTL%begr,rtmCTL%endr - ni = ni + 1 - fptr(index_r2x_Forr_rofl,ni) = rtmCTL%direct(n,nliq) / (rtmCTL%area(n)*0.001_r8) - fptr(index_r2x_Forr_rofi,ni) = rtmCTL%direct(n,nfrz) / (rtmCTL%area(n)*0.001_r8) - if (rtmCTL%mask(n) >= 2) then - fptr(index_r2x_Forr_rofl,ni) = fptr(index_r2x_Forr_rofl,ni) + & - rtmCTL%runoff(n,nliq) / (rtmCTL%area(n)*0.001_r8) - fptr(index_r2x_Forr_rofi,ni) = fptr(index_r2x_Forr_rofi,ni) + & - rtmCTL%runoff(n,nfrz) / (rtmCTL%area(n)*0.001_r8) - if (ni > rtmCTL%lnumr) then - write(iulog,*) sub, ' : ERROR runoff count',n,ni - call shr_sys_abort( sub//' : ERROR runoff > expected' ) - endif - endif - end do - else - ! liquid and ice runoff added to liquid runoff, ice runoff is zero - do n = rtmCTL%begr,rtmCTL%endr - ni = ni + 1 - fptr(index_r2x_Forr_rofl,ni) = & - (rtmCTL%direct(n,nfrz)+rtmCTL%direct(n,nliq)) / (rtmCTL%area(n)*0.001_r8) - if (rtmCTL%mask(n) >= 2) then - fptr(index_r2x_Forr_rofl,ni) = fptr(index_r2x_Forr_rofl,ni) + & - (rtmCTL%runoff(n,nfrz)+rtmCTL%runoff(n,nliq))/(rtmCTL%area(n)*0.001_r8) - if (ni > rtmCTL%lnumr) then - write(iulog,*) sub, ' : ERROR runoff count',n,ni - call shr_sys_abort( sub//' : ERROR runoff > expected' ) - endif - endif - 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. - ni = 0 - do n = rtmCTL%begr, rtmCTL%endr - ni = ni + 1 - fptr(index_r2x_Flrr_flood,ni) = -rtmCTL%flood(n)/(rtmCTL%area(n)*0.001_r8) - fptr(index_r2x_Flrr_volr,ni) = (Trunoff%wr(n,nliq) + Trunoff%wt(n,nliq)) / rtmCTL%area(n) - fptr(index_r2x_Flrr_volrmch,ni) = Trunoff%wr(n,nliq) / rtmCTL%area(n) - end do - - end subroutine rof_export_esmf - -#endif -end module rof_comp_esmf diff --git a/src/cpl/rof_comp_mct.F90 b/src/cpl/rof_comp_mct.F90 index 3a89bb3f74..f07b7a0c71 100644 --- a/src/cpl/rof_comp_mct.F90 +++ b/src/cpl/rof_comp_mct.F90 @@ -107,6 +107,7 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) character(len=SHR_KIND_CL) :: hostname ! hostname of machine running on character(len=SHR_KIND_CL) :: version ! Model version character(len=SHR_KIND_CL) :: username ! user running the model + character(len=SHR_KIND_CL) :: model_doi_url ! Web address for model Digital Object Identifier (DOI) character(len=32), parameter :: sub = 'rof_init_mct' character(len=*), parameter :: format = "('("//trim(sub)//") :',A)" !--------------------------------------------------------------------------- @@ -167,6 +168,7 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) case_desc=ctitle, start_type=starttype, & brnch_retain_casename=brnch_retain_casename, & model_version=version, & + model_doi_url=model_doi_url, & hostname=hostname, username=username) call timemgr_setup(calendar_in=calendar, & @@ -187,6 +189,7 @@ subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) call RtmVarSet(caseid_in=caseid, ctitle_in=ctitle, & brnch_retain_casename_in=brnch_retain_casename, & nsrest_in=nsrest, version_in=version, & + model_doi_url_in=model_doi_url, & hostname_in=hostname, username_in=username) ! Read namelist, grid and surface data diff --git a/src/riverroute/RtmHistFile.F90 b/src/riverroute/RtmHistFile.F90 index d215db91d8..13e4dcd28f 100644 --- a/src/riverroute/RtmHistFile.F90 +++ b/src/riverroute/RtmHistFile.F90 @@ -3,7 +3,7 @@ module RtmHistFile ! !MODULE: RtmHistFileMod ! ! !DESCRIPTION: -! Module containing methods to for RTM history file handling. +! Module containing methods to for MOSART history file handling. ! ! !USES: use shr_kind_mod , only : r8 => shr_kind_r8 @@ -12,7 +12,8 @@ module RtmHistFile use RunoffMod , only : rtmCTL, Tunit use RtmVar , only : rtmlon, rtmlat, spval, ispval, secspday, frivinp_rtm, & iulog, nsrest, caseid, inst_suffix, nsrStartup, nsrBranch, & - ctitle, version, hostname, username, conventions, source + ctitle, version, hostname, username, conventions, source, & + model_doi_url use RtmFileUtils , only : get_filename, getfil use RtmTimeManager, only : get_nstep, get_curr_date, get_curr_time, get_ref_date, & get_prev_time, get_prev_date, is_last_step, get_step_size @@ -227,7 +228,7 @@ subroutine RtmHistHtapesBuild () !---------------------------------------------------------- if (masterproc) then - write(iulog,*) trim(subname),' Initializing RTM history files' + write(iulog,*) trim(subname),' Initializing MOSART history files' write(iulog,'(72a1)') ("-",i=1,60) call shr_sys_flush(iulog) endif @@ -293,7 +294,7 @@ subroutine RtmHistHtapesBuild () end do if (masterproc) then - write(iulog,*) trim(subname),' Successfully initialized RTM history files' + write(iulog,*) trim(subname),' Successfully initialized MOSART history files' write(iulog,'(72a1)') ("-",i=1,60) call shr_sys_flush(iulog) endif @@ -449,16 +450,16 @@ subroutine htapes_fieldlist() end if if (masterproc) then - write(iulog,*) 'There will be a total of ',ntapes,'RTM history tapes' + write(iulog,*) 'There will be a total of ',ntapes,'MOSART history tapes' do t=1,ntapes write(iulog,*) if (rtmhist_nhtfrq(t) == 0) then - write(iulog,*)'RTM History tape ',t,' write frequency is MONTHLY' + write(iulog,*)'MOSART History tape ',t,' write frequency is MONTHLY' else - write(iulog,*)'RTM History tape ',t,' write frequency = ',rtmhist_nhtfrq(t) + write(iulog,*)'MOSART History tape ',t,' write frequency = ',rtmhist_nhtfrq(t) endif - write(iulog,*)'Number of time samples on RTM history tape ',t,' is ',rtmhist_mfilt(t) - write(iulog,*)'Output precision on RTM history tape ',t,'=',rtmhist_ndens(t) + write(iulog,*)'Number of time samples on MOSART history tape ',t,' is ',rtmhist_mfilt(t) + write(iulog,*)'Output precision on MOSART history tape ',t,'=',rtmhist_ndens(t) write(iulog,*) end do call shr_sys_flush(iulog) @@ -674,7 +675,7 @@ subroutine htape_create (t, histrest) call shr_sys_flush(iulog) end if call ncd_pio_createfile(lnfid, trim(locfnh(t))) - call ncd_putatt(lnfid, ncd_global, 'title', 'RTM History file information' ) + call ncd_putatt(lnfid, ncd_global, 'title', 'MOSART History file information' ) call ncd_putatt(lnfid, ncd_global, 'comment', & "NOTE: None of the variables are weighted by land fraction!" ) else @@ -685,7 +686,7 @@ subroutine htape_create (t, histrest) end if call ncd_pio_createfile(lnfid, trim(locfnhr(t))) call ncd_putatt(lnfid, ncd_global, 'title', & - 'RTM Restart History information, required to continue a simulation' ) + 'MOSART Restart History information, required to continue a simulation' ) call ncd_putatt(lnfid, ncd_global, 'comment', & "This entire file NOT needed for startup or branch simulations") end if @@ -697,15 +698,13 @@ subroutine htape_create (t, histrest) call ncd_putatt(lnfid, ncd_global, 'Conventions', trim(conventions)) call getdatetime(curdate, curtime) str = 'created on ' // curdate // ' ' // curtime - call ncd_putatt(lnfid, ncd_global, 'history' , trim(str)) - call ncd_putatt(lnfid, ncd_global, 'source' , trim(source)) - call ncd_putatt(lnfid, ncd_global, 'hostname', trim(hostname)) - call ncd_putatt(lnfid, ncd_global, 'username', trim(username)) - call ncd_putatt(lnfid, ncd_global, 'version' , trim(version)) - - str = & - '$Id: histFileMod.F90 36692 2012-04-27 18:39:55Z tcraig $' - call ncd_putatt(lnfid, ncd_global, 'revision_id', trim(str)) + call ncd_putatt(lnfid, ncd_global, 'history' , trim(str)) + call ncd_putatt(lnfid, ncd_global, 'source' , trim(source)) + call ncd_putatt(lnfid, ncd_global, 'hostname' , trim(hostname)) + call ncd_putatt(lnfid, ncd_global, 'username' , trim(username)) + call ncd_putatt(lnfid, ncd_global, 'version' , trim(version)) + call ncd_putatt(lnfid, ncd_global, 'model_doi_url', trim(model_doi_url)) + call ncd_putatt(lnfid, ncd_global, 'case_title', trim(ctitle)) call ncd_putatt(lnfid, ncd_global, 'case_id', trim(caseid)) diff --git a/src/riverroute/RtmRestFile.F90 b/src/riverroute/RtmRestFile.F90 index 6db337e41e..d0e45cc721 100644 --- a/src/riverroute/RtmRestFile.F90 +++ b/src/riverroute/RtmRestFile.F90 @@ -6,7 +6,7 @@ module RtmRestFile ! !MODULE: restFileMod ! ! !DESCRIPTION: -! Reads from or writes to/ the RTM restart file. +! Reads from or writes to/ the MOSART restart file. ! ! !USES: use shr_kind_mod , only : r8 => shr_kind_r8 @@ -58,7 +58,7 @@ subroutine RtmRestFileWrite( file, rdate ) !----------------------------------------------------------------------- ! !DESCRIPTION: - ! Read/write RTM restart file. + ! Read/write MOSART restart file. ! !ARGUMENTS: implicit none @@ -75,7 +75,7 @@ subroutine RtmRestFileWrite( file, rdate ) if (masterproc) then write(iulog,*) - write(iulog,*)'restFile_open: writing RTM restart dataset ' + write(iulog,*)'restFile_open: writing MOSART restart dataset ' write(iulog,*) end if call ncd_pio_createfile(ncid, trim(file)) @@ -114,7 +114,7 @@ end subroutine RtmRestFileWrite subroutine RtmRestFileRead( file ) ! !DESCRIPTION: - ! Read a RTM restart file. + ! Read a MOSART restart file. ! ! !ARGUMENTS: implicit none @@ -146,7 +146,7 @@ end subroutine RtmRestFileRead subroutine RtmRestTimeManager( file ) ! !DESCRIPTION: - ! Read a RTM restart file. + ! Read a MOSART restart file. ! ! !ARGUMENTS: implicit none @@ -352,12 +352,10 @@ subroutine restFile_dimset( ncid ) call ncd_putatt(ncid, NCD_GLOBAL, 'host' , trim(hostname)) call ncd_putatt(ncid, NCD_GLOBAL, 'version' , trim(version)) call ncd_putatt(ncid, NCD_GLOBAL, 'source' , trim(source)) - str = '$Id: restFileMod.F90 35676 2012-03-22 21:48:04Z tcraig $' - call ncd_putatt(ncid, NCD_GLOBAL, 'revision_id' , trim(str)) call ncd_putatt(ncid, NCD_GLOBAL, 'case_title' , trim(ctitle)) call ncd_putatt(ncid, NCD_GLOBAL, 'case_id' , trim(caseid)) call ncd_putatt(ncid, NCD_GLOBAL, 'title', & - 'RTM Restart information, required to continue a simulation' ) + 'MOSART Restart information, required to continue a simulation' ) end subroutine restFile_dimset @@ -367,7 +365,7 @@ subroutine RtmRestart(ncid, flag) !----------------------------------------------------------------------- ! DESCRIPTION: - ! Read/write RTM restart data. + ! Read/write MOSART restart data. ! ! ARGUMENTS: implicit none diff --git a/src/riverroute/RtmVar.F90 b/src/riverroute/RtmVar.F90 index 5aa1d7fc09..80fb0ad532 100644 --- a/src/riverroute/RtmVar.F90 +++ b/src/riverroute/RtmVar.F90 @@ -1,6 +1,6 @@ module RtmVar - use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_kind_mod , only : r8 => shr_kind_r8, SHR_KIND_CL use shr_const_mod, only : SHR_CONST_CDAY,SHR_CONST_REARTH use shr_sys_mod , only : shr_sys_abort use RtmSpmd , only : masterproc @@ -11,35 +11,36 @@ module RtmVar integer, parameter, private :: iundef = -9999999 integer, parameter, private :: rundef = -9999999._r8 - real(r8), public, parameter :: secspday = SHR_CONST_CDAY ! Seconds per day - integer, public, parameter :: isecspday= secspday ! Integer seconds per day - real(r8), public, parameter :: spval = 1.e36_r8 ! special value for real data - integer , public, parameter :: ispval = -9999 ! special value for int data - real(r8) :: re = SHR_CONST_REARTH*0.001_r8 ! radius of earth (km) - logical , public :: barrier_timers = .false. ! barrier timers + real(r8), public, parameter :: secspday = SHR_CONST_CDAY ! Seconds per day + integer, public, parameter :: isecspday= secspday ! Integer seconds per day + real(r8), public, parameter :: spval = 1.e36_r8 ! special value for real data + integer , public, parameter :: ispval = -9999 ! special value for int data + real(r8) :: re = SHR_CONST_REARTH*0.001_r8 ! radius of earth (km) + logical , public :: barrier_timers = .false. ! barrier timers ! Run control variables - character(len=256), public :: caseid = ' ' ! case id - character(len=256), public :: ctitle = ' ' ! case title - integer, public, parameter :: nsrStartup = 0 ! Startup from initial conditions - integer, public, parameter :: nsrContinue = 1 ! Continue from restart files - integer, public, parameter :: nsrBranch = 2 ! Branch from restart files - integer, public :: nsrest = iundef ! Type of run - logical, public :: brnch_retain_casename = .false. ! true => allow case name to remain the same for branch run - ! by default this is not allowed - logical, public :: noland = .false. ! true => no valid land points -- do NOT run - character(len=32) , public :: decomp_option ! decomp option - character(len=32) , public :: bypass_routing_option ! bypass routing model method - character(len=32) , public :: qgwl_runoff_option ! method for handling qgwl runoff - character(len=32) , public :: smat_option ! smatrix multiply option (opt, Xonly, Yonly) - ! opt = XandY in MCT - ! Xonly = Xonly in MCT, should be bfb on different pe counts - ! Yonly = Yonly in MCT - character(len=256), public :: hostname = ' ' ! Hostname of machine running on - character(len=256), public :: username = ' ' ! username of user running program - character(len=256), public :: version = " " ! version of program - character(len=256), public :: conventions = "CF-1.0" ! dataset conventions - character(len=256), public :: source = "Community Land Model CLM4.0" ! description of this source + character(len=SHR_KIND_CL), public :: caseid = ' ' ! case id + character(len=SHR_KIND_CL), public :: ctitle = ' ' ! case title + integer, public, parameter :: nsrStartup = 0 ! Startup from initial conditions + integer, public, parameter :: nsrContinue = 1 ! Continue from restart files + integer, public, parameter :: nsrBranch = 2 ! Branch from restart files + integer, public :: nsrest = iundef ! Type of run + logical, public :: brnch_retain_casename = .false. ! true => allow case name to remain the same for branch run + ! by default this is not allowed + logical, public :: noland = .false. ! true => no valid land points -- do NOT run + character(len=32) , public :: decomp_option ! decomp option + character(len=32) , public :: bypass_routing_option ! bypass routing model method + character(len=32) , public :: qgwl_runoff_option ! method for handling qgwl runoff + character(len=32) , public :: smat_option ! smatrix multiply option (opt, Xonly, Yonly) + ! opt = XandY in MCT + ! Xonly = Xonly in MCT, should be bfb on different pe counts + ! Yonly = Yonly in MCT + character(len=SHR_KIND_CL), public :: hostname = ' ' ! Hostname of machine running on + character(len=SHR_KIND_CL), public :: username = ' ' ! username of user running program + character(len=SHR_KIND_CL), public :: version = " " ! version of program + character(len=SHR_KIND_CL), public :: conventions = "CF-1.0" ! dataset conventions + character(len=SHR_KIND_CL), public :: source = "Model for Scale Adaptive River Transport MOSART1.0" ! description of this source + character(len=SHR_KIND_CL), public :: model_doi_url ! Web address of the Digital Object Identifier (DOI) for this model version ! Unit Numbers integer, public :: iulog = 6 ! "stdout" log file unit number, default is 6 @@ -50,16 +51,16 @@ module RtmVar character(len=16), public :: inst_suffix ! Rtm control variables - character(len=256), public :: nrevsn_rtm = ' ' ! restart data file name for branch run - character(len=256), public :: finidat_rtm = ' ' ! initial conditions file name - character(len=256), public :: frivinp_rtm = ' ' ! RTM input data file name + character(len=SHR_KIND_CL), public :: nrevsn_rtm = ' ' ! restart data file name for branch run + character(len=SHR_KIND_CL), public :: finidat_rtm = ' ' ! initial conditions file name + character(len=SHR_KIND_CL), public :: frivinp_rtm = ' ' ! MOSART input data file name logical, public :: ice_runoff = .true. ! true => runoff is split into liquid and ice, ! otherwise just liquid ! Rtm grid size - integer :: rtmlon = 1 ! number of rtm longitudes (initialize) - integer :: rtmlat = 1 ! number of rtm latitudes (initialize) + integer :: rtmlon = 1 ! number of mosart longitudes (initialize) + integer :: rtmlat = 1 ! number of mosart latitudes (initialize) - character(len=256), public :: rpntfil = 'rpointer.rof' ! file name for local restart pointer file + character(len=SHR_KIND_CL), public :: rpntfil = 'rpointer.rof' ! file name for local restart pointer file logical, private :: RtmVar_isset = .false. @@ -69,18 +70,20 @@ module RtmVar !================================================================================ subroutine RtmVarSet( caseid_in, ctitle_in, brnch_retain_casename_in, & - nsrest_in, version_in, hostname_in, username_in ) + nsrest_in, version_in, hostname_in, username_in, & + model_doi_url_in ) !----------------------------------------------------------------------- ! Set input control variables. ! ! !ARGUMENTS: - character(len=256), optional, intent(IN) :: caseid_in ! case id - character(len=256), optional, intent(IN) :: ctitle_in ! case title - integer, optional, intent(IN) :: nsrest_in ! 0: initial run. 1: restart: 3: branch - character(len=256), optional, intent(IN) :: version_in ! model version - character(len=256), optional, intent(IN) :: hostname_in ! hostname running on - character(len=256), optional, intent(IN) :: username_in ! username running job + character(len=SHR_KIND_CL), optional, intent(IN) :: caseid_in ! case id + character(len=SHR_KIND_CL), optional, intent(IN) :: ctitle_in ! case title + integer, optional, intent(IN) :: nsrest_in ! 0: initial run. 1: restart: 3: branch + character(len=SHR_KIND_CL), optional, intent(IN) :: version_in ! model version + character(len=SHR_KIND_CL), optional, intent(IN) :: hostname_in ! hostname running on + character(len=SHR_KIND_CL), optional, intent(IN) :: username_in ! username running job + character(len=SHR_KIND_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 !----------------------------------------------------------------------- @@ -94,6 +97,7 @@ subroutine RtmVarSet( caseid_in, ctitle_in, brnch_retain_casename_in, & if (present(version_in)) version = version_in if (present(username_in)) username = username_in if (present(hostname_in)) hostname = hostname_in + if (present(model_doi_url_in)) model_doi_url = model_doi_url_in if (present(brnch_retain_casename_in)) brnch_retain_casename = brnch_retain_casename_in end subroutine RtmVarSet