#!/usr/bin/perl -w
#
# This file was revised by Chuck Spalding from the original MKNEDAT as contained on the July 1,2003 DVD--
# Appendix A of the Republican River Compact Admistration Groundwater model June 30 2003.  The original
# MKNEDAT file was created on 6/29/03 @10:01 PM. This program creates files for 2001 and 2002 for input into
# RRPP.
#################### Note all revisions and original programming are identified by comments ################
#
# This file was modified on 4/21/04


#  This program takes the Nebraska groundwater and surface water data,
#  both exclusive and comingled, and builds data sets for the preprocessor.
#  Well data is converted into a format suitable for mkgw to generate
#  pumping and groundwater returns.
#  Surface water

use strict;
use lib '/pm/grflib/perl';
use DBF;

#  MODFLOW domain
my $X0   =   266023;
my $Y0   = 14092806;
my $DX   =     5280;
my $DY   =     5280;
my $Nrow =      165;
my $Ncol =      326;
my $N    = $Nrow*$Ncol;

#  River Pumpers return flow fractions
my $RPrf = 0.25;

##
## Private river canals were previously handled by two files, PrivateCanalLosses_to_Fields_NE_061003.dbf and
## SWexLand_Revised.dbf. These canals are now handled in the surface water file.  In the surface water file,
## the column "Volume" for private canals represents the diversion. Return flow from the private canals is specified
## system and is always 0.4 times the diversion as specified in the final model report and agreed by the RRCA committee.
## "Volume" for all other canals represents the volume of application to the fields. Because the private canals are in
## a now handled in the surface water file, the following calculation has been commented out.
##
###############################################Revision############################################################
#  Private Canals return flow fractions
#  my $PCrf = 0.40;

##
## Revise format for easy identification of Nebraska Canal Systems and return flow multipliers
##
###############################################Original############################################################
####  SW system return flow fractions. 815 added in 2008
####  my %SWrf = (800=>0.246,801=>0.246,802=>0.246,803=>0.246,804=>0.246,805=>0.246,
####            807=>0.287,808=>0.287,809=>0.287,
####            810=>0.2542,
####            811=>0.1886,
####            812=>0.4,813=>0.4,814=>0.4,816=>0.4,815=>0.4,817=>0.4,818=>0.4,822=>0.4,823=>0.4,824=>0.4,825=>0.4,826=>0.4,
####            819=>-1,820=>-1,821=>-1);
###############################################Revision############################################################

#  SW system return flow fractions
#
#-----------Federal----------------
#  Culbertson                   800
#  Culbertson Extension         801
#  Meeker-Driftwood             802
#  Bartley                      803
#  Red Willow                   804
#  Cambridge                    805
#  Franklin                     807
#  Naponee                      808
#  Franklin Pump                809
#  Superior                     810
#  Courtland                    811
#-----------Private----------------
#  Haigler                      812
#  Champion                     813
#  Riverside                    814
#-----------CNPPID----------------815 added in 2008
#  Jeffrey Hydro to J1          815
#  Jeffrey Hydro to J1          816
#  J1 to J2 Hydro               817
#  J2 to the Platte             818
#  Phelps                       819
#  E65                          820
#  E67                          821
#-----Platte Private Wells--------
#  Sixmile                      822
#  Thirtymile                   823
#  Orchard                      824
#  Western                      826
#-------------NPPD----------------
#  NPPD                         825
#------------River Pumpers---------
#

my %SWrf = (800=>0.246,
            801=>0.246,
            802=>0.246,
            803=>0.246,
            804=>0.246,
            805=>0.246,
            807=>0.287,
            808=>0.287,
            809=>0.287,
            810=>0.2542,
            811=>0.1886,
            812=>0.4,
            813=>0.4,
            814=>0.4,
            815=>0.4,
            816=>0.4,
            817=>0.4,
            818=>0.4,
            819=>-1,
            820=>-1,
            821=>-1,
            822=>0.4,
            823=>0.4,
            824=>0.4,
            825=>0.4,
            826=>0.4,);
###########################################End of Revision#########################################################

#
#  Offset from row and column
#  Store FORTRAN style (column major order)
#
sub offset
{
   my ($row,$col) = @_;
   return $Ncol*($row-1)+($col-1);
}

#  Years for which to operate
##
## Update end year for calculations
##
###############################################Original############################################################
#### my $yr0 = 1940;
#### my $yr1 = 2000;
###############################################Revision############################################################
my $yr0 = 2016;
my $yr1 = 2016;
###########################################End of Revision#########################################################

