#!/usr/local/bin/perl
# $Id $
# Author Tomasz Haupt  (haupt@npac.syr.edu) 1996
#===========================================================================

sub build_symtable {

    local $line="";
    local @w=();
    local $tmp;

    %symtable=();
    open(INFH,$infileC) || die "cannot open $infileC: $|"; 
    
LINE:  while ($line = <INFH>) {
    last LINE if $line =~ /end of the list/;
    @w=split(" ",$line);
    $symtable{$w[1]}=$w[2];
    if($w[3]) {
	$tmp=$w[2]."-1";
        $symtable{$w[3]}=$tmp;
    }
    if($w[4]) {
	$tmp=$w[2]."+1";
        $symtable{$w[4]}=$tmp;
    }

     }    
       
# in addition define the following:

    $symtable{"maskold"}="mask-1";
    $symtable{"mask_old"}="mask-1";
    $symtable{"mask"}="mask";
    $symtable{"m"}   ="mask";
    $symtable{"d"}   ="mask";
    $symtable{"nl"}  ="mask";
    $symtable{"h"}   ="double";
    $symtable{"dt"}  ="double";
    $symtable{"init1"} = "int";
#    $symtable{"params"} = "double";

#    $symtable{"shift_p1"} ="SArray";
#    $symtable{"shift_p2"} ="SArray";
#    $symtable{"shift_p3"} ="SArray";
#    $symtable{"shift_b"} ="SArray";
#    $symtable{"num_int_points"} = "SArray";

#    $symtable{"shift_p1o"} ="SArray";
#    $symtable{"shift_p2o"} ="SArray";
#    $symtable{"shift_p3o"} ="SArray";
#    $symtable{"shift_bo"} ="SArray";
#    $symtable{"num_int_pointso"} = "SArray";

#    $symtable{"tshift_p1"} = "TArray";
#    $symtable{"tshift_p2"} = "TArray";
#    $symtable{"tshift_p3"} = "TArray";
#    $symtable{"tshift_b"} = "TArray";
#    $symtable{"tshift_t"} = "TArray";
#    $symtable{"np"} = "TArray"; 
    $symtable{"p"} = "double";
    $symtable{"s"} = "double";
    $symtable{"g_error"} = "double";
    $symtable{"k_error"} = "double";
    $symtable{"dtsave"} = "double";
#    $symtable{"ricc"} = "stensor";
#    $symtable{"chr"} = "ctensor";
#    $symtable{"alph"} = "scalar";

    %symtable1=();
    $symtable1{"gm1"} = "stensor";
    $symtable1{"gp1"} = "stensor";
    $symtable1{"km1"} = "stensor";
    $symtable1{"kp1"} = "stensor";
    $symtable1{"beta_old"} = "vector";
    $symtable1{"mask_old"} = "mask";

    $symtable1{"anm"} = "scalar";
    $symtable1{"anp"} = "scalar";
    $symtable1{"bnm"} = "scalar";
    $symtable1{"bnp"} = "scalar";
    $symtable1{"cnm"} = "scalar";
    $symtable1{"cnp"} = "scalar";
    $symtable1{"dnm"} = "scalar";
    $symtable1{"dnp"} = "scalar";
    $symtable1{"phim"} = "scalar";
    $symtable1{"phip"} = "scalar";
}

