#! /usr/bin/perl 
#
#    Jun 27/05 - F.Majaess (Relax the [1,2,3,4,6,12] "months" value 
#                           constraints)
#    Dec 20/04 - F.Majaess (Allow specifying "actual year" to use as
#                           base reference year via "ayear" parameter.
#                           Mainly to support "amip" run case.)
#    Nov 02/04 - F.Majaess (Allow specifying start month via "monthw"
#                           input parameter option)
#    May 31/04 - F.Majaess (Revised to add "initsp" option support)
#    Jun 06/03 - F.Majaess (Revised for multi-month option support)
#    Nov 12/03 - F.Majaess (Revised for 9-characters "delt")
#    Jan 04/00 - F.Majaess (Revised to get around "reserved words" 
#                           passed as argument (ie. run=tr)).
#    May 17/99 - F.Majaess (Revised to extract and use parmsub "delt"
#                           and for installation as a standard script)
#    Nov 14/97 - Damin Liu
#
#id  create_run - Used to generate model run string from a base file.
#
#    AUTHOR  -  Damin Liu
#
#hd PURPOSE  - This script generates a model run string for a specified
#hd            number of years (the default is 10 years) from a base 
#hd            "${runid}.base" file.
#hd            Note: Sample "base file" can be found in $CCRNINFO directory,
#hd                  such as "$CCRNINFO/sample_gcm6u_model_base_for_create_run"
#hd                  file.
#hd 
#
#pr PARAMETERS:
#pr
#pr   PRIMARY/SECONDARY
#pr     
#pr     h      = Display help (optional).
#pr     runid  = The model identifier. This parameter is compared
#pr              with those in "${runid}.base" file as a safety check.
#pr     year   = The starting year (must be >= "ayear").
#pr     years  = Number of years for which the string is created.
#pr              (optional; defaults to 10).
#pr     ayear  = The "actual year" to use as base reference year 
#pr              when substituting the "year" value.
#pr              (optional; defaults to 1)
#pr     monthw = The starting month. 
#pr              (optional; defaults to 1; valid values: 1,2,...,11,12).
#pr     months = Number of months to run at the time.
#pr              (optional; defaults to 1; 
#pr               Note: "yearly section" processing is honoured only 
#pr                     if "months" value is one of: [1,2,3,4,6,12],
#pr                     otherwise, "yearly section" processing is
#pr                     disabled).
#pr     initsp = Optional switch, if set to "on" will lead to changing 
#pr              in the generated first month's job:
#pr                 - "start" year from "000" to "001",
#pr                        (or "ayear - 1" to "ayear"),
#pr                 - "start" month from "m12" to "m01",
#pr                 - "samerun=on" to "samerun=off",
#pr                 - "initsp=off" to "initsp=on".
#pr              (Defaults to "off"; valid values: "on"/"off").
#pr     cwext  = A variable which may be useful in the universal
#pr              variable declaration section. For instance, it
#pr              can be used as an identifier for 'crawork' and
#pr              'flabel'. (optional)
#pr NOTE:     This script relies on "#MARKER:..." lines in "{runid}.base"
#pr           base file to act as separators between the various sections
#pr           except possibly for the optional "MARKER:.*End of Template"
#pr           line which closes the base file template.
#pr
#pr           From                              to
#pr           --------------------------------  -------------------------------
#pr
#pr           beginning                         "#end_of_global_def"
#pr           (definition of global parameters section which get inserted
#pr            at the top of the "parmsub section" of every job in the
#pr            job string).
#pr
#pr           "#MARKER:.*Monthly Section"       "#MARKER:.*End of Monthly"
#pr           (main monthly job;
#pr            variables altered: "kfinal,year,year_restart,mon,mon_restart,
#pr                                days,obsday").
#pr
#pr           "#MARKER:.*Yearly Section"        "#MARKER:.*End of Yearly"
#pr           (inserted at the end of month 12 of each year;
#pr            variables altered: "year".
#pr            Note: Processing disabled if "months" value is set to other 
#pr                  than one of: [1,2,3,4,6,12]).
#pr
#pr           "#MARKER:.*Special Section"       "#MARKER:.*End of Special"
#pr           (inserted once at the end of the job string produced;
#pr            variables altered: "year").
#pr
#pr           (please refer to the sample in $CCRNINFO directory).
#pr
#pr
#pr  USAGE: create_run [h] runid=xx year=y [years=y] [ayear=y] [initsp=on] [months=...] [monthw=...] [cwext=_xx]
#pr
#ex EXAMPLE:
#ex
#ex     create_run  runid=xx  year=1 years=6 initsp=on months=3
#ex
#ex   A sample use for amip run:
#ex     
#ex     create_run  runid=xx  year=1974 years=23 ayear=1974 months=12
#ex
#ex   another
#ex
#ex     create_run  runid=xx  year=1984 years=13 ayear=1974 months=12
#ex