##
## Revise location to put output files
##
###############################################Original############################################################
#  Where to put output files for preprocessor
####my $dir  = 'ne12b';
###############################################Revision############################################################
my $dir  = 'ne2016';
###########################################End of Revision#########################################################

#  Irrigation distribution
my %irrdist = (6=>0.147,7=>0.320,8=>0.328,9=>0.205);

#  Open all the databases and index on year
#warn "Index databases\n";
##
## Revised file names and eliminate opening of separate private canal file
##
###############################################Original############################################################
#### my %db;
#### $db{GW}{EX} = DBF->open('ne-data/GWOnlyWells_Export.dbf'                    ,'DIRECT'); $db{GW}{EX}->index('Year','N');
#### $db{GW}{CO} = DBF->open('ne-data/CoWell_Export.dbf'                         ,'DIRECT'); $db{GW}{CO}->index('Year','N');
#### $db{SW}{EX} = DBF->open('ne-data/SWexLand_Revised.dbf'                      ,'DIRECT'); $db{SW}{EX}->index('Year','N');
#### $db{SW}{CO} = DBF->open('ne-data/SWcoLand_Revised.dbf'                      ,'DIRECT'); $db{SW}{CO}->index('Year','N');
#### $db{SW}{RP} = DBF->open('ne-data/RiverPumpers_NE_061003.dbf'                ,'DIRECT'); $db{SW}{RP}->index('Year','N');
#### $db{SW}{PC} = DBF->open('ne-data/PrivateCanalLosses_to_Fields_NE_061003.dbf','DIRECT'); $db{SW}{PC}->index('Year','N');
###############################################Revision############################################################
my %db;
$db{GW}{EX} = DBF->open('../GWOnlyExport.dbf','DIRECT'); $db{GW}{EX}->index('Year','N');
$db{GW}{CO} = DBF->open('../GWCoExport.dbf'  ,'DIRECT'); $db{GW}{CO}->index('Year','N');
$db{SW}{EX} = DBF->open('../SWOnlyExport.dbf','DIRECT'); $db{SW}{EX}->index('Year','N');
$db{SW}{CO} = DBF->open('../SWCoExport.dbf'  ,'DIRECT'); $db{SW}{CO}->index('Year','N');
##
## Private river canals were previously handled by two files, PrivateCanalLosses_to_Fields_NE_061003.dbf and
## SWexLand_Revised.dbf. These canals are now handled in the surface water file.  In the surface water file,
## the column "Volume" for private canals represents the diversion. Return flow from the private canals is specified
## system and is always 0.4 times the diversion as specified in the final model report and agreed by the RRCA committee.
## "Volume" for all other canals represents the volume of application to the fields. Because the private canals are in
## a now handled in the surface water file, the following file open call has been commented out.
## In addition the River Pumpers file, RiverPumpers_NE_061003.dbf, was eliminated from use.  This is now handled by the
## surface water comingled and exclusive files using a system number greater than 9000.
##
#### $db{SW}{PC} = DBF->open('ne-data/PrivateCanalLosses_to_Fields_NE_061003.dbf','DIRECT'); $db{SW}{PC}->index('Year','N');
###########################################End of Revision#########################################################

#  Process data year by year
#warn "Process data by year\n";
my (%cty,%volm,%area);
for (my $yr=$yr0;$yr<=$yr1;$yr++)
{
   #  Process all the wells
   foreach my $typ ('EX','CO')
   {
      #  Get well data for this year - need county totals only
      foreach my $rec ($db{GW}{$typ}->select('Year',$yr,'N','ROW','COLUMN','County','Area','Volume'))
      {
         my ($row,$col,$cty,$acr,$pmp) = @{$rec}{'ROW','COLUMN','County','Area','Volume'};
         #  Remember county
         $cty{$cty} = 1;
         #  Accumulate pumping and acres by type, county and year
         $volm{GW}{$typ}{$cty}{$yr} += $pmp;
         $area{GW}{$typ}{$cty}{$yr} += $acr;
      }
   }
   #  Process surface acres - need county totals only
   foreach my $typ ('EX','CO')
   {
      #  Get surface data for this year
      foreach my $rec ($db{SW}{$typ}->select('Year',$yr,'N','County','Area','Volume'))
      {
         my ($cty,$acr,$div) = @{$rec}{'County','Area','Volume'};
         #  Remember county
         $cty{$cty} = 1;
         #  Accumulate diversions and acres by type, county and year
         $volm{SW}{$typ}{$cty}{$yr} += $div;
         $area{SW}{$typ}{$cty}{$yr} += $acr;
      }
   }
}

#  Make sorted county list
my @cty = sort keys %cty;

