#! /usr/bin/perl 
#
#    Jan 04/00 - F.Majaess (Revised to get around "reserved words" 
#                           passed as argument (ie. run=tr)).
#    May 17/99 - F.Majaess (Revamped for installation as a standard script)
#    Jan 08/99 - Scott Tinis
#    Nov 14/97 - Damin Liu
#
#id  create_diag - Used to generate diagnostic string from a base file.
#
#    AUTHOR  -  Damin Liu
#
#hd PURPOSE  - This script generates a diagnostic job string for a specified
#hd            number of years (the default is 1 year) from a base 
#hd            "${runid}_diag" file.
#hd            Note: Sample "base file" can be found in $CCRNINFO subdirectory,
#hd                  such as "$CCRNINFO/sample_gcm6u_diag_for_create_diag" file.
#hd
#
#pr PARAMETERS:
#pr
#pr   PRIMARY/SECONDARY
#pr
#pr     h      = Display help (optional).
#pr     runid  = The model/diagnostic identifier.This parameter is compared
#pr              with those in "${runid}_diag" file as a safety check.
#pr     year   = The starting year.
#pr     years  = number of years for which the string is created.
#pr              (optional; defaults to 1).
#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
#pr NOTE:     This script relies on "#MARKER:..." lines in "{runid}_diag"
#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:.*Annually Section"      "#MARKER:.*End of Annually"
#pr           (inserted before month #1 "monthly" job of each year;
#pr            variables altered: "year").
#pr            
#pr           "#MARKER:.*Seasonal DJF Section"  "#MARKER:.*End of DJF Seasonal"
#pr           (inserted after months 2; variables altered: "year,yearm1")
#pr
#pr           "#MARKER:.*Seasonal MAM Section"  "#MARKER:.*End of MAM Seasonal"
#pr           (inserted after months 5; variables altered: "year")
#pr
#pr           "#MARKER:.*Seasonal JJA Section"  "#MARKER:.*End of JJA Seasonal"
#pr           (inserted after months 8; variables altered: "year")
#pr
#pr           "#MARKER:.*Seasonal SON Section"  "#MARKER:.*End of SON Seasonal"
#pr           (inserted after months 11; variables altered: "year")
#pr
#pr           "#MARKER:.*Quarterly Section"     "#MARKER:.*End of Quarterly"
#pr           (inserted before months 1,4,7 & 10;
#pr            variables altered: "year,mon1,mon2,mon3").
#pr
#pr           "#MARKER:.*Monthly Section"       "#MARKER:.*End of Monthly"
#pr           (main monthly job;
#pr            variables altered: "year,mon,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
#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 USAGE: create_diag [h] runid=xx year=y [years=y] [cwext=_xx] 
#pr               
#ex EXAMPLE:
#ex
#ex   create_diag runid=xx year=3 years=2
#

# 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=('a','djf','mam','jja','son','q','y','s');

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=.*|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;

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

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

# read base file from current directory.
$procid=$$;
$basefile="${runid}_diag";
open(BASE,"<$basefile") || die "cannot open input file $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=^#deck =)    {$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; $aflag=0; $sflag=0; $qflag=0; $yflag=0;
$djfflag=0; $mamflag=0; $jjaflag=0; $sonflag=0; 

