diff --git a/cime_config/buildlib b/cime_config/buildlib index 945363a..5f6fab7 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -9,7 +9,7 @@ import os, sys CIMEROOT = os.environ.get("CIMEROOT") if CIMEROOT is None: raise SystemExit("ERROR: must set CIMEROOT environment variable") -sys.path.append(os.path.join(CIMEROOT, "scripts", "Tools")) +sys.path.append(os.path.join(CIMEROOT, "CIME", "Tools")) from standard_script_setup import * from CIME.case import Case diff --git a/cime_config/buildnml b/cime_config/buildnml index c7e0d18..a700c85 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -14,7 +14,7 @@ import os, sys, glob CIMEROOT = os.environ.get("CIMEROOT") if CIMEROOT is None: raise SystemExit("ERROR: must set CIMEROOT environment variable") -sys.path.append(os.path.join(CIMEROOT, "scripts", "Tools")) +sys.path.append(os.path.join(CIMEROOT, "CIME", "Tools")) from standard_script_setup import * from CIME.case import Case diff --git a/cime_config/testdefs/testlist_rtm.xml b/cime_config/testdefs/testlist_rtm.xml index 754a72b..be0c101 100644 --- a/cime_config/testdefs/testlist_rtm.xml +++ b/cime_config/testdefs/testlist_rtm.xml @@ -3,9 +3,8 @@ - - - + + @@ -14,9 +13,8 @@ - - - + + @@ -25,9 +23,8 @@ - - - + + @@ -36,7 +33,7 @@ - + @@ -45,7 +42,7 @@ - + @@ -54,7 +51,7 @@ - + @@ -63,7 +60,7 @@ - + @@ -72,7 +69,7 @@ - + @@ -81,7 +78,7 @@ - + diff --git a/docs/ChangeLog b/docs/ChangeLog index 0b10865..f7ac4e1 100644 --- a/docs/ChangeLog +++ b/docs/ChangeLog @@ -1,3 +1,20 @@ +=============================================================== +Tag name: rtm1_0_79 +Originator(s): mvertens/erik +Date: Jan 22, 2024 +One-line Summary: Remove MCT from RTM + +This tag removes MCT code that is no longer used since it is only in the mct cap. +Also updates the testlist to be moved to Derecho, removing izumi + +Erik added some changes to this that were important for RTM as a maintainer of +RTM which cover the following issues: + +Resolves #45 -- failing tests +Resolves #44 -- lower testing for RTM (remove Izumi tests) +Resolves #41 -- Move testlist from Cheyenne to Derecho +Resolves #33 -- Update path to CIME tools needed for buildnml/buildlib + =============================================================== Tag name: rtm1_0_78 Originator(s): erik diff --git a/src/cpl/mct/rof_comp_mct.F90 b/src/cpl/mct/rof_comp_mct.F90 deleted file mode 100644 index c9f16df..0000000 --- a/src/cpl/mct/rof_comp_mct.F90 +++ /dev/null @@ -1,513 +0,0 @@ -module rof_comp_mct - -!======================================================================== -! DESCRIPTION: -! Interface of the active runoff 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 - - use seq_flds_mod - use shr_kind_mod , only : r8 => shr_kind_r8, CL => 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 seq_cdata_mod , only : seq_cdata, seq_cdata_setptrs - use seq_timemgr_mod , only : seq_timemgr_EClockGetData, seq_timemgr_StopAlarmIsOn, & - seq_timemgr_RestartAlarmIsOn, seq_timemgr_EClockDateInSync - use seq_infodata_mod , only : seq_infodata_type, seq_infodata_GetData, seq_infodata_PutData, & - seq_infodata_start_type_start, seq_infodata_start_type_cont, & - seq_infodata_start_type_brnch - use seq_comm_mct , only : seq_comm_suffix, seq_comm_inst, seq_comm_name - use RunoffMod , only : runoff - use RtmVar , only : rtmlon, rtmlat, ice_runoff, iulog, & - nsrStartup, nsrContinue, nsrBranch, & - inst_index, inst_suffix, inst_name, RtmVarSet, & - rtm_active, flood_active, nt_rtm, rtm_tracers - use RtmSpmd , only : masterproc, mpicom_rof, iam, RtmSpmdInit - use RtmMod , only : Rtmini, Rtmrun - use RtmTimeManager , only : timemgr_setup, get_curr_date, get_step_size, advance_timestep - use perf_mod , only : t_startf, t_stopf, t_barrierf - use rtm_cpl_indices , only : rtm_cpl_indices_set - use rof_import_export - - use mct_mod - use ESMF -! -! PUBLIC MEMBER FUNCTIONS: - implicit none - SAVE - private ! By default make data private -! -! PUBLIC MEMBER FUNCTIONS: - - public :: rof_init_mct ! rof initialization - public :: rof_run_mct ! rof run phase - public :: rof_final_mct ! rof finalization/cleanup -! -! PRIVATE MEMBER FUNCTIONS: - - private :: rof_SetgsMap_mct ! Set the river runoff model MCT GS map - private :: rof_domain_mct ! Set the river runoff model domain information -! -! PRIVATE DATA MEMBERS: - real(r8), allocatable :: totrunin(:,:) ! cell tracer lnd forcing on rtm grid (mm/s) - -! REVISION HISTORY: -! Author: Mariana Vertenstein -!=============================================================== -contains -!=============================================================== - -!======================================================================== - - subroutine rof_init_mct( EClock, cdata_r, x2r_r, r2x_r, NLFilename) - - !--------------------------------------------------------------------------- - ! DESCRIPTION: - ! Initialize runoff model and obtain relevant atmospheric model arrays - ! back from (i.e. albedos, surface temperature and snow cover over land). - ! - ! !ARGUMENTS: - type(ESMF_Clock), intent(inout) :: EClock ! Input synchronization clock - type(seq_cdata), intent(inout) :: cdata_r ! Input runoff-model driver data - type(mct_aVect) , intent(inout) :: x2r_r ! River import state - type(mct_aVect), intent(inout) :: r2x_r ! River export state - character(len=*), optional, intent(in) :: NLFilename ! Namelist filename to read - ! - ! !LOCAL VARIABLES: - integer :: ROFID ! rof identifyer - integer :: mpicom_rof ! mpi communicator - type(mct_gsMap), pointer :: gsMap_rof ! runoff model MCT GS map - type(mct_gGrid), pointer :: dom_r ! runoff model domain - type(seq_infodata_type), pointer :: infodata ! CESM driver level info data - 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 - character(len=CL) :: caseid ! case identifier name - character(len=CL) :: ctitle ! case description title - character(len=CL) :: starttype ! start-type (startup, continue, branch, hybrid) - character(len=CL) :: calendar ! calendar type name - character(len=CL) :: hostname ! hostname of machine running on - character(len=CL) :: version ! Model version - character(len=CL) :: username ! user running the model - character(len=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)" - !--------------------------------------------------------------------------- - - ! Obtain cdata_r (initalized in ccsm_comp_mod.F90 in the call to - ! seq_cdata_init for cdata_rr) - call seq_cdata_setptrs(cdata_r, ID=ROFID, mpicom=mpicom_rof, & - gsMap=gsMap_rof, dom=dom_r, infodata=infodata) - - ! Determine attriute vector indices - call rtm_cpl_indices_set() - - ! Initialize rtm MPI communicator - call RtmSpmdInit(mpicom_rof) - -#if (defined _MEMTRACE) - if(masterproc) then - lbnum=1 - call memmon_dump_fort('memmon.out','rof_init_mct: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) "RTM land model initialization" - else - iulog = shrlogunit - end if - - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (iulog) - - ! Initialize rtm - 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 seq_infodata_GetData(infodata, case_name=caseid, & - 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, & - 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, & - model_doi_url_in=model_doi_url, & - hostname_in=hostname, username_in=username) - - ! Read namelist, grid and surface data - call Rtmini() - - if (rtm_active) then - ! Initialize memory for input state - begr = runoff%begr - endr = runoff%endr - allocate (totrunin(begr:endr,nt_rtm)) - - ! Initialize rof gsMap for ocean rof and land rof - call rof_SetgsMap_mct( mpicom_rof, ROFID, gsMap_rof) - - ! Initialize rof domain - lsize = mct_gsMap_lsize(gsMap_rof, mpicom_rof) - call rof_domain_mct( lsize, gsMap_rof, dom_r ) - - ! Initialize lnd -> rtm attribute vector - call mct_aVect_init(x2r_r, rList=seq_flds_x2r_fields, lsize=lsize) - call mct_aVect_zero(x2r_r) - - ! Initialize rtm -> ocn attribute vector - call mct_aVect_init(r2x_r, rList=seq_flds_r2x_fields, lsize=lsize) - call mct_aVect_zero(r2x_r) - - ! Create mct river runoff export state - call rof_export(r2x_r%rattr) - end if - - ! Fill in infodata - call seq_infodata_PutData( infodata, rof_present=rtm_active, & - rofice_present=.false., rof_prognostic=rtm_active, & - rof_nx = rtmlon, rof_ny = rtmlat) - call seq_infodata_PutData( infodata, flood_present=flood_active) - - ! 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_mct:end::',lbnum) - call memmon_reset_addr() - endif -#endif - - end subroutine rof_init_mct - -!--------------------------------------------------------------------------- - - subroutine rof_run_mct( EClock, cdata_r, x2r_r, r2x_r) - - !------------------------------------------------------- - ! DESCRIPTION: - ! Run runoff model - - ! ARGUMENTS: - implicit none - type(ESMF_Clock) , intent(inout) :: EClock ! Input synchronization clock from driver - type(seq_cdata) , intent(inout) :: cdata_r ! Input driver data for runoff model - type(mct_aVect) , intent(inout) :: x2r_r ! Import state from runoff model - type(mct_aVect) , intent(inout) :: r2x_r ! Export state from runoff model - - ! LOCAL VARIABLES: - 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 :: shrlogunit,shrloglev ! old values for share log unit and log level - integer :: lsize ! local size - integer :: lbnum ! input to memory diagnostic - integer :: g,i ! indices - type(mct_gGrid), pointer :: dom_r ! runoff model domain - type(seq_infodata_type),pointer :: infodata ! CESM information from the driver - real(r8), pointer :: data(:) ! temporary - character(len=32) :: rdate ! date char string for restart file names - character(len=32), parameter :: sub = "rof_run_mct" - !------------------------------------------------------- - -#if (defined _MEMTRACE) - if(masterproc) then - lbnum=1 - call memmon_dump_fort('memmon.out','rof_run_mct:start::',lbnum) - endif -#endif - - if (.not.rtm_active) return - - ! Reset shr logging to my log file - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (iulog) - - ! Determine time of next atmospheric shortwave calculation - 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 MCT to land data type (output is totrunin - module variable) - call t_startf ('lc_rof_import') - call rof_import(x2r_r%rattr, totrunin=totrunin) - call t_stopf ('lc_rof_import') - - ! First advance rtm 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() - - ! Run rtm (input is totrunin, output is runoff%runoff) - call Rtmrun(totrunin, rstwr, nlend, rdate) - - ! Map roff data to coupler datatype (input is runoff%runoff, output is r2x_r%rattr) - call t_startf ('lc_rof_export') - call rof_export(r2x_r%rattr) - call t_stopf ('lc_rof_export') - - ! Check that internal clock is in sync with master clock - 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,*)' rtm ymd=',ymd ,' rtm tod= ',tod - write(iulog,*)'sync ymd=',ymd_sync,' sync tod= ',tod_sync - call shr_sys_abort( sub//":: RTM clock is 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_mct:end::',lbnum) - call memmon_reset_addr() - endif -#endif - - end subroutine rof_run_mct - -!=============================================================================== - - subroutine rof_final_mct( EClock, cdata_r, x2r_r, r2x_r) - - use RtmFinalizeAll , only : RtmFinalizeMemory - - !----------------------------------------------------- - ! DESCRIPTION: - ! Finalize rof surface model - ! - ! ARGUMENTS: - implicit none - type(ESMF_Clock) , intent(inout) :: EClock ! Input synchronization clock from driver - type(seq_cdata) , intent(inout) :: cdata_r ! Input driver data for runoff model - type(mct_aVect) , intent(inout) :: x2r_r ! Import state from runoff model - type(mct_aVect) , intent(inout) :: r2x_r ! Export state from runoff model - !----------------------------------------------------- - - ! - ! deal with deallocations of items in this file here - ! - if (rtm_active) then - if (allocated(totrunin)) deallocate(totrunin) - end if - - ! - ! deal with clean up of memory for parts of RTM here - ! - call RtmFinalizeMemory() - - end subroutine rof_final_mct - -!=============================================================================== - - subroutine rof_SetgsMap_mct( mpicom_r, ROFID, gsMap_rof) - - !----------------------------------------------------- - ! DESCRIPTION: - ! Set the MCT GS map for the runoff model - ! - ! ARGUMENTS: - implicit none - integer , intent(in) :: mpicom_r ! MPI communicator for rof model - integer , intent(in) :: ROFID ! Land model identifier - type(mct_gsMap), intent(inout) :: gsMap_rof ! MCT gsmap for runoff -> land data - ! - ! LOCAL VARIABLES - integer,allocatable :: gindex(:) ! indexing for runoff grid cells - integer :: n, ni ! indices - integer :: lsize,gsize ! 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_SetgsMap_mct' - !----------------------------------------------------- - - begr = runoff%begr - endr = runoff%endr - lsize = runoff%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,runoff%lnumr - call shr_sys_abort( sub//' ERROR: runoff > expected' ) - endif - end do - if (ni /= lsize) then - write(iulog,*) sub, ' : ERROR runoff total count',ni,runoff%lnumr - call shr_sys_abort( sub//' ERROR: runoff not equal to expected' ) - endif - - ! Determine gsmap_rof - allocate(gindex(lsize),stat=ier) - ni = 0 - do n = begr,endr - ni = ni + 1 - gindex(ni) = runoff%gindex(n) - end do - call mct_gsMap_init( gsMap_rof, gindex, mpicom_r, ROFID, lsize, gsize ) - deallocate(gindex) - - end subroutine rof_SetgsMap_mct - -!=============================================================================== - - subroutine rof_domain_mct( lsize, gsMap_r, dom_r ) - - !----------------------------------------------------- - ! - ! !DESCRIPTION: - ! Send the runoff model domain information to the coupler - ! - ! !ARGUMENTS: - implicit none - integer , intent(in) :: lsize ! Size of runoff domain information - type(mct_gsMap), intent(inout) :: gsMap_r ! Output MCT GS map for runoff model - type(mct_ggrid), intent(out) :: dom_r ! Domain information from the runoff model - ! - ! LOCAL VARIABLES - integer :: n, ni ! index - integer , pointer :: idata(:) ! temporary - real(r8), pointer :: data(:) ! temporary - real(r8) :: re = SHR_CONST_REARTH*0.001_r8 ! radius of earth (km) - character(len=32), parameter :: sub = 'rof_domain_mct' - !----------------------------------------------------- - - ! lat/lon in degrees, area in radians^2, mask is 1 (land), 0 (non-land) - ! Note that in addition land carries around landfrac for the purposes of domain checking - call mct_gGrid_init( GGrid=dom_r, CoordChars=trim(seq_flds_dom_coord), & - OtherChars=trim(seq_flds_dom_other), lsize=lsize ) - - ! Allocate memory - allocate(data(lsize)) - - ! Determine global gridpoint number attribute, GlobGridNum, which is set automatically by MCT - call mct_gsMap_orderedPoints(gsMap_r, iam, idata) - call mct_gGrid_importIAttr(dom_r,'GlobGridNum',idata,lsize) - - ! Determine domain (numbering scheme is: West to East and South to North to South pole) - ! Initialize attribute vector with special value - data(:) = -9999.0_R8 - call mct_gGrid_importRAttr(dom_r,"lat" ,data,lsize) - call mct_gGrid_importRAttr(dom_r,"lon" ,data,lsize) - call mct_gGrid_importRAttr(dom_r,"area" ,data,lsize) - call mct_gGrid_importRAttr(dom_r,"aream",data,lsize) - data(:) = 0.0_R8 - call mct_gGrid_importRAttr(dom_r,"mask" ,data,lsize) - - ! Determine bounds numbering consistency - ni = 0 - do n = runoff%begr,runoff%endr - ni = ni + 1 - if (ni > runoff%lnumr) then - write(iulog,*) sub, ' : ERROR runoff count',n,ni,runoff%lnumr - call shr_sys_abort( sub//' ERROR: runoff > expected' ) - end if - end do - if (ni /= runoff%lnumr) then - write(iulog,*) sub, ' : ERROR runoff total count',ni,runoff%lnumr - call shr_sys_abort( sub//' ERROR: runoff not equal to expected' ) - endif - - ! Fill in correct values for domain components - ni = 0 - do n = runoff%begr,runoff%endr - ni = ni + 1 - data(ni) = runoff%lonc(n) - end do - call mct_gGrid_importRattr(dom_r,"lon",data,lsize) - - ni = 0 - do n = runoff%begr,runoff%endr - ni = ni + 1 - data(ni) = runoff%latc(n) - end do - call mct_gGrid_importRattr(dom_r,"lat",data,lsize) - - ni = 0 - do n = runoff%begr,runoff%endr - ni = ni + 1 - data(ni) = runoff%area(n)*1.0e-6_r8/(re*re) - end do - call mct_gGrid_importRattr(dom_r,"area",data,lsize) - - ni = 0 - do n = runoff%begr,runoff%endr - ni = ni + 1 - data(ni) = 1.0_r8 - end do - call mct_gGrid_importRattr(dom_r,"mask",data,lsize) - call mct_gGrid_importRattr(dom_r,"frac",data,lsize) - - deallocate(data) - deallocate(idata) - - end subroutine rof_domain_mct - -!==================================================================================== - - -end module rof_comp_mct diff --git a/src/cpl/mct/rof_import_export.F90 b/src/cpl/mct/rof_import_export.F90 deleted file mode 100644 index cfcb4b4..0000000 --- a/src/cpl/mct/rof_import_export.F90 +++ /dev/null @@ -1,208 +0,0 @@ -module rof_import_export - - use shr_kind_mod , only : r8 => shr_kind_r8 - 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_sys_mod , only : shr_sys_abort - use shr_const_mod , only : SHR_CONST_REARTH - use RunoffMod , only : runoff - use RtmVar , only : ice_runoff, iulog, nt_rtm, rtm_tracers, rtmlon, rtmlat - use RtmSpmd , only : masterproc - use RtmTimeManager , only : get_nstep - use perf_mod , only : t_startf, t_stopf, t_barrierf - use rtm_cpl_indices , only : index_x2r_Flrl_rofsur,index_x2r_Flrl_rofi - use rtm_cpl_indices , only : index_x2r_Flrl_rofgwl,index_x2r_Flrl_rofsub - use rtm_cpl_indices , only : index_x2r_Flrl_irrig - use rtm_cpl_indices , only : index_r2x_Forr_rofl, index_r2x_Forr_rofi - use rtm_cpl_indices , only : index_r2x_Flrr_flood, index_r2x_Flrr_volr - use rtm_cpl_indices , only : index_r2x_Flrr_volrmch - - implicit none - public - - integer ,parameter :: debug = 0 ! internal debug level - integer ,parameter :: nmax = 48 ! number of time steps to write debug output - character(*),parameter :: F01 = "('(rof_import_export) ',a,i5,2x,3(i8,2x),d21.9)" - -contains - - subroutine rof_import( x2r, totrunin) - - !--------------------------------------------------------------------------- - ! DESCRIPTION: - ! Obtain the runoff input from the coupler - ! - ! ARGUMENTS: - real(r8), intent(inout) :: x2r(:,:) - real(r8), intent(out) :: totrunin( runoff%begr: ,: ) - ! - ! LOCAL VARIABLES - integer :: n2, n, nt, ix, iy - integer :: begr, endr - integer :: nliq, nfrz - character(len=32), parameter :: sub = 'rof_import' - !--------------------------------------------------------------------------- - - ! Note that totrunin is a flux - - 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,*) trim(sub),': ERROR in rtm_tracers LIQ ICE ',nliq,nfrz,rtm_tracers - call shr_sys_abort() - endif - - begr = runoff%begr - endr = runoff%endr - - do n = begr,endr - n2 = n - begr + 1 - totrunin(n,nliq) = x2r(index_x2r_Flrl_rofsur,n2) + & - x2r(index_x2r_Flrl_rofsub,n2) + & - x2r(index_x2r_Flrl_rofgwl,n2) + & - x2r(index_x2r_Flrl_irrig,n2) - - runoff%qirrig(n) = x2r(index_x2r_Flrl_irrig,n2) - - totrunin(n,nfrz) = x2r(index_x2r_Flrl_rofi,n2) - - enddo - - if (debug > 0 .and. masterproc .and. get_nstep() < nmax) then - do n = begr,endr - n2 = n - begr + 1 - iy = (n-1)/rtmlon + 1 - ix = n - (iy-1)*rtmlon - write(iulog,F01)'import: nstep, n, ix, iy, Flrl_rofsur = ',get_nstep(),n,ix,iy,x2r(index_x2r_Flrl_rofsur,n2) - write(iulog,F01)'import: nstep, n, ix, iy, Flrl_rofsub = ',get_nstep(),n,ix,iy,x2r(index_x2r_Flrl_rofsub,n2) - write(iulog,F01)'import: nstep, n, ix, iy, Flrl_rofgwl = ',get_nstep(),n,ix,iy,x2r(index_x2r_Flrl_rofgwl,n2) - write(iulog,F01)'import: nstep, n, ix, iy, qirrig = ',get_nstep(),n,ix,iy,runoff%qirrig(n) - write(iulog,F01)'import: nstep, n, ix, iy, totrunin(liq) = ',get_nstep(),n,ix,iy,totrunin(n,nliq) - write(iulog,F01)'import: nstep, n, ix, iy, totrunin(frz) = ',get_nstep(),n,ix,iy,totrunin(n,nfrz) - end do - end if - - end subroutine rof_import - - !==================================================================================== - - subroutine rof_export(r2x) - - !--------------------------------------------------------------------------- - ! DESCRIPTION: - ! Send the runoff model export state to the coupler - ! - ! ARGUMENTS: - real(r8), intent(inout) :: r2x(:,:) ! Runoff to coupler export state - ! - ! LOCAL VARIABLES - integer :: ni, n, nt, ix, iy - integer :: nliq, nfrz - logical :: first_time = .true. - character(len=32), parameter :: sub = 'rof_export' - !--------------------------------------------------------------------------- - - 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,*) trim(sub),': ERROR in rtm_tracers LIQ ICE ',nliq,nfrz,rtm_tracers - call shr_sys_abort() - endif - - r2x(:,:) = 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 - do n = runoff%begr,runoff%endr - ni = ni + 1 - if (runoff%mask(n) == 2) then - ! liquid and ice runoff are treated separately - this is what goes to the ocean - r2x(index_r2x_Forr_rofl,ni) = & - runoff%runoff(n,nliq)/(runoff%area(n)*1.0e-6_r8*1000._r8) - r2x(index_r2x_Forr_rofi,ni) = & - runoff%runoff(n,nfrz)/(runoff%area(n)*1.0e-6_r8*1000._r8) - if (ni > runoff%lnumr) then - write(iulog,*) sub, ' : ERROR runoff count',n,ni - call shr_sys_abort( sub//' : ERROR runoff > expected' ) - endif - endif - end do - else - do n = runoff%begr,runoff%endr - ni = ni + 1 - if (runoff%mask(n) == 2) then - ! liquid and ice runoff are bundled together to liquid runoff - ! and then ice runoff set to zero - r2x(index_r2x_Forr_rofl,ni) = & - (runoff%runoff(n,nfrz)+runoff%runoff(n,nliq))& - /(runoff%area(n)*1.0e-6_r8*1000._r8) - r2x(index_r2x_Forr_rofi,ni) = 0._r8 - if (ni > runoff%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 = runoff%begr, runoff%endr - ni = ni + 1 - r2x(index_r2x_Flrr_flood,ni) = -runoff%flood(n) - end do - - ! Want volr on land side to do a correct water balance - ni = 0 - do n = runoff%begr, runoff%endr - ni = ni + 1 - r2x(index_r2x_Flrr_volr,ni) = runoff%volr(n,1) / (runoff%area(n)) - r2x(index_r2x_Flrr_volrmch,ni) = r2x(index_r2x_Flrr_volr,ni) ! main channel not defined in rtm so use total - end do - - if (debug > 0 .and. masterproc .and. get_nstep() < nmax) then - ni = 0 - do n = runoff%begr,runoff%endr - ni = ni + 1 - iy = (n-1)/rtmlon + 1 - ix = n - (iy-1)*rtmlon - write(iulog,F01)'export: nstep, n, ix, iy, Flrr_flood = ',get_nstep(),n,ix,iy,r2x(index_r2x_Flrr_flood,ni) - write(iulog,F01)'export: nstep, n, ix, iy, Flrr_volr = ',get_nstep(),n,ix,iy,r2x(index_r2x_Flrr_volr,ni) - write(iulog,F01)'export: nstep, n, ix, iy, Flrr_volrmch = ',get_nstep(),n,ix,iy,r2x(index_r2x_Flrr_volrmch,ni) - write(iulog,F01)'export: nstep, n, ix, iy, Forr_rofl = ',get_nstep(),n,ix,iy,r2x(index_r2x_Forr_rofl,n) - write(iulog,F01)'export: nstep, n, ix, iy, Forr_rofi = ',get_nstep(),n,ix,iy,r2x(index_r2x_Forr_rofi,ni) - end do - end if - - end subroutine rof_export - -end module rof_import_export diff --git a/src/cpl/mct/rtm_cpl_indices.F90 b/src/cpl/mct/rtm_cpl_indices.F90 deleted file mode 100644 index 7dfc6c5..0000000 --- a/src/cpl/mct/rtm_cpl_indices.F90 +++ /dev/null @@ -1,102 +0,0 @@ -module rtm_cpl_indices -!----------------------------------------------------------------------- -!BOP -! -! !MODULE: rtm_cpl_indices -! -! !DESCRIPTION: -! Module containing the indices for the fields passed between RTM and -! the driver. -! -! !USES: - - use shr_sys_mod, only : shr_sys_abort - implicit none - - SAVE - private ! By default make data private -! -! !PUBLIC MEMBER FUNCTIONS: - - public :: rtm_cpl_indices_set ! Set the coupler indices - -! -! !PUBLIC DATA MEMBERS: -! - integer, public :: index_x2r_Flrl_rofsur = 0 ! lnd->rtm liquid surface runoff forcing from land - integer, public :: index_x2r_Flrl_rofgwl = 0 ! lnd->rtm liquid gwl runoff forcing from land - integer, public :: index_x2r_Flrl_rofsub = 0 ! lnd->rtm liquid subsurface runoff forcing from land - integer, public :: index_x2r_Flrl_rofi = 0 ! lnd->rtm ice runoff forcing from land - integer, public :: index_x2r_Flrl_irrig = 0 ! lnd->rof fraction of volr to be removed for irrigation - - integer, public :: nflds_x2r = 0 - - ! roff to driver (part of land for now) (optional if RTM is off) - - integer, public :: index_r2x_Forr_rofl = 0 ! rtm->ocn liquid runoff to ocean - integer, public :: index_r2x_Forr_rofi = 0 ! rtm->ocn ice runoff to ocean - integer, public :: index_r2x_Flrr_flood = 0 ! rtm->lnd flood runoff (>fthresh) back to land - integer, public :: index_r2x_Flrr_volr = 0 ! rtm->lnd volr total back to land - integer, public :: index_r2x_Flrr_volrmch = 0 ! rtm->lnd volr main channel back to land - integer, public :: nflds_r2x = 0 - -!======================================================================= -contains -!======================================================================= - - subroutine rtm_cpl_indices_set( ) - - !----------------------------------------------------------------------- - ! !DESCRIPTION: - ! Set the coupler indices needed by the rof model coupler interface. - ! runoff - (rtm -> ocn) and (rtm->lnd) - ! - ! !USES: - use seq_flds_mod , only: seq_flds_r2x_fields, seq_flds_x2r_fields - use mct_mod , only: mct_aVect, mct_aVect_init, mct_avect_indexra, & - mct_aVect_clean, mct_avect_nRattr - ! - ! !ARGUMENTS: - implicit none - ! - ! !REVISION HISTORY: - ! Author: Mariana Vertenstein - ! - ! !LOCAL VARIABLES: - type(mct_aVect) :: avtmp ! temporary av - character(len=32) :: subname = 'rtm_cpl_indices_set' ! subroutine name - !----------------------------------------------------------------------- - - ! x2r - - call mct_aVect_init(avtmp, rList=seq_flds_x2r_fields, lsize=1) - - index_x2r_Flrl_rofsur = mct_avect_indexra(avtmp,'Flrl_rofsur') - index_x2r_Flrl_rofgwl = mct_avect_indexra(avtmp,'Flrl_rofgwl') - index_x2r_Flrl_rofsub = mct_avect_indexra(avtmp,'Flrl_rofsub') - index_x2r_Flrl_rofi = mct_avect_indexra(avtmp,'Flrl_rofi') - index_x2r_Flrl_irrig = mct_avect_indexra(avtmp,'Flrl_irrig') - - nflds_x2r = mct_avect_nRattr(avtmp) - - call mct_aVect_clean(avtmp) - - ! r2x - - call mct_aVect_init(avtmp, rList=seq_flds_r2x_fields, lsize=1) - - index_r2x_Forr_rofl = mct_avect_indexra(avtmp,'Forr_rofl') - index_r2x_Forr_rofi = mct_avect_indexra(avtmp,'Forr_rofi') - index_r2x_Flrr_flood = mct_avect_indexra(avtmp,'Flrr_flood') - index_r2x_Flrr_volr = mct_avect_indexra(avtmp,'Flrr_volr') - index_r2x_Flrr_volrmch = mct_avect_indexra(avtmp,'Flrr_volrmch') - - nflds_r2x = mct_avect_nRattr(avtmp) - - call mct_aVect_clean(avtmp) - - end subroutine rtm_cpl_indices_set - -end module rtm_cpl_indices - - diff --git a/src/riverroute/RtmFinalizeAll.F90 b/src/riverroute/RtmFinalizeAll.F90 index 1e11f9b..802734e 100644 --- a/src/riverroute/RtmFinalizeAll.F90 +++ b/src/riverroute/RtmFinalizeAll.F90 @@ -3,7 +3,6 @@ module RtmFinalizeAll ! ! gateway to other Rtm routines to clean up memory. Called from: ! -! rof_comp_mct::rof_final_mct ! rof_comp_esmf::rof_final_esmf ! diff --git a/src/riverroute/RtmHistFile.F90 b/src/riverroute/RtmHistFile.F90 index 01eab6a..140d314 100644 --- a/src/riverroute/RtmHistFile.F90 +++ b/src/riverroute/RtmHistFile.F90 @@ -188,7 +188,7 @@ subroutine RtmHistFileFinalize() ! DESCRIPTION: ! - ! Finalize and clean up memory, Called from rof_final_mct + ! Finalize and clean up memory, Called from RtmFinalizeMemory ! ! !ARGUMENTS: diff --git a/src/riverroute/RtmMod.F90 b/src/riverroute/RtmMod.F90 index 9b24114..f126ce2 100644 --- a/src/riverroute/RtmMod.F90 +++ b/src/riverroute/RtmMod.F90 @@ -23,13 +23,13 @@ module RtmMod nsrContinue, nsrBranch, nsrStartup, nsrest, & inst_index, inst_suffix, inst_name, & rtm_active, flood_active, effvel_active, & - nt_rtm, rtm_tracers + nt_rtm, rtm_tracers use RtmFileUtils , only : getfil, getavu, relavu use RtmTimeManager , only : timemgr_init, get_nstep, get_curr_date - use RtmHistFlds , only : RtmHistFldsInit, RtmHistFldsSet + use RtmHistFlds , only : RtmHistFldsInit, RtmHistFldsSet use RtmHistFile , only : RtmHistUpdateHbuf, RtmHistHtapesWrapup, RtmHistHtapesBuild, & rtmhist_ndens, rtmhist_mfilt, rtmhist_nhtfrq, & - rtmhist_avgflag_pertape, rtmhist_avgflag_pertape, & + rtmhist_avgflag_pertape, rtmhist_avgflag_pertape, & rtmhist_fincl1, rtmhist_fincl2, rtmhist_fincl3, & rtmhist_fexcl1, rtmhist_fexcl2, rtmhist_fexcl3, & max_tapes, max_namlen @@ -84,10 +84,10 @@ module RtmMod character(len=256) :: flood_mode character(len=256) :: rtm_mode - character(len=256) :: rtm_effvel + character(len=256) :: rtm_effvel - character(len=256) :: nlfilename_rof = 'rof_in' - character(len=256) :: nlfilename_lnd = 'lnd_in' + character(len=256) :: nlfilename_rof = 'rof_in' + character(len=256) :: nlfilename_lnd = 'lnd_in' ! !EOP !----------------------------------------------------------------------- @@ -158,16 +158,15 @@ subroutine Rtmini() real(r8) :: dtover,dtovermax ! ts calc temporaries type(file_desc_t) :: ncid ! netcdf file id integer :: dimid ! netcdf dimension identifier - integer :: nroflnd ! local number of land runoff + integer :: nroflnd ! local number of land runoff integer :: nrofocn ! local number of ocn runoff integer :: pid,np,npmin,npmax,npint ! log loop control - integer :: na,nb,ns ! mct sizes integer :: ni,no,go ! tmps - integer ,allocatable :: rgdc2glo(:) ! temporary for initialization - integer ,allocatable :: rglo2gdc(:) ! temporary for initialization - integer ,allocatable :: gmask(:) ! global mask + integer ,allocatable :: rgdc2glo(:) ! temporary for initialization + integer ,allocatable :: rglo2gdc(:) ! temporary for initialization + integer ,allocatable :: gmask(:) ! global mask logical :: found ! if variable found on rdirc file - character(len=256):: fnamer ! name of netcdf restart file + character(len=256):: fnamer ! name of netcdf restart file character(len=256):: pnamer ! full pathname of netcdf restart file character(len=256):: locfn ! local file name integer :: begro,endro ! local start/stop indices @@ -291,7 +290,7 @@ subroutine Rtmini() write(iulog,*) ' RTM :: use default effective velocity (4.0) ' endif endif - + if (rtm_active) then if (frivinp_rtm == ' ') then call shr_sys_abort( subname//' ERROR: rtm_mode ACTIVE, but frivinp_rtm NOT set' ) @@ -311,7 +310,7 @@ subroutine Rtmini() write(iulog,*) subname,': ERROR rtm step invalid',rtm_tstep call shr_sys_abort( subname//' ERROR: rtm_tstep invalid' ) endif - + do i = 1, max_tapes if (rtmhist_nhtfrq(i) == 0) then rtmhist_mfilt(i) = 1 @@ -321,7 +320,7 @@ subroutine Rtmini() end do !------------------------------------------------------- - ! Initialize rtm time manager + ! Initialize rtm time manager !------------------------------------------------------- ! Intiialize RTM pio @@ -329,13 +328,13 @@ subroutine Rtmini() ! Obtain restart file if appropriate if ((nsrest == nsrStartup .and. finidat_rtm /= ' ') .or. & - (nsrest == nsrContinue) .or. & + (nsrest == nsrContinue) .or. & (nsrest == nsrBranch )) then call RtmRestGetfile( file=fnamer, path=pnamer ) - endif + endif ! Initialize time manager - if (nsrest == nsrStartup) then + if (nsrest == nsrStartup) then call timemgr_init(dtime_in=rtm_tstep) else call RtmRestTimeManager(file=fnamer) @@ -393,12 +392,12 @@ subroutine Rtmini() call shr_sys_abort() end if - allocate(tempr(rtmlon,rtmlat)) + allocate(tempr(rtmlon,rtmlat)) call ncd_io(ncid=ncid, varname='RTM_FLOW_DIRECTION', flag='read', data=tempr, readvar=found) if ( .not. found ) call shr_sys_abort( trim(subname)//' ERROR: RTM_FLOW_DIRECTION NOT on rdirc file' ) do j=1,rtmlat do i=1,rtmlon - + !------------------------------------------------------- ! Put in a check for a negative rdirc value and abort. !------------------------------------------------------- @@ -420,7 +419,7 @@ subroutine Rtmini() runoff%rlat(j) = tempr(1,j) rlatc(j) = tempr(1,j) end do - deallocate(tempr) + deallocate(tempr) call ncd_pio_closefile(ncid) @@ -428,14 +427,14 @@ subroutine Rtmini() write(iulog,*)'RTM netcdf river direction file successfully read ' call shr_sys_flush(iulog) endif - + call t_stopf('rtmi_grid') !------------------------------------------------------- ! Set dwnstrm_index from rdirc values !------------------------------------------------------- - ! The following assumes that there is no runoff + ! The following assumes that there is no runoff ! south of j=1 or north of j=rtmlat ! This is true for rdirc.05 ! Determine dwnstrmm_index from rtm river flow direction (0-8) @@ -474,9 +473,9 @@ subroutine Rtmini() ! Determine rtm ocn/land mask (global, all procs) !------------------------------------------------------- - ! 0=none, - ! 1=land, - ! 2=ocean outflow, + ! 0=none, + ! 1=land, + ! 2=ocean outflow, ! -1=reroute over ocean to ocean outflow points call t_startf('rtmi_decomp') @@ -496,7 +495,7 @@ subroutine Rtmini() if (nr /= 0) then ! n is always land if dwnstrm_index exists if (rdirc(n) > 0) then gmask(n) = 1 - else if (rdirc(n) < 0) then + else if (rdirc(n) < 0) then gmask(n) = -1 end if end if @@ -529,7 +528,7 @@ subroutine Rtmini() n = dwnstrm_index(n) g = g + 1 end do - if (gmask(n) == 2) then ! found ocean outlet + if (gmask(n) == 2) then ! found ocean outlet iocn(nr) = n ! set ocean outlet or nr to n nocn(n) = nocn(n) + 1 ! one more land cell for n elseif (abs(gmask(n)) == 1) then ! no ocean outlet, warn user, ignore cell @@ -537,7 +536,7 @@ subroutine Rtmini() g,nr,gmask(nr),dwnstrm_index(nr), & n,gmask(n),dwnstrm_index(n) call shr_sys_abort() - else + else write(iulog,*) 'rtmini ERROR downstream cell is non-ocean,non-land', & g,nr,gmask(nr),dwnstrm_index(nr), & n,gmask(n),dwnstrm_index(n) @@ -557,7 +556,7 @@ subroutine Rtmini() call t_startf('rtmi_dec_distr') !--- pocn is the pe that gets the basin associated with ocean outlet nr - !--- nop is a running count of the number of rtm cells/pe + !--- nop is a running count of the number of rtm cells/pe nbas = 0 nrtm = 0 @@ -687,7 +686,7 @@ subroutine Rtmini() do nr = 1,rtmlon*rtmlat if (pocn(nr) >= 0) then rglo2gdc(nr) = nrs(pocn(nr)) + nba(pocn(nr)) - nba(pocn(nr)) = nba(pocn(nr)) + 1 + nba(pocn(nr)) = nba(pocn(nr)) + 1 endif enddo do n = 0,npes-1 @@ -783,7 +782,7 @@ subroutine Rtmini() sfluxin(:,:) = 0._r8 !------------------------------------------------------- - ! Allocate runoff datatype + ! Allocate runoff datatype !------------------------------------------------------- call RunoffInit(begr, endr, numr) @@ -802,7 +801,7 @@ subroutine Rtmini() nr = rglo2gdc(n) if (nr /= 0) then numr = numr + 1 - rgdc2glo(nr) = n + rgdc2glo(nr) = n runoff%mask(nr) = gmask(n) endif end do @@ -912,7 +911,7 @@ subroutine Rtmini() if (masterproc) write(iulog,*) 'Rtmini rtm area ',runoff%totarea !------------------------------------------------------- - ! Determine downstream distance + ! Determine downstream distance !------------------------------------------------------- ! Instead of reading a distance file calculate the downstream distance @@ -986,7 +985,7 @@ subroutine Rtmini() ! The call below opens and closes the file if ((nsrest == nsrStartup .and. finidat_rtm /= ' ') .or. & - (nsrest == nsrContinue) .or. & + (nsrest == nsrContinue) .or. & (nsrest == nsrBranch )) then call RtmRestFileRead( file=fnamer ) fluxout(:,:) = runoff%fluxout(:,:) @@ -1100,23 +1099,23 @@ subroutine Rtmrun(totrunin, rstwr, nlend, rdate) endif ! Remove water from rtm and send back to clm - ! Just consider land points and only remove liquid water + ! Just consider land points and only remove liquid water ! runoff%flood needs to be a flux - in units of mm/s ! totrunin is a flux (mm/s) call t_startf('RTMflood') - nt = 1 + nt = 1 do nr = runoff%begr,runoff%endr ! initialize runoff%flood to zero runoff%flood(nr) = 0._r8 if (flood_active .and. runoff%mask(nr) == 1) then - if (runoff%volr(nr,nt) > runoff%fthresh(nr)) then + if (runoff%volr(nr,nt) > runoff%fthresh(nr)) then ! determine flux that is sent back to the land ! need to convert to mm/s to be consistent with totrunin units runoff%flood(nr) = & 1000._r8*(runoff%volr(nr,nt)-runoff%fthresh(nr)) / & (delt_rtm*runoff%area(nr)) - ! runoff%flood will be sent back to land - so must subtract this + ! runoff%flood will be sent back to land - so must subtract this ! from the input runoff from land ! tcraig, comment - this seems like an odd approach, you ! might create negative forcing. why not take it out of @@ -1130,7 +1129,7 @@ subroutine Rtmrun(totrunin, rstwr, nlend, rdate) endif enddo call t_stopf('RTMflood') - + ! BUDGET, flood out, just liquid water term if (budget_check) then call t_startf('RTMbudget') @@ -1333,7 +1332,7 @@ subroutine Rtmrun(totrunin, rstwr, nlend, rdate) call shr_sys_flush(iulog) call t_stopf('RTMrun') - + end subroutine Rtmrun !======================================================================= @@ -1349,37 +1348,37 @@ subroutine RtmFloodInit(frivinp, begr, endr, nt_rtm, fthresh, evel, & !----------------------------------------------------------------------- ! Uses use pio - use RtmVar , only : spval + use RtmVar , only : spval use shr_log_mod , only : errMsg => shr_log_errMsg - ! Subroutine arguments + ! Subroutine arguments ! in mode arguments character(len=*), intent(in) :: frivinp integer , intent(in) :: begr, endr, nt_rtm logical , intent(in) :: is_rtmflood_on !control flooding - logical , intent(in) :: is_effvel_on !control eff. velocity + logical , intent(in) :: is_effvel_on !control eff. velocity integer , intent(in) :: gindex( begr: ) ! global index [begr:endr] integer , intent(in) :: lnumr ! local number of cells ! out mode arguments real(r8), intent(out) :: fthresh( begr: ) ! Rtm water flood threshold ! [begr:endr] - real(r8), intent(out) :: evel( begr: , 1: )! effective velocity [begr:endr, nt_rtm] + real(r8), intent(out) :: evel( begr: , 1: )! effective velocity [begr:endr, nt_rtm] ! Local dynamically alloc'd variables - real(r8) , allocatable :: rslope(:) + real(r8) , allocatable :: rslope(:) real(r8) , allocatable :: max_volr(:) real(r8) , allocatable :: tempr1(:,:),tempr2(:,:) ! temporary buffer for netcdf read - integer(kind=pio_offset_kind), pointer :: compdof(:) ! computational degrees of freedom for pio + integer(kind=pio_offset_kind), pointer :: compdof(:) ! computational degrees of freedom for pio integer :: nt,n,cnt,nr ! indices logical :: readvar ! read variable in or not integer :: ier ! status variable - integer :: dids(2) ! variable dimension ids + integer :: dids(2) ! variable dimension ids integer :: dsizes(2) ! variable global sizes type(file_desc_t) :: ncid ! pio file desc - type(var_desc_t) :: vardesc1 ! pio variable desc - type(var_desc_t) :: vardesc2 ! pio variable desc + type(var_desc_t) :: vardesc1 ! pio variable desc + type(var_desc_t) :: vardesc2 ! pio variable desc type(io_desc_t) :: iodesc ! pio io desc character(len=256) :: locfn ! local file name @@ -1401,7 +1400,7 @@ subroutine RtmFloodInit(frivinp, begr, endr, nt_rtm, fthresh, evel, & min_ev4_5(:) = 0.05_r8 ! minimum downstream velocity (m/s) !---------------------- - ! if either is_rtmflood_on = .true. or is_effvel_on is .true. then do + ! if either is_rtmflood_on = .true. or is_effvel_on is .true. then do ! read slope and max_volr out of rdric file. Below we make the distinction ! between using SLOPE (only when is_effvel_on=.true.) and MAX_VOLR (which is ! always used when is_rtmflood_on is .true.). @@ -1447,17 +1446,17 @@ subroutine RtmFloodInit(frivinp, begr, endr, nt_rtm, fthresh, evel, & enddo call pio_initdecomp(pio_subsystem, pio_double, dsizes, compdof, iodesc) deallocate(compdof) - + ! Read data call pio_read_darray(ncid, vardesc1, iodesc, rslope, ier) call pio_read_darray(ncid, vardesc2, iodesc, max_volr, ier) - + ! Cleanup and close file call pio_freedecomp(ncid, iodesc) call pio_closefile(ncid) endif - + ! done reading rdirc file, now set fthresh and effvel if (is_rtmflood_on) then do nt = 1,nt_rtm @@ -1472,7 +1471,7 @@ subroutine RtmFloodInit(frivinp, begr, endr, nt_rtm, fthresh, evel, & do nt = 1,nt_rtm do n = begr, endr ! modify velocity based on gridcell average slope (Manning eqn) - evel(n,nt) = max(min_ev4_5(nt),effvel4_5(nt)*sqrt(max(0._r8,rslope(n)))) + evel(n,nt) = max(min_ev4_5(nt),effvel4_5(nt)*sqrt(max(0._r8,rslope(n)))) end do end do else @@ -1491,7 +1490,7 @@ subroutine RtmFloodInit(frivinp, begr, endr, nt_rtm, fthresh, evel, & if (masterproc) write(iulog,*) subname //':: Success ' - end subroutine RtmFloodInit + end subroutine RtmFloodInit !======================================================================= ! @@ -1510,7 +1509,7 @@ subroutine RtmFinalize() if (allocated(sfluxin)) deallocate(sfluxin) if (allocated(ddist)) deallocate(ddist) if (allocated(evel)) deallocate(evel) - + end subroutine RtmFinalize !=======================================================================