#
#  Set missing years to zero
#  Check to make sure GW and SW data agree on comingled acres
#  Translate pumping into rates for comingled
my %rate;
for (my $yr=$yr0;$yr<=$yr1;$yr++)
{
   foreach my $cty (@cty)
   {
      #  Set missing years to zero
      foreach my $src ('GW','SW')
      {
         foreach my $typ ('EX','CO')
         {
            exists($volm{$src}{$typ}{$cty}{$yr}) || ($volm{$src}{$typ}{$cty}{$yr} = 0);
            exists($area{$src}{$typ}{$cty}{$yr}) || ($area{$src}{$typ}{$cty}{$yr} = 0);
         }
      }
      #  Check that SW & GW comingled areas match to withing 5 acre-feet
      (abs($area{SW}{CO}{$cty}{$yr}-$area{GW}{CO}{$cty}{$yr})>10) && die "Error SW-GW comingling area mismatch $cty $area{SW}{CO}{$cty}{$yr} $area{GW}{CO}{$cty}{$yr}\n";
      #  Calculate rate of application - 0 if none
      $rate{GW}{CO}{$cty}{$yr} = ($area{GW}{CO}{$cty}{$yr}>0) ? $volm{GW}{CO}{$cty}{$yr}/$area{GW}{CO}{$cty}{$yr} : 0;
      $rate{GW}{EX}{$cty}{$yr} = ($area{GW}{EX}{$cty}{$yr}>0) ? $volm{GW}{EX}{$cty}{$yr}/$area{GW}{EX}{$cty}{$yr} : 0;
      $rate{SW}{CO}{$cty}{$yr} = ($area{SW}{CO}{$cty}{$yr}>0) ? $volm{SW}{CO}{$cty}{$yr}/$area{SW}{CO}{$cty}{$yr} : 0;
      $rate{SW}{EX}{$cty}{$yr} = ($area{SW}{EX}{$cty}{$yr}>0) ? $volm{SW}{EX}{$cty}{$yr}/$area{SW}{EX}{$cty}{$yr} : 0;
   }
}

#warn "Save county summaries\n";
#
#  Save volumes & areas in year-county format
#
sub save
{
   my ($data,$file) = @_;
   open(DAT , ">$file") || die "Cannot open file ne-data/$file\n";
   print DAT "Year";
   foreach my $cty (@cty)
   {
      printf DAT " %12s" , $cty;
   }
   print DAT "\n";
   for (my $yr=$yr0;$yr<=$yr1;$yr++)
   {
      printf DAT "%4d" , $yr;
      foreach my $cty (@cty)
      {
         printf DAT " %12.2f" , $data->{$cty}{$yr};
      }
      print DAT "\n";
   }
   close(DAT);
}
save($volm{GW}{EX},'nepump.gw');
save($volm{GW}{CO},'nepump.co');
save($volm{SW}{EX},'nediv.sw');
save($volm{SW}{CO},'nediv.co');
save($rate{GW}{EX},'nerate.gw');
save($rate{GW}{CO},'nerate.cg');
save($rate{SW}{EX},'nerate.sw');
save($rate{SW}{CO},'nerate.cs');
save($area{GW}{EX},'nearea.gw');
save($area{SW}{EX},'nearea.sw');
save($area{SW}{CO},'nearea.co');

#
#  Store volumes for rrpp
#
sub store
{
   my ($dir,$yr,$mo,$ext,$var) = @_;
   my $file = sprintf "%s/%.4d.%.2d.%s" , $dir , $yr , $mo , $ext;
   open(DAT , ">$file") || die "Cannot open file $file\n";
   for (my $l=0;$l<$N;$l++)
   {
      print DAT $irrdist{$mo}*$var->[$l] . "\n";
   }
   close(DAT);
}