#------------------------- BUILD GF TABLE ---------------------
#
sub build_gf_table {

%gf_table = (
  'alpha', 'scalar',
  'mask', 'mask',
  'mask_old','mask-1',
  'maskold','mask-1',
  'hc','scalar',
  'hc_%d','double',
  'interpolator_shift','scalar',
  'interpolator_shift_old','scalar',
  'beta','vector',
  'betal','vector',
  'beta_old','vector-1',
  'tempv','vector',
  'kc','vector',
  'old_shifted_coordinates','vector',
  'current_shifted_coordinates','vector',

  'anm','scalar-1',
  'anp','scalar+1',
 
  'g', 'stensor',
  'gm1','stensor-1',
  'gp1','stensor+1',
  'k','stensor',
  'km1','stensor-1',
  'kp1','stensor+1',
  'gup','stensor',
  'r','stensor',
  'tempt','stensor',
  'old_temp','stensor',
  'dot_temp','stensor',
  'b0','tensor',
  'b1','tensor',
  'c','ctensor',
  'ca','ctensor',
  'riemann','rtensor',
  'mask_%d','double',
  'mask_old_%d','double-1',
  'alpha_%d','double',
  'interpolator_shift_%d','double',
  'interpolator_shift_old_%d','double',
  'shift_p1','SArray',
  'shift_p2','SArray',
  'shift_p3','SArray',
  'shift_b','SArray',
  'num_int_points','SArray',
  'shift_p1o','SArray',
  'shift_p2o','SArray',
  'shift_p3o','SArray',
  'shift_bo','SArray',
  'num_int_pointso','SArray',
  'tshift_p1','TArray',
  'tshift_p2','TArray',
  'tshift_p3','TArray',
  'tshift_b','TArray',
  'tshift_t','TArray',
  'np','TArray',
  'chr0','scalar',
  'chr1','scalar',
  'chr2','scalar',
  'chr3','scalar',
  'chr4','scalar',
  'hc','scalar'
   );

%gf_translate = (

  'alpha','alpha',
  'mask','mask',
  'mask_old','mask',
  'maskold','mask',
  'hc','tmp4',
  'hc_%d','tmp4',
  'beta','beta',
  'beta_old','beta',
  'betal','tmp1+tmp2+tmp3',
  'tempv','tmp1+tmp2+tmp3',
  'kc','c[0]+c[1]+c[2]',
  'g','g',
  'k','k',
  'gm1','g',
  'gp1','g',
  'km1','k',
  'kp1','k',

  'anm','an',
  'anp','an', 
  'bnm','bn',
  'bnp','bn', 
  'cnm','cn',
  'cnp','cn', 
  'dnm','dn',
  'dnp','dn', 
  'phim','phi',
  'phip','phi', 


  'gup','gup',
  'r','r',
  'tempt','tempt',
  'riemann','tempt',
  'c','c',
  'ca','ca',
  'b0','c[0]+c[1]+c[2]+c[3]+c[4]+c[5]+c[6]+c[7]+c[8]',
  'b1','c[9]+c[10]+c[11]+c[12]+c[13]+c[14]+c[15]+c[16]+c[17]',
  'old_temp','ca[6]+ca[7]+ca[8]+ca[9]+ca[10]+ca[11]',
  'dot_temp','ca[12]+ca[13]+ca[14]+ca[15]+ca[16]+ca[17]',
  'old_shifted_coordinates','gup[0]+gup[1]+gup[2]',
  'current_shifted_coordinates','gup[3]+gup[4]+gup[5]',
  'interpolator_shift','c[0]',
  'interpolator_shift_old','c[1]',
  'interpolator_shift_%d','c[0]',
  'interpolator_shift_old_%d','c[1]',
  'mask_%d','mask',
  'mask_old_%d','mask',
  'alpha_%d','alph',
  'shift_p1','shift_p1',
  'shift_p2','shift_p2',
  'shift_p3','shift_p3',
  'shift_p1o','shift_p1o',
  'shift_p2o','shift_p2o',
  'shift_p3o','shift_p3o',
  'shift_b','shift_b',
  'shift_bo','shift_bo',
  'num_int_points','num_int_points',
  'num_int_pointso','num_int_pointso',
  'tshift_p1','tshift_p1',
  'tshift_p2','tshift_p2',
  'tshift_p3','tshift_p3',
  'tshift_b','tshift_b',
  'tshift_t','tshift_t',
  'np','np',
  'chr0','c[0]',
  'chr1','c[1]',
  'chr2','c[2]',
  'chr3','c[3]',
  'chr4','c[4]'
  );

%components = (
  'alph',     'alph',
  'beta',     'beta',
  'tempt',    'tempt',
  'g',        'g',   
  'k',        'k',
  'gup',      'gup',
  'chr',      'c',
  'chra',     'ca',
  'ricc',     'r',
  'gm1',      'g',
  'km1',      'k',
  'beta_old', 'beta',
  'maskold',  'maskold' 
);

%stensor_t = (
   1,0,
   2,1,
   3,2,
   4,3,
   6,4,
   9,5
	      );
 
}  