open(TEMPLATE,"<${procid}.template") || die "cannot open ${procid}.template";
while (<TEMPLATE>) {
    if (/^#MARKER:.*Annually Section/ .. /^#MARKER:.*End of Annually/) {
     if (!/^#MARKER:.*/) { $abase.=$_; $aflag++; };
    };
    if (/^#MARKER:.*Seasonal DJF Section/ .. /^#MARKER:.*End of DJF Seasonal/) {
     if (!/^#MARKER:.*/) { $djfbase.=$_; $djfflag++; };
    };
    if (/^#MARKER:.*Seasonal MAM Section/ .. /^#MARKER:.*End of MAM Seasonal/) {
     if (!/^#MARKER:.*/) { $mambase.=$_; $mamflag++; };
    };
    if (/^#MARKER:.*Seasonal JJA Section/ .. /^#MARKER:.*End of JJA Seasonal/) {
     if (!/^#MARKER:.*/) { $jjabase.=$_; $jjaflag++; };
    };
    if (/^#MARKER:.*Seasonal SON Section/ .. /^#MARKER:.*End of SON Seasonal/) {
     if (!/^#MARKER:.*/) { $sonbase.=$_; $sonflag++; };
    };
    if (/^#MARKER:.*Quarterly Section/ .. /^#MARKER:.*End of Quarterly/) {
     if (!/^#MARKER:.*/) { $qbase.=$_; $qflag++; };
    };
    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";

# Issue warning if the monthly section is empty...

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

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

$Nmismtch=0;

# First, 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_diag: Aborts due to errors!.\n";
};

# Generate the job string ...

$year1=$year;
$year2=($years)? $year1+$years-1: $year1;
$year1=sprintf "%03d",$year1;
$year2=sprintf "%03d",$year2;

open(SCRIPT,">${runid}_diag${year1}_${year2}") || die "cannot open output file ${runid}_diag${year1}_${year2}";

for ($year=$year1; $year<=$year2; $year++) {
   $year=sprintf "%03d",$year;         # pad leading spaces.
   $month=0;

   for $days (@days) {
       $month++;
       $month=sprintf "%02d", $month;  # pad leading spaces.

# add annual functions to the script ...

       if ( $month == 1 ) {
        if ( $aflag>0 ) {

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

          print SCRIPT $abase;

        };
       };

# ... quarterly ...

       if ( $qflag>0 ) {
        if ( $month == 1 || $month == 4 || $month == 7  || $month == 10 ) {

          $month2=$month+1;
          $month3=$month+2;
          $month1=sprintf "%02d",$month;              #pad leading space
          $month2=sprintf "%02d",$month2;             #pad leading space
          $month3=sprintf "%02d",$month3;             #pad leading space

          $qbase=~s/\n(.*)\byear=[^;]*;(.*)/\n${1}year="${year}";${2}/g;
          $qbase=~s/\n(.*)\bmon1=[^;]*;(.*)/\n${1}mon1="${month1}";${2}/g;
          $qbase=~s/\n(.*)\bmon2=[^;]*;(.*)/\n${1}mon2="${month2}";${2}/g;
          $qbase=~s/\n(.*)\bmon3=[^;]*;(.*)/\n${1}mon3="${month3}";${2}/g;

          print SCRIPT $qbase;

        };
       };

# ... monthly...
# Look for lines containing year, mon and days; replace with appropriate value.

       if ( $flag>0 ) {
       
         $base=~s/\n(.*)\byear=[^;]*;(.*)/\n${1}year="${year}";${2}/g;
         $base=~s/\n(.*)\bmon=[^;]*;(.*)/\n${1}mon="${month}";${2}/g;
         $base=~s/\n(.*)\bdays=[^;]*;(.*)/\n${1}days="$mname[$month-1]";${2}/g;
         $base=~s/\n(.*)\bobsday=[^;]*;(.*)/\n${1}obsday="$mname[$month-1]";${2}/g;

         print SCRIPT $base;

        };
# ... seasonal...
# --- DJF ---

       if ( $djfflag>0 && $month == 2 && $year > 1 ) {

         $yearm1=$year-1;
         $yearm1=sprintf "%03d",$yearm1;

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

         print SCRIPT $djfbase;

        };

# --- MAM ---

       if ( $mamflag>0 && $month == 5 ) {

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

         print SCRIPT $mambase;

        };

# --- JJA ---

       if ( $jjaflag>0 && $month == 8 ) {

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

         print SCRIPT $jjabase;

        };

# --- SON ---

       if ( $sonflag>0 && $month == 11 ) {

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

         print SCRIPT $sonbase;

        };

   };
 
# ... 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="${year2}";${2}/mg;
 print SCRIPT $sbase;
}
close SCRIPT;

# print STDERR "\nThe output is saved as:     ${runid}_diag${year1}_${year2}\n"
print "\nThe output is saved as:     ${runid}_diag${year1}_${year2}\n"