#warn "Save cell by cell\n";
#  Calculate cell by cell pumping, recharge, area and rate
for (my $yr=$yr0;$yr<=$yr1;$yr++)
{
   #  Set volumes amd areas to 0
   my (%area,%ret);
   my @pmp  = (0) x ($N);
   @{$area{GW}} = @{$area{SW}} = @{$area{CO}} = (0) x ($N);
   @{$ret{GW}}  = @{$ret{SW}}  = (0) x ($N);
   #  Get all the surface water diversions
   foreach my $typ ('EX','CO')
   {
      #  Process individual lands for this year
      foreach my $rec ($db{SW}{$typ}->select('Year',$yr,'N','ROW','COLUMN','County','Area','Volume','System'))
      {
         my ($row,$col,$cty,$acr,$div,$sys) = @{$rec}{'ROW','COLUMN','County','Area','Volume','System'};
         my $l = offset($row,$col);
         #  For comingled lands, add groundwater to surface water
         #  GW = comingled rate for county and year times area
         my $pmp = ($typ eq 'CO') ? $rate{GW}{CO}{$cty}{$yr}*$acr : 0;
         #  No water this year - skip the rest
         ($div+$pmp>0) || next;
##
## Revise code to handle river pumper efficiency. Any system code greater than 999 is assigned a return of 0.25
##
##############################################Original############################################################
#
#        #  Calculate return flows
#        exists($SWrf{$sys}) || die "Unknown SW system $sys\n";
#        my $SWrf = $SWrf{$sys};
###############################################Revision############################################################
         ($sys>999 || exists($SWrf{$sys})) || die "Unknown SW system $sys\n";
         my $SWrf = ($sys>999) ? 0.25 : $SWrf{$sys};
##
## Extend return flow multiplier of 0.30 for CNPPID surface water (efficiency of 70%) to 2001 and beyond
##
###############################################Original############################################################
#         ($SWrf<0) && ($SWrf = ($yr>1960) ? 0.4-0.0025*($yr-1960) : 0.4);
###############################################Revision############################################################
          ($SWrf<0) && ($SWrf = 0.3);
###########################################End of Revision#########################################################

         $area{($typ eq 'EX') ? 'SW' : 'CO'}[$l] += $acr;
         $ret{GW}[$l] += $SWrf*$pmp;
         $ret{SW}[$l] += $SWrf*$div;
      }
   }
   #  Get all the wells - static monthly distribution
   foreach my $typ ('EX','CO')
   {
      #  Get well data for this year
      foreach my $rec ($db{GW}{$typ}->select('Year',$yr,'N','ROW','COLUMN','County','Area','Volume'))
      {
         my ($row,$col,$cty,$acr,$pmp) = @{$rec}{'ROW','COLUMN','County','Area','Volume'};
         my $l = offset($row,$col);
         #  No water this year - skip the rest
         ($pmp>0) || next;
         #  Add pumping to cell
         $pmp[$l] += $pmp;
         #  Add area, volume and return flows to groundwater exclusive lands
         if ($typ eq 'EX')
         {
##
## Extend return flow multiplier of 0.20 for ground water (efficiency of 80%) to 2001 and beyond
##
###############################################Original############################################################
#           my $GWrf = ($yr>1960) ? 0.3-0.0025*($yr-1960) : 0.3;
###############################################Revision############################################################
            my $GWrf = 0.2;
###########################################End of Revision#########################################################

            $area{GW}[$l] += $acr;       #  Record GW acres
            $ret{GW}[$l]  += $pmp*$GWrf; #  Record GW returns
         }
      }
   }
##
#    #  Process river pumpers for this year
#   foreach my $rec ($db{SW}{RP}->select('Year',$yr,'N','ROW','COLUMN','Volume'))
#   {
#      my ($row,$col,$vol) = @{$rec}{'ROW','COLUMN','Volume'};
#      my $l = offset($row,$col);
#      $ret{SW}[$l] += $RPrf*$vol;
#   }
##
## Private river canals were previously handled by two files, PrivateCanalLosses_to_Fields_NE_061003.dbf and
## SWexLand_Revised.dbf. These canals are now handled in the surface water file.  In the surface water file,
## the column "Volume" for private canals represents the diversion. Return flow from the private canals is specified
## system and is always 0.4 times the diversion as specified in the final model report and agreed by the RRCA committee.
## "Volume" for all other canals represents the volume of application to the fields. Because the private canals are in
## a now handled in the surface water file, the following calculation has been commented out.
##
###############################################Revision############################################################
#   #  Process river private canals for this year
#   foreach my $rec ($db{SW}{PC}->select('Year',$yr,'N','ROW','COLUMN','Volume'))
#   {
#      my ($row,$col,$vol) = @{$rec}{'ROW','COLUMN','Volume'};
#      my $l = offset($row,$col);
#      $ret{SW}[$l] += $PCrf*$vol;
#   }
###########################################End of Revision#########################################################
   #  Save annual irrigated area files
   foreach my $typ ('SW','GW','CO')
   {
      my $file = sprintf "%s/%.4d.a%s" , $dir , $yr , lc($typ);
      open(DAT , ">$file") || die "Cannot open file $file\n";
      for (my $l=0;$l<$N;$l++)
      {
         print DAT "$area{$typ}[$l]\n";
      }
      close(DAT);
   }
   #  Save monthly pumping and returns
   foreach my $mo (sort keys %irrdist)
   {
      store($dir,$yr,$mo,'pmp',\@pmp);
      store($dir,$yr,$mo,'rcg',$ret{GW});
      store($dir,$yr,$mo,'rcs',$ret{SW});
   }
}