#
#local $line="";
#local $cont=0;
#
#open(FTN,"tstep.f90");
#    while (<FTN>) {
#	$line=$_;
#
## do not forget about blank lines and leading &
# continuation lines?
#
#     if($cont==1) {
#       $line=$pline.$line;
#     }   
#
#     if($line =~ /$amp/) {
#        $cont=1;
#        $pline=$line;
#        while($pline =~ /$amp/) {chop($pline)};
#     }
#     else {
#        $cont=0;
#        $pline="";
#     }  
#
#     if($cont==0) {
#        if($line =~ /GridFunction/){
#	    print "$line \n";
#        } # $line =~ /type(GridFunction)/
#     
#     } # cont==0      
#
#    } # while (<FTN>)
#    close(FTN);
##die "stop here";
#}

#------------------------- SMALL UTILITIES --------------------

sub streap_leading_apersand{
  local ($line)=@_;
  local @aw=split("",$line);
  local $first=" ";
#  print "start stripping ampersand\n";
  while($first eq " "){
      $first=shift(@aw);
  }
#  print "first first $first \n";
  if($first eq $amp) {
  return $newline=join("",@aw);
  }
  else {  
  return $line;
  }
}

sub first_non_blank_char { 
  local ($line)=@_;
  $first=" ";
  local @aw=split("",$line);
  while($first eq " ") {
    $first=shift(@aw);
  }
  return $first;
}

