module RvicVar 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 RvicSpmd , only : masterproc use rvic_cpl_indices, only : nt_rvic implicit none ! PUBLIC MEMBER FUNCTIONS: ! PUBLIC DATA MEMBERS: ! Constants 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) ! Run control variables character(len=SHR_KIND_CL), public :: caseid = ' ' ! case id character(len=SHR_KIND_CL), public :: ctitle = ' ' ! case title character(len=SHR_KIND_CL) :: starttype ! start-type (startup, continue, branch, hybrid) 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=SHR_KIND_CL), public :: calendar ! calendar type name 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 = "RVIC0.0_beta" ! description of this source ! Instance control integer , public :: inst_index character(len=16), public :: inst_name character(len=16), public :: inst_suffix ! Rvic control variables character(len=SHR_KIND_CL), public :: nrevsn_rvic = ' ' ! restart data file name for branch run character(len=SHR_KIND_CL), public :: finidat_rvic = ' ' ! initial conditions file name character(len=SHR_KIND_CL), public :: frivinp_rvic = ' ' ! RVIC input data file name logical, public :: ice_runoff = .false.! true => runoff is split into liquid and ice, ! otherwise just liquid ! Rvic grid size integer :: rviclon = 1 ! number of rvic longitudes (initialize) integer :: rviclat = 1 ! number of rvic latitudes (initialize) character(len=SHR_KIND_CL), public :: rpntfil = 'rpointer.rof' ! file name for local restart pointer file logical, private :: RvicVar_isset = .false. ! RVIC data structure type RVIC_type sequence integer :: nSources = 0 ! Number of source points integer :: nOutlets = 0 ! Number of outlet points integer :: nTracers = 0 integer :: subset_length = 0 ! Length of subset --> len(time) integer :: full_time_length = 0 ! Original UH length before subsetting --> len(ring) integer :: unit_hydrograph_dt = 0 ! Timestep of Unit Hydrograph (Internal RVIC timestep) real(r8) :: ring_timestamp ! days since basetime integer, dimension(:), allocatable :: source_decomp_ind ! ROF grid cell ID of source point integer, dimension(:), allocatable :: source_x_ind ! X index location of source point integer, dimension(:), allocatable :: source_y_ind ! Y index location of source point integer, dimension(:), allocatable :: source_time_offset ! Time offset of source point unit hydrograph integer, dimension(:), allocatable :: source2outlet_ind ! Mapping from source point to outlet point integer, dimension(:), allocatable :: source_tracer ! tracer to associate uh with integer, dimension(:), allocatable :: outlet_decomp_ind ! ROF grid cell ID of outlet point integer, dimension(:), allocatable :: outlet_x_ind ! X index location of outlet point integer, dimension(:), allocatable :: outlet_y_ind ! Y index location of outlet point integer, dimension(:), allocatable :: outlet_number ! Outlet index number integer, dimension(:), allocatable :: outlet_mask integer, dimension(:), allocatable :: ring_timesteps ! Timesteps from state file real(r8), dimension(:,:,:), allocatable :: unit_hydrograph ! Unit Hydrograph of source point real(r8), dimension(:,:,:), allocatable :: ring ! Convolution ring real(r8), dimension(:,:), allocatable :: agg_in ! array to hold aggregated fluxes real(r8), pointer :: point_in(:,:) ! pointer to unpacked flux array real(r8), dimension(:,:), allocatable :: upstrm_storage real(r8), dimension(:,:), allocatable :: upstrm_dstorage ! counters integer :: agg_tsteps = 0 ! number of coupling timesteps per rvic timestep integer :: agg_counter = 0 end type RVIC_type ! copy of RTM runoff type type runoff_flow ! - local initialization real(r8), pointer :: lonc(:) ! lon of cell real(r8), pointer :: latc(:) ! lat of cell real(r8), pointer :: area(:) ! area of cell integer, dimension(:), allocatable :: gindex ! global index ! - local runtime real(r8), pointer :: runoff(:,:) ! RVIC flow (m**3 H2O/s) real(r8), pointer :: runofflnd(:,:) ! runoff masked for land (m**3 H2O/s) real(r8), pointer :: runoffocn(:,:) ! runoff masked for ocn (m**3 H2O/s) !real(r8), pointer :: runoffguage(:,:) ! runoff masked for streamflow guage real(r8), pointer :: dvolrdt(:,:) ! RVIC change in storage (mm/s) real(r8), pointer :: dvolrdtlnd(:,:) ! dvolrdt masked for land (mm/s) real(r8), pointer :: dvolrdtocn(:,:) ! dvolrdt masked for ocn (mm/s) real(r8), pointer :: volr(:,:) ! RVIC storage (m**3) real(r8), pointer :: volrlnd(:,:) ! RVIC storage masked for land (m**3) ! - global !integer , pointer :: mask(:) ! mask of cell 0=none, 1=lnd, 2=ocn real(r8), pointer :: rlon(:) ! rvic longitude list, 1d real(r8), pointer :: rlat(:) ! rtm latitude list, 1d integer :: numr ! rvic gdc global number of cells integer :: numrl = 0 ! rvic gdc global number of lnd cells integer :: numro = 0 ! rvic gdc global number of ocn cells ! - local integer :: begr,endr ! local start/stop indices integer :: lnumr ! local number of cells ! - 1d field pointers for history files (currently needed) real(r8), pointer :: runofflnd_nt1(:) real(r8), pointer :: runofflnd_nt2(:) real(r8), pointer :: runoffocn_nt1(:) real(r8), pointer :: runoffocn_nt2(:) real(r8), pointer :: dvolrdtlnd_nt1(:) real(r8), pointer :: dvolrdtlnd_nt2(:) real(r8), pointer :: dvolrdtocn_nt1(:) real(r8), pointer :: dvolrdtocn_nt2(:) real(r8), pointer :: volr_nt1(:) real(r8), pointer :: volr_nt2(:) end type runoff_flow type (runoff_flow), public :: runoff type (RVIC_type), public, target :: rvar real(r8), pointer :: lon(:,:),lat(:,:),area(:,:),mask(:,:) ! Unit Numbers integer, public :: iulog = 6 ! "stdout" log file unit number, default is 6 ! PRIVATE MEMBER FUNCTIONS ! PRIVATE DATA MEMBERS ! REVISION HISTORY: ! Author: Joe Hamman, University of Washington !================================================================================ contains subroutine RvicVarSet( caseid_in, ctitle_in, brnch_retain_casename_in, & nsrest_in, version_in, hostname_in, username_in ) !----------------------------------------------------------------------- ! Set input control variables. ! ! !ARGUMENTS: 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 logical, optional, intent(IN) :: brnch_retain_casename_in ! true => allow case name to !----------------------------------------------------------------------- if ( RvicVar_isset )then call shr_sys_abort( 'RvicVarSet ERROR:: control variables already set -- EXIT' ) end if if (present(caseid_in)) caseid = caseid_in if (present(ctitle_in)) ctitle = ctitle_in if (present(nsrest_in)) nsrest = nsrest_in if (present(version_in)) version = version_in if (present(username_in)) username = username_in if (present(hostname_in)) hostname = hostname_in if (present(brnch_retain_casename_in)) brnch_retain_casename = brnch_retain_casename_in end subroutine RvicVarSet !================================================================================ subroutine RvicVarInit( ) if (masterproc) then if (nsrest == iundef) then call shr_sys_abort( 'RvicVarInit ERROR:: must set nsrest' ) end if if (nsrest == nsrBranch .and. nrevsn_rvic == ' ') then call shr_sys_abort( 'RvicVarInit ERROR: need to set restart data file name' ) end if if (nsrest == nsrStartup ) then nrevsn_rvic = ' ' end if if (nsrest == nsrContinue) then nrevsn_rvic = 'set by restart pointer file file' end if if (nsrest /= nsrStartup .and. nsrest /= nsrContinue .and. nsrest /= nsrBranch ) then call shr_sys_abort( 'RvicVarInit ERROR: nsrest NOT set to a valid value' ) end if endif RvicVar_isset = .true. end subroutine RvicVarInit !--------------------------------------------------------------------------- subroutine FluxContainInit(begr, endr, numr) !--------------------------------------------------------------------------- ! DESCRIPTION: ! Initilize the runoff fields ! ! ARGUMENTS: integer, intent(in) :: begr, endr, numr ! LOCAL VARIABLES: integer :: ier !--------------------------------------------------------------------------- allocate(rvar%agg_in(begr:endr,nt_rvic), & rvar%point_in(begr:endr, nt_rvic)) Rvar%agg_in = 0.0_r8 end subroutine FluxContainInit subroutine RunoffInit(begr, endr, numr, gsize) !--------------------------------------------------------------------------- ! DESCRIPTION: ! Initilize the runoff fields ! ! ARGUMENTS: integer, intent(in) :: begr, & ! local start index endr, & ! local end index numr, & ! total local number of points gsize ! global size of array ! LOCAL VARIABLES: integer :: ier !--------------------------------------------------------------------------- runoff%begr = begr runoff%endr = endr allocate(runoff%runoff(begr:endr,nt_rvic), & runoff%dvolrdt(begr:endr,nt_rvic), & runoff%runofflnd(begr:endr,nt_rvic), & runoff%dvolrdtlnd(begr:endr,nt_rvic),& runoff%runoffocn(begr:endr,nt_rvic), & runoff%dvolrdtocn(begr:endr,nt_rvic),& runoff%area(begr:endr), & runoff%volr(begr:endr,nt_rvic), & runoff%volrlnd(begr:endr,nt_rvic), & runoff%lonc(begr:endr), & runoff%latc(begr:endr), & runoff%runofflnd_nt1(begr:endr), & runoff%runofflnd_nt2(begr:endr), & runoff%runoffocn_nt1(begr:endr), & runoff%runoffocn_nt2(begr:endr), & runoff%volr_nt1(begr:endr), & runoff%volr_nt2(begr:endr), & runoff%dvolrdtlnd_nt1(begr:endr), & runoff%dvolrdtlnd_nt2(begr:endr), & runoff%dvolrdtocn_nt1(begr:endr), & runoff%dvolrdtocn_nt2(begr:endr), & runoff%gindex(begr:endr), & runoff%rlon(gsize), & runoff%rlat(gsize), & stat=ier) if (ier /= 0) then write(iulog,*)'RVIC ERROR allocation of runoff local arrays' call shr_sys_abort end if runoff%runoff(:,:) = 0._r8 runoff%runofflnd(:,:) = 0._r8 !spval runoff%runoffocn(:,:) = 0._r8 !spval runoff%dvolrdt(:,:) = 0._r8 runoff%dvolrdtlnd(:,:) = 0._r8 !spval runoff%dvolrdtocn(:,:) = 0._r8 !spval runoff%volr(:,:) = 0._r8 runoff%volrlnd(:,:) = 0._r8 !spval !runoff%flood(:) = 0._r8 runoff%gindex(:) = 0 runoff%rlon(:) = 0._r8 runoff%rlat(:) = 0._r8 end subroutine RunoffInit subroutine RvicRvarSet(rvar_set) !--------------------------------------------------------------------------- ! DESCRIPTION: ! Check that the Rvar Variable has been filled by the State and Parameter ! Files and print a summary to the rvic log file ! ! ARGUMENTS: logical, intent(out) :: rvar_set ! ! LOCAL VARIABLES: character(len=*), parameter :: subname = 'RvicRvarSet' character(len=*), parameter :: format = "('("//trim(subname)//") :',A)" !--------------------------------------------------------------------------- ! Run through a set of tests to check if rvar has been set !--------------------------------------------------------------------------- rvar_set = .TRUE. if (Rvar%nSources == 0) then rvar_set = .FALSE. write(iulog, format) 'Error: nSources = 0' endif if (Rvar%nOutlets == 0) then rvar_set = .FALSE. write(iulog, format) 'Error: nOulets = 0' endif if (Rvar%subset_length == 0) then rvar_set = .FALSE. write(iulog, format) 'Error: subset_length = 0' endif if (Rvar%full_time_length == 0) then rvar_set = .FALSE. write(iulog, format) 'Error: full_time_length = 0' endif if (Rvar%unit_hydrograph_dt == 0) then rvar_set = .FALSE. write(iulog, format) 'Error: unit_hydrograph_dt = 0' endif if (any(Rvar%ring<0.0_r8)) then !rvar_set = .FALSE. write(iulog, format) 'Warning: An element of the runoff ring is negative' endif if (minval(Rvar%source_decomp_ind)Runoff%endr) then rvar_set = .FALSE. write(iulog, format) 'Error: The max value of source_decomp_ind is gt endr' write(iulog, *) 'Max(Rvar%source_decomp_ind): ',maxval(Rvar%source_decomp_ind) write(iulog, *) 'endr: ', Runoff%endr endif if (maxval(Rvar%outlet_decomp_ind)>Runoff%endr) then rvar_set = .FALSE. write(iulog, format) 'Error: The max value of outlet_decomp_ind is gt endr' write(iulog, *) 'Max(Rvar%outlet_decomp_ind): ',maxval(Rvar%outlet_decomp_ind) write(iulog, *) 'endr: ', Runoff%endr endif if (Rvar%full_time_length /= size(Rvar%ring,1)) then rvar_set = .FALSE. write(iulog, format) 'Error: Size of ring does not match full_time_length' end if ! --------------------------------------------------------------------------- ! Runoff Var Summary !--------------------------------------------------------------------------- write(iulog, format) " ========= Runoff VAR SUMMARY ===========" if (rvar_set==.true.) then write(iulog, *) 'Rvar passed tests' else write(iulog, *) 'Rvar failed tests... printing outputs anyways.' end if write(iulog, *) "Number of Source Points: ", Rvar%nSources write(iulog, *) "Number of Outlet Points: ", Rvar%nOutlets write(iulog, *) "Length of Subset Time Dim: ", Rvar%subset_length write(iulog, *) "Original UH length before subsetting --> len(ring): ", Rvar%full_time_length write(iulog, *) "Timestep of Unit Hydrograph: ", Rvar%unit_hydrograph_dt write(iulog, *) " +++++++ Variable / Shape / Min / Max +++++++" write(iulog, *) "source_decomp_ind: ", shape(Rvar%source_decomp_ind), minval(Rvar%source_decomp_ind), maxval(Rvar%source_decomp_ind) write(iulog, *) "source_x_ind: ", shape(Rvar%source_x_ind), minval(Rvar%source_x_ind), maxval(Rvar%source_x_ind) write(iulog, *) "source_y_ind: ", shape(Rvar%source_y_ind), minval(Rvar%source_y_ind), maxval(Rvar%source_y_ind) write(iulog, *) "outlet_number: ", shape(Rvar%outlet_number), minval(Rvar%outlet_number), maxval(Rvar%outlet_number) write(iulog, *) "unit_hydrograph: ", shape(Rvar%unit_hydrograph), minval(Rvar%unit_hydrograph), maxval(Rvar%unit_hydrograph) write(iulog, *) "current_rof: ", shape(Rvar%ring(1,:,:)), minval(Rvar%ring(1,:,:)), maxval(Rvar%ring(1,:,:)) write(iulog, format) " ************ END OF Runoff VAR SUMMARY ************" end subroutine RvicRvarSet !--------------------------------------------------------------------------- end module RvicVar