# Code for "include" to check in "SUBPROC" for referenced modules

BEGIN {
unshift(@INC,$ENV{SUBPROC});
}

use cccma_perl_functions;

# define constants

@days=(31,28,31,30,31,30,31,31,30,31,30,31);
@mname=(JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC);
@prfx=('y','s');
@vmonths=(1,2,3,4,6,12);
@vmonthw=(1,2,3,4,5,6,7,8,9,10,11,12);

for (@ARGV) {
#evaluate input parameters.
#   eval "\$$_" if (/run=.*|runid=.*|year=.*|years=.*|cwext=.*/);
# the above caused problem for "run=tr". To get around such
# encounters, the initialization is done via environment variable 
# setting:

 if (/run=.*|runid=.*|year=.*|years=.*|ayear=.*|months=.*|monthw=.*|initsp=.*|cwext=.*/) {
   ($key,$value) = split('=', $_ , 2 ) ;
#  $ENV{$key} =  $value  ;
#  ${$key} = $ENV{$key} ;
#  Use the above 2 lines or the more efficient one:
   ${$key} = $value  ;
 } ;

}
$runid=(defined $runid)? $runid : $run;
$ayear=(defined $ayear)? $ayear : 1;
$months=(defined $months)? $months : 1;
$monthw=(defined $monthw)? $monthw : 1;
$initsp=(defined $initsp)? $initsp : 'off';

# if year or runid undefined, or help is requested, display help.

if ($h || !($year&&$runid)) {
    Display_help0($0);
    exit -1;
}

# Abort if "year" < "ayear".

if ( $year<$ayear ) { die "\nAbort: year(=$year) must be >= ayear(=$ayear)!\n\n"; };

# Check if run.table non-empty file exists and set "runtbl" 
# variable accordingly.

$runtbl=0;
open(TABLE, "<../run.table") ;
while (<TABLE>) {
    chop;
    $runtbl++;
}

# read model base file from current directory.
$procid=$$;
$basefile="${runid}.base";
open(BASE, "<$basefile") || die "cannot open $basefile";

# process "global definition" section...
open(SH,"|sh") || die "cannot open shell";