#-------------------------- CONVERT ARGUMENTS ------------------------
sub convert_arguments {
    local ($line) = @_;

    $admcall = "!DAGH"."\$"." ADMCALL ";
#-------------------------------------------
# parse arguments
#-------------------------------------------
     local @ar1=split("",$line);

#get rid off leading blanks
     local $test=" ";
     while($test eq " ") { $test=shift(@ar1); };

#now get rid of all blanks
    $line =~ s/\s//g;

#extract function name
    $line =~ tr/[A-Z]/[a-z]/;
    $line =~ /call([a-z_0-9]+)\((.*)/; 
    $fname=$1;

    $fname || die "error 29 failed to recognize function name in $line\n";

    $admcall = $admcall.$fname."(      &\n  ";

#finally, parse arguments
#be careful about tempv(1,1)_%d -> double:tempv[0]
#be careful about int(params(50)) -> integer:params50

    $line=$2;

#get rid if ")" and trailing comments

  if($line =~ /!/) { 
    $line =~ /\)\s*!(.*)/;
    $repl3=$1;
    $line =~ s/!$repl3//;
    $line =~ s/\s//;
  }
    chop $line;

#before matching ( ) pair get rid of (())

while($line =~ /params\(([0-9]+)\)/) {
   $repl=$1;
   $repl1=$1-1;
   $repl1="params".$repl1;
   $line =~ s/params\($repl\)/$repl1/; #so now int(params(50)) -> int(params49)
} 

#replace (i,k) by (i;k) - later we will split using "," 
#    print "$line\n";
#   if($line =~ /\(/) {
    while($line =~ /\([a-z0-9]+,/) {
       $line =~ /.*\((.*)\).*/;
       $repl1=$1;
       $repl2=$1;
       $repl2 =~ s/,/;/g;
       $line =~ s/$repl1/$repl2/;
    }

    @ar1=split(/,/,$line); 

    foreach $i (@ar1) {

     $i =~ tr/A-Z/a-z/;

#    trailing "_" ?
      if(!($i =~ /_$/)) {
          $ii=$i;

          if($ii =~ /.*\[%[a-z]+\].*/) {
             #allows for g_[%i]%d
	     $admcall=$admcall."double:".$ii.",";
	  }
          elsif($ii =~ /_%d/) {
            $ii =~ /(.*)_%d/;
            if($symtable{$1}) {
              $admcall=$admcall."double:".$i.",";
	    }
            elsif($gf_table{$1}){
              $admcall=$admcall."double:".$i;
              $admcall=$admcall."{".$gf_table{$i}.":".$gf_translate{$i}."},";
            }
            else {
              die "error 15: $ii has invalid type\n"
            }
          } 
          elsif($ii =~ /%d/) {
              if($ii =~ /\(/) {
		  # "syntax gf_()%d is used\n";
		  $ii =~ /(.*)_\((.*)\)%d/;
                  if($symtable{$1}) { 
                     $admcall=$admcall."double:".$1;
		  }
                  elsif ($gf_translate{$1}) {
                     $admcall=$admcall."double:".$i."{scalar-1:";
                     $admcall=$admcall.$gf_translate{$1}; 
                     die "error 502: not yet implemented: ask Tom";
                  }
                  else {
		      die "error 18: unknow type of $ii\n";
		  }
                  if($symtable{$1} eq "stensor") {
                      @ar2=split(";",$2);
                      $dummy=$ar2[0]*$ar2[1];
                      $idx=$stensor_t{$dummy};
                      $admcall=$admcall."[".$idx."],";
                  }
                  else {
                      die "error 19: type $symtable{$1} not implemented\n";
                  }
              }
	  }
          else {

              $ii=$i;

              if($symtable{$ii}) {

                  $admcall=$admcall.$symtable{$ii}.":".$ii.","; 
              }
              elsif($ii =~ /params([0-9]+)/){

		  $idx=$1;
                  if($ii =~ /int/) {
                   $admcall=$admcall."int:params".$idx.",";
                  }
                  else {
                   $admcall=$admcall."double:params".$idx.",";
	          }
	      }
              elsif($ii =~ /[0-9]+/) {

                  if($ii =~ /gm1|km1/) {
                      $ii =~ /([a-z0-9]+)([0-9]$)/;
		      $a1=$gf_translate{$1};
		      $a2=$2;
		      $stype = "double-1";
		      }
                  elsif($ii =~ /gp1|kp1/) {
                      $ii =~ /([a-z0-9]+)([0-9]$)/;
		      $a1=$gf_translate{$1};
		      $a2=$2;
		      $stype = "double+1";
		      }
		  else {
		      $ii =~ /([a-z]*)([0-9]+)*/;
		      $a1=$1;
		      $a2=$2;
                      $stype = "double";
		  }
                  if($symtable{$a1}) {
		      $admcall=$admcall.$stype.":".$a1."[".$a2."],";
		  }
                  elsif($components{$a1}) {
		      $admcall=$admcall.$stype.":".$components{$a1}."[".$a2."],";
		  }
                  else {
		      die "error 17: unknown type of $a1 ($ii) \n";
		  }
              }
              else { 
                  die "error 16: don't know what to do with $ii \n";
              }
	  }
      }
      else {
 
        $i =~ s/_$//;


        if($symtable{$i}) {

#            watch for type +/-1!
            if($symtable{$i} =~ /[\+\-]1/) {
		if($symtable{$i} =~ /\+/) {
                  $admcall=$admcall.$symtable1{$i}.":".$i."{";
                  $admcall=$admcall.$symtable1{$i}."+1:".$gf_translate{$i}."},";
                 }
                 else {
                  $admcall=$admcall.$symtable1{$i}.":".$i."{";
                  $admcall=$admcall.$symtable1{$i}."-1:".$gf_translate{$i}."},";
                 }  
             }  
            else {
            $admcall=$admcall.$symtable{$i}.":".$i.",";
            } 
	}

        elsif($gf_table{$i}){

            $admcall=$admcall.$gf_table{$i}.":".$i."{";

            $sub_var=$gf_translate{$i};
	    if($sub_var =~ /\+/ || $sub_var =~ /\[/) {
		$sub_type="scalar";
            } 
	    else {
               $sub_type=$symtable{$sub_var} || die "error 10: 
                      type unknown for sub_var $sub_var ($i) \n";
	    }

	    $admcall=$admcall.$sub_type.":".$gf_translate{$i}."},";    
            } 
        else {
              die " error 11: type unknown for $i \n";
	}
      } # if trailing _
    } # foreach (@ar1)

# format ADMcall
chop $admcall;
$admcall=$admcall.")";

local $alist="";
local $l=length($admcall);
local $comma=0;

if($l>51) {
 local $newlist="";
 local @aw=split(//,$admcall);
 for($i=0;$i<$l;$i++) {
  $newlist=$newlist.$aw[$i];
  if($i>0 && $i%50 == 0) {
     $comma=1;
  }
  if(($comma==1) && ($aw[$i] eq ",")) {
       $newlist=$newlist." &\n  ";
       $comma=0;
  }
 }
$admcall=$newlist;
} 

print OUTFH "$admcall\n\n";
print "$admcall\n";

}

#-------------------------- PROCESS DAGH DIRECTIVES ----------------------
sub dagh_directive {
    local ($line,$keyword) = @_;

    $syncall = "!DAGH"."\$"." ".$keyword."(";
#-------------------------------------------
# parse arguments
#-------------------------------------------

    print "$line\n";
    $line =~ /!DAGH\$\s*$keyword\((.*)\)/;

    local @ar1=split(/,/,$1);

    for($i=0; $i<$#ar1+1; $i++) { 

    if($ar1[$i] =~ /#/) {
       $ar1[$i] =~ /#(.+)/;
       $syncall=$syncall."double:".$1.",";
    }
    else {

       $ar1[$i] =~ tr/A-Z/a-z/;

       local $dummy = $ar1[$i];
       $dummy =~ s/_$//;

#       if(($symtable{$dummy}) && $dummy ne ("beta")) {
       if($symtable{$dummy}) {
           if($symtable{$dummy} =~ /\+1/) {
                  $syncall=$syncall.$symtable1{$dummy}."+1:"; 
                  $syncall=$syncall.$gf_translate{$dummy}.",";
	   }
           elsif($symtable{$dummy} =~ /-1/) {
                  $syncall=$syncall.$symtable1{$dummy}."-1:"; 
                  $syncall=$syncall.$gf_translate{$dummy}.",";
	   }
	   else {
               $syncall=$syncall.$symtable{$dummy}.":".$dummy.",";
           }
       }
#      elsif(($ar1[$i] =~ /_$/) && ($gf_translate{$dummy})) {
#          # gm1_ or km1_
#	  $syncall=$syncall.$gf_table{$dummy}.":".$dummy."{";
#          $dummy1=$gf_translate{$dummy}; 
#          $syncall=$syncall.$symtable{$dummy1}.":".$dummy1."},";
#	  $syncall=$syncall.$gf_table{$dummy}.":".$gf_translate{$dummy}.","; 
#      }

       else {

              # may be a reference to a single component of a tensor or %d
              if($dummy =~ /\[/){
                   die " gf[] syntax used: $dummy\n";
              }
              elsif($dummy =~ /\(/) {
                   die "gf() syntax used: $dummy\n";
              }
	      elsif($dummy =~ /%d/){
		  $dummy =~ s/_%d//;
                  if($symtable{$dummy}) {
                      $syncall=$syncall.$symtable{$dummy}.":".$dummy.",";
		  }
                  else {
                      $syncall=$syncall.$gf_table{$dummy}.":".$gf_translate{$dummy}.","; 
		  }
	      }
              else {
              # last chance: gfN syntax used
              # NOTE:
              # tempv corresponds to tempv[0]; do not confuse with tempv_ 
              # chr2 corresponds to c[2] --- a very nasty thing!
                 local $dummy1=$dummy;
                 $dummy1 =~ tr/[A-Z]/[a-z]/;
                 $dummy1 =~ /([a-z_]*)([0-9]*)/;
                 local $gf=$1;
                 local $nc=$2; 
                 if(!$nc) {
		     $nc="0";
		 }
		 if($components{$gf}) {
                     if($dummy=~/old/){
			 $dummy2="scalar-1";
		     }
		     else {
			 $dummy2="scalar";
		     }
                     print "$dummy,$gf,$nc,$components{$gf}\n";
                     $syncall=$syncall.$dummy2.":".$components{$gf}."[".$nc."],";
	         }
                 else {
         	   die "error 13: unknown type of $ar1[$i]\n";
	         }
               #  if($dummy=~/beta_old/) {die "here $gf,$nc \n";}
              }
	  }
    }
    }

# format ADMcall
chop $syncall;
$syncall=$syncall.")";

local $alist="";
local $l=length($syncall);
local $comma=0;

if($l>51) {
 local $newlist="";
 local @aw=split(//,$syncall);
 for($i=0;$i<$l;$i++) {
  $newlist=$newlist.$aw[$i];
  if($i>0 && $i%50 == 0) {
     $comma=1;
  }
  if(($comma==1) && ($aw[$i] eq ",")) {
       $newlist=$newlist." &\n  ";
       $comma=0;
  }
 }
$syncall=$newlist;
} 

print OUTFH "$syncall\n\n";
print "$syncall\n";

}

# --------------------------- BODY OF TSTEP --------------------------------
sub body_of_tstep {


local $cont=0;
local $pline="";
local $sline="";

    while (<FTN>) {

     $sline=$_; 

     if($sline =~ /\S/) {

     $comment=&first_non_blank_char($sline);
     if($comment ne "!" || $sline =~ /!DAGH\$/) {

     $sline=&streap_leading_apersand($sline);

# continuation lines?

     if($cont==1) {
       $sline=$pline.$sline;
     }   

     if($sline =~ /$amp/) {
#	 print "$sline\n";
        $cont=1;
        $pline=$sline;
        while($pline =~ /$amp/) {chop($pline)};
     }
     else {
        $cont=0;
        $pline="";
     }  

     if($cont==0) {


# find call statements

         print "$sline\n";
         if($sline =~ /call tstep/) {
	     open(TMPH,"tstepcall") || die "cannot open tstepcall: $! \n";
             while(<TMPH>) {
              print OUTFH $_;
             }
             close TMPH;
         }  
	 elsif($sline =~ /call/) {
             &convert_arguments($sline);
         }
         elsif($sline =~ /\s*if\s*\((.*)\)\s*then/) {
             &if_statement($1);
	 }
         elsif($sline =~ /\s*end\s*if/) {
             print OUTFH "} //endif \n\n";
	 }
         elsif($sline =~ /\s*else\s+/) {
             print OUTFH "} //endif \n\n else { \n\n";
	 }
         elsif($sline =~ /\s*write\(6,\*\)(.*)/) {
             write_statement($1);
         }
#	 elsif($sline =~ /\s*end\s*do/) {
#             print OUTFH "} //end for \n\n";
#	 }
#         elsif($sline =~ /\sdo\s(.*)/) {
#             &do_statement($1);
#	 }
         elsif($sline =~ /stop/) {
             print OUTFH "  exit(1); \n";
         }
         elsif($sline =~ /select case \((.+)\)/) {
             $selstr = $1;
             if($selstr =~ /^int\((.+)\)/ ){
		 $selstr = "(int)".$1;
	     }
             if($selstr =~ /(.+)params\((.+)\)/ ) {
	         $selstr = $1."params[".$2."]";
	     }
             $selstr = "switch (".$selstr.") {";
             print OUTFH "$selstr \n";
	 }
         elsif($sline =~ /case\((.+)\)/) {
	     $casestr= "case ".$squote.$1.$squote.":\n";
             print OUTFH"   $casestr \n";
	 }
	 elsif($sline =~ /end select/) {
             print OUTFH "} // switch\n\n";
         }

	 elsif ($sline =~ /!DAGH\$/) {
            if($sline =~ /sync/){
                 &dagh_directive($sline,"sync");
            }
            elsif($sline =~ /maxval/){
                 &dagh_directive($sline,"maxval");
            }
            elsif($sline =~ /minval/){
                 &dagh_directive($sline,"minval");
            }
            elsif($sline =~ /sum/){
                 &dagh_directive($sline,"sum");
            }
            elsif($sline =~ /copy/){
                 &dagh_directive($sline,"copy");
            }
            elsif($sline =~ /swap/){
                 &dagh_directive($sline,"swap");
            }
            elsif($sline =~ /add/){
                 &dagh_directive($sline,"add");
            }
            elsif($sline =~ /subtract/){
                 &dagh_directive($sline,"subtract");
            }
            elsif($sline =~ /multiply/){
                 &dagh_directive($sline,"multiply");
            }
            elsif($sline =~ /equals/){
                 &dagh_directive($sline,"equals");
            }
            elsif($sline =~ /user/){
                chop $sline;
                $sline =~ s/!DAGH\$ user\(//;
                $sline =~ s/\)$//;
		print OUTFH "$sline \n\n";
            }
            else {     
             die "error 503: invalid directive $sline\n";
	    }
         }
         elsif(!($sline =~ /=>/ || $sline =~ /::/ || $sline =~ /use /)) {

#	     print OUTFH "// WARNING: ignored line:\n";

$sline="// ".$sline; 
# format argument (sline) list
local $l=length($sline);
local $comma=0;

if($l>51) {
 local $newlist="";
 local @aw=split(//,$sline);
 for($i=0;$i<$l;$i++) {
  $newlist=$newlist.$aw[$i];
  if($i>0 && $i%50 == 0) {
     $comma=1;
  }
  if(($comma==1) && ($aw[$i] eq " ")) {
       $newlist=$newlist." \n"."// ";
       $comma=0;
  }
 }
$sline=$newlist;
} 

	     print OUTFH "$sline";
         }
     }


 } #if $comment="!"
 } #if $sline =~ /\S/
 } #while <FTN>

}  #body_of_tstep 


# ------------------------------------- IF STATEMENT -----
sub if_statement {
    local ($cond) = @_;

    $cond =~ s/\.eq\./ == /g; 
    $cond =~ s/\.ne\./ != /g; 
    $cond =~ s/\.gt\./ > /g; 
    $cond =~ s/\.lt\./ < /g; 
    $cond =~ s/\.ge\./ >= /g; 
    $cond =~ s/\.le\./ <= /g;
    $cond =~ s/\.not\./!/g;
    $cond =~ s/\.and\./ && /g; 
    $cond =~ s/\.or\./ || /g; 
    $cond =~ s/d0//g;
    $cond =~ s/int\(/\(int\)\(/g;

    if($cond =~ /!\s*init/) {
        $cond =~ s/!\s*init/init==0/; 
    }
    elsif ($cond =~ /init/) {
        $cond =~ s/init/init==1/;
    }

    while($cond =~ /(.*)params\(([A-Z_0-9]+)\)(.*)/){
        $beg=$1; 
        $rest=$3;
        $repl=$2;
        if($repl =~ /[A-Z]+/) { 
            $repl="params[".$repl."]".$rest;
	}
        else {
            $repl=$2-1;
            $repl="params[".$repl."]".$rest;
        } 
        $cond=$beg.$repl;
    }
    
    while($cond =~ /int\(params\[([0-9]+)\]\)/) {
        $repl=$1;
        $cond =~ s/int\(params\[[0-9]+\]\)/\(int\) params\[$repl\]/;
    }
    print OUTFH "if($cond) { \n\n";

}

# ------------------------------ DO STATEMENT --------
sub do_statement {
    local ($line)=@_;
    $line =~ s/\s//g;
    $line =~ /(\w+)\W([0-9]+),([0-9]+)/;
    $loop=$1;
    $lb=$2;
    $ub=$3+1;
    print OUTFH "for($loop=$lb; $loop<$ub; $loop++) { \n";   
} 
# ------------------------------ WRITE STATEMENT --------
sub write_statement {
    local ($line)=@_;
    local @warg=();

#replace params(whatever) by params[whatever]

    while($line =~ /(.*)params\(([A-Z_0-9]+)\)(.*)/){
        $beg=$1; 
        $rest=$3;
        $repl=$2;
        $repl="params[".$repl."]".$rest;
        $line=$beg.$repl;
    }


# find array references
    while ($line =~ /[a-z0-9_]\(([0-9,]+)\).*/) {
    if($1) {
      $repl=$1;
      if(!($repl =~ /,/)) {
	  $repl1=$repl-1;
      }
      else {
	  die "error 201: cannot process it yet: $repl\n";
      }
      $line =~ s/\($repl\)/\[$repl1\]/;
    }
  }	
    $line =~ s/d0//g;
    $line =~ s/'/"/g;
    $space = '" "';    

    @warg=split(",",$line);
    print OUTFH "if(myrank==0) cout";
    for ($i=0;$i<$#warg+1;$i++) {
      $dummy=$warg[$i];
      print OUTFH "<< $dummy << $space \n"; 
    }
print OUTFH "<< endl;\n";
}

# ------- main routine starts here -----------------------
# ------- process input arguments ------------------------


if($#ARGV != 2) {
  print "\nUsage: ftoir fn.C fn.f90 fn.ir\n\n";
  print "where:\n";
  print "      fn.C   - init.C or tstep.C generated by stub.pl\n";
  print "      fn.f90 - fortran routine to be translated to IR\n";
  print "      fn.ir  - output file\n\n";
  print "EXAMPLE: ftoir tstep.C tstep.f90 tstep.ir\n\n";
  exit ;
}

$infileC = $ARGV[0];
$infileF = $ARGV[1];
$outfile = $ARGV[2];

$outname=">".$outfile;

print "converting $infileF to $outfile using $infileC as a template\n";

# ----------- constants ------------------------------

$quote = '"';
$squote = "'";
$amp = "&";
@VALID_TYPES = ("int","double","scalar","vector", "tensor","stensor",
                "ctensor","rtensor","mask","SArray","TArray", "vector-1",
                "stensor-1","stensor+1","mask-1","scalar+1","scalar-1");


# symbol table for the stub
# at this time just analyze stub.C :: later it will analyze fortran input
# now analysis is restricted to subroutine tstep

&build_symtable();
&build_gf_table;

# copy the stub to output.
# insert body of the tstep routine.

open(INFH,$infileC) || die "cannot opoen $infileC: $!";
open(OUTFH,$outname) || die "cannot open $outfile: $!";

$start=0;
LINE: while ($line=<INFH>) {

  if($line =~ /include/) {
    $start=1;
  } 

  next LINE if $start==0;

  if($line =~ /insert body here/) {
      open(FTN,$infileF) || die "cannot open $infileF: $! \n";
      &body_of_tstep;
      close(FTN)
  }
  else {
      print OUTFH $line;
  }

} # while <INFH>