print SH "cwext=$cwext;";
while (<BASE>) {
    last if /^#end_of_global_def/;
    if (m=^#!/bin/sh=) {$line=$_; last;}
    if (m=^#MARKER:=)  {$line=$_; last;}
    next if /^#/;
    print SH;
    print SH "set +x;cat >>${procid}.parm <<end_of_parm\n${_}end_of_parm\n";
}
close SH;

if (open(PARMDEF,"<${procid}.parm")) {
    $global_def="#  * ..................... Definition of Global Parameters .....................\n";
    while (<PARMDEF>) {
        next if /^#/;
        $global_def.=$_;
    }
    close PARMDEF;
}

# Read the rest of the sections and ...
open(TEMPLATE,">${procid}.template") || die "cannot open ${procid}.template";
print TEMPLATE $line;
while (<BASE>) {
    last if /^#MARKER:.*End of Template/;
    print TEMPLATE $global_def if (/#.*Parmsub Parameters/);
    print TEMPLATE;
}
close TEMPLATE;
close BASE;

# Initialize appropriate variables and process each of the
# individual sections ...
$flag=0; $yflag=0; $sflag=0;

open(TEMPLATE,"<${procid}.template") || die "cannot open ${procid}.template";
while (<TEMPLATE>) {
    if (/^#MARKER:.*Monthly Section/ .. /^#MARKER:.*End of Monthly/) {
     if (!/^#MARKER:.*/) { $base.=$_; $flag++; };
    };
    if (/^#MARKER:.*Yearly Section/ .. /^#MARKER:.*End of Yearly/) {
     if (!/^#MARKER:.*/) { $ybase.=$_; $yflag++; };
    };
    if (/^#MARKER:.*Special Section/ .. /^#MARKER:.*End of Special/) {
     if (!/^#MARKER:.*/) { $sbase.=$_; $sflag++; };
    };
}
close TEMPLATE;

unlink "${procid}.template", "${procid}.parm";

# Abort if the monthly section is empty...

if ( $flag==0) { die "\nAbort: monthly section is empty!\n\n"; };


# Preserve "yflag" value in "hldyflag" for later test...

$hldyflag=$yflag;

# Abort on invalid "months" value entered... 

if ( $months > 1 ) {

 # if ( $months > 24) { die "\nAbort: Invalid months=$months (>24) value!\n\n"; };

 $Mtch=0;

 for $Var (@vmonths) {
  if ($Var==$months) {
    $Mtch++ ;
  };
 };

#if ( $Mtch!=1) { die "\nAbort: Invalid months=$months value!\n\n"; };
 if ( $Mtch!=1) { $yflag=0 ; } ;

};

# Abort on invalid "monthw" value entered... 

if ( $monthw>1 ) {

 $Mtch=0;

 for $Var (@vmonthw) {
  if ($Var==$monthw) {
    $Mtch++ ;
  };
 };

 if ( $Mtch!=1) { die "\nAbort: Invalid monthw=$monthw value!\n\n"; };

};

# Ensure there is no mismatch between entered "runid"/"months" values and those
# specified in the "base" file ...

$Nmismtch=0;
#  Check value for runid in base file's "monthly" section ...
if ( $flag>0 ) {
  if(@offends=grep(!/\brunid="*$runid"*/,grep(/.*\brunid=.*?;.*/g,split("\n",$base)))) {
      print "\nvalue(s) for runid in base file monthly section:\n\n";
      for $offend (@offends) {
          print "$offend\n";
          $Nmismtch++ ;
      };
#     die "value(s) for runid in base file not matching runid provided.";
      print "\nnot matching runid provided!.\n\n";
  };
};
#  ... and in the other "base" file's sections as well.
for $Var (@prfx) {
  $Xvar=${"${Var}flag"};
# print "\$Var=$Var, \$Xvar=$Xvar\n";
# if ($Xvar==2) {
#  $Xbase=${"${Var}base"};
#  print "\$Xbase=$Xbase\n";
# };
  if ($Xvar>0 ) {
#   print "\$Var=$Var, \$Xvar=$Xvar > 0 \n";
    if(@offends=grep(!/\brunid="*$runid"*/,grep(/.*\brunid=.*?;.*/g,split("\n",${"${Var}base"}))))
{
        print "\nvalue(s) for runid in ${Var}base file:\n\n";
        for $offend (@offends) {
            print "$offend\n";
            $Nmismtch++ ;
        };
#       die "value(s) for runid in ${Var}base file not matching runid provided.";
        print "\nnot matching runid provided!.\n\n";
    };
  };
};

# Abort if any "runid" mismatch was found...

if ($Nmismtch>0) {
  die "\ncreate_run: Aborts due to errors!.\n";
};


# Check value for "months" in base file's "monthly" section ...

if ( $flag>0 ) {
  if(@offends=grep(!/\bmonths="*$months"[^0-9]*/,grep(/^[^#]*?[ ]*months=.*/g,split("\n",$base)))) {
      $Lmismtch=0;
      for $offend (@offends) {
           $Cmonths=$offend;
           ($key,$value) = split('=', $Cmonths , 2) ;
           if( $months != $value ) {
            $Lmismtch++ ;
           };
      };
      if ($Lmismtch>0) {
       print "\nvalue(s) for months in base file monthly section:\n\n";
       for $offend (@offends) {
            print "$offend\n";
            $Nmismtch++ ;
       };
#      die "value(s) for months in base file not matching months provided.";
       print "\nnot matching expected months=$months value!.\n\n";
      };
  };
};

#!! #  ... and in the other "base" file's sections as well.
#!! for $Var (@prfx) {
#!!   $Xvar=${"${Var}flag"};
#!! # print "\$Var=$Var, \$Xvar=$Xvar\n";
#!! # if ($Xvar==2) {
#!! #  $Xbase=${"${Var}base"};
#!! #  print "\$Xbase=$Xbase\n";
#!! # };
#!!   if ($Xvar>0 ) {
#!! #   print "\$Var=$Var, \$Xvar=$Xvar > 0 \n";
#!! #   if(@offends=grep(!/\bmonths="*$months"*/,grep(/.*\bmonths=.*?;.*/g,split("\n",${"${Var}base"}))))
#!!     if(@offends=grep(!/\bmonths="*$months"*/,grep(/^[^#]*?[ ]*months=.*/g,split("\n",${"${Var}base"}))))
#!! {
#!!         print "\nvalue(s) for months in ${Var}base file:\n\n";
#!!         for $offend (@offends) {
#!!             print "$offend\n";
#!!             $Nmismtch++ ;
#!!         };
#!! #       die "value(s) for months in ${Var}base file not matching months provided.";
#!!         print "\nnot matching months provided!.\n\n";
#!!     };
#!!   };
#!! };

# Abort if any "months" mismatch was found...

if ($Nmismtch>0) {
  die "\ncreate_run: Aborts due to errors!.\n";
};

# Extract value of "months"; abort if missing or misdefined.

if ( $months > 1 ) { 
  if (@Lmonths=grep(/^[^#]*?[ ]*months=.*/g,split("\n",$base))) {
   for $Lmonths (@Lmonths) {
       $Xmonths=$Lmonths ;
     ( $months ) = ( $Lmonths =~ /.*[ ]*months=(\d*).*/ ) ;
   };
  };
#               print " After for: Xmonths=$Xmonths, months=$months \n";
  
  if ( ! $months || ! $Xmonths ) {
      die " months variable is missing or misdefined in the monthly section. " ;
  };

}


# Extract value of "delt"; abort if missing or misdefined.

if (@Ldelt=grep(/^[^#]* *delt=["']{1}\s*\d*\.?[\d\s]*["']{1}.*[;\n]/g,split("\n",$base))) {
 for $Ldelt (@Ldelt) {
   ( $delt ) = ( $Ldelt =~ /^[^#]* *delt=["']{1}(\s*\d*\.?[\d\s]*)["']{1}.*[;\n]/ ) ;
 };
};

if ( ! $delt ) {
    die " delt variable is missing or misdefined. " ;
}
 
if ($yflag!=$hldyflag) {
 print "\n Note: 'yearly section' processing is disabled since 'months' \n";
 print "       value is not one of: [1,2,3,4,6,12].\n";
};

# Proceed with producing the job string.

if ( $initsp =~ 'on' ) {
 print "\n Since \"initsp=$initsp\" is specified, some first month's settings may defer.\n";
};

$stepspd= 86400 / $delt ;

print "\n Based on delt=\"$delt\", the number of timesteps per day=$stepspd.\n";

# Generate the job string ...

$ayear_rs=sprintf "%03d", $ayear-1;
$year1=$year;
$years=($years)? $year1+$years-1: $year1+9;
# $months=($months)? $months: 1;
# $monthw=1;
$monthw=($monthw)? $monthw: 1;
$yearw=$year1;
$year1=sprintf "%03d", $year1;
$years=sprintf "%03d", $years;
$monthw=sprintf "%02d", $monthw;
$yearw=sprintf "%03d", $yearw;
open(SCRIPT,">${runid}_${year1}_${years}")||die "cannot open output file ${runid}_${year1}_${years}";

    # $kfinal=($year1-1)*365*$stepspd;
    $kfinal=($year1 - $ayear )*365*$stepspd;
for ($year=$year1; $year<=$years; $year++) {
    $year=sprintf "%03d", $year;       # pad leading spaces.
    $month=0;
    for $days (@days) {

#       $kfinal+=$days*$stepspd;
        $kfinal= $kfinal + $days*$stepspd;
        $month++;
        $mon_rs=($month>1)? $month-1 : 12;  #if month>1, mon_rs=month-1, otherwise =12
        $year_rs=($month>1)? $year:$year-1; #if month==1, year_rs=year-1
# pad leading spaces.
        $kfinal=sprintf "%10d",$kfinal;
        $mon_rs=sprintf "%02d", $mon_rs;
        $month=sprintf "%02d", $month;
        $year_rs=sprintf "%03d", $year_rs;


# Substitute proper values and output the script for the month of the year 
# if current month/year value equal to "monthw/yearw".

     if ($month==$monthw && $year==$yearw ) {

# Look for line containing kfinal and replace with appropriate value.

        $base=~s/\n(.*)\bkfinal=[^;]*;(.*)/\n${1}kfinal="${kfinal}";${2}/mg;

# Look for lines containing year; replace with appropriate value.

        $base=~s/\n(.*)\byear=[^;]*;(.*)/\n${1}year="${year}";${2}/g;

# Look for lines containing mon; replace with appropriate value.

        $base=~s/\n(.*)\bmon=[^;]*;(.*)/\n${1}mon="${month}";${2}/g;

# Look for lines containing days; replace with appropriate value.

        $base=~s/\n(.*)\bdays=[^;]*;(.*)/\n${1}days="$mname[$month-1]";${2}/g;

# Look for lines containing obsday; replace with appropriate value.

        $base=~s/\n(.*)\bobsday=[^;]*;(.*)/\n${1}obsday="$mname[$month-1]";${2}/g;

      # if ( $initsp =~ 'on' && $year_rs == 000 && $mon_rs == 12 ) {
        if ( $initsp =~ 'on' && $year_rs == $ayear_rs && $mon_rs == 12 ) {

# If it's the first month's job for January of the first year and "initsp=on", then
# use:
#      "$year"  for the "start" year  instead of "$year_rs", 
#      "$month" for the "start" month instead of "$mon_rs" ,
#      change "samerun=on" to "samerun=off";
#      change "initsp=off" to "initsp=on".

          $base=~s/\n(.*)\byear_restart=[^;]*;(.*)/\n${1}year_restart="${year}";${2}/g;
          $base=~s/\n(.*)\bmon_restart=[^;]*;(.*)/\n${1}mon_restart="${month}";${2}/g;
          $base=~s/\n(.*)\bsamerun=on(.*)/\n${1}samerun=off${2}/g;
          $base=~s/\n(.*)\binitsp=off(.*)/\n${1}initsp=on${2}/g;
         
        }

        else 

        {

# Look for lines containing year_restart; replace with appropriate value.

        $base=~s/\n(.*)\byear_restart=[^;]*;(.*)/\n${1}year_restart="${year_rs}";${2}/g;

# Look for lines containing mon_restart; replace with appropriate value.

        $base=~s/\n(.*)\bmon_restart=[^;]*;(.*)/\n${1}mon_restart="${mon_rs}";${2}/g;

        }; 

        print SCRIPT $base;

# If applicable, reverse back "samerun"/"initsp" changes.

      # if ( $initsp =~ 'on' && $year_rs == 000 && $mon_rs == 12 ) {
        if ( $initsp =~ 'on' && $year_rs == $ayear_rs && $mon_rs == 12 ) {

          $base=~s/\n(.*)\bsamerun=off(.*)/\n${1}samerun=on${2}/g;
          $base=~s/\n(.*)\binitsp=on(.*)/\n${1}initsp=off${2}/g;
          $initsp='off';
        };

# Adjust "monthw/yearw" values for the next month to be output.

        $monthw=$monthw + $months ;
        while ( $monthw>12 ) {
         $monthw= $monthw-12 ;
         $yearw= $yearw+1 ;
        };
        $yearw=sprintf "%03d", $yearw;
        $monthw=sprintf "%02d", $monthw;
     };

   };

# ... end of year ...

  if ( $yflag>0 ) {

   $ybase=~s/\n(.*)\byear=[^;]*;(.*)/\n${1}year="${year}";${2}/mg;
   print SCRIPT $ybase;

  };

};


# ... special part ...

# the following job(s) (if were present after "MARKER:  SPECIAL SECTION" line)
# will be executed only once at the end of the job string produced. For
# these jobs, the 'year=' assignment will be replaced by year= "the value
# of the last year" in the set.

if ( $sflag>0 ) {
 $sbase=~s/\n(.*)\byear=[^;]*;(.*)/\n${1}year="${years}";${2}/mg;
 print SCRIPT $sbase;
}
close SCRIPT;

{
print STDERR <<end_of_message1

 The output is saved in:   ${runid}_${year1}_${years}

end_of_message1
}

if ( $runtbl>0 ) {

print STDERR <<end_of_message2

 To copy to the end of the current job string, type:

    stokestr ${runid}_${year1}_${years}

end_of_message2
}
