#!/usr/local/bin/perl
#
# This reads the Registry file and generates a number of automatically
# generated files used or included by WRF during compilation.
#
# The following is a list of generated files:
#
#
# 1.  Files that define, declare, or provide index information to
#     fields in the domain data structure
# 
#     module_state_description.F
#     state_struct_items.inc
#     state_defines.inc
#     state_derefs.inc
# 
# 2.  Files that define and specify the actual and dummy arguments 
#     for the interface between the solve subroutine, which takes all
#     state data explicitly through its argument list, and the driver
#     layer, which carries all this data around as a single structure.
# 
#     solve_actual_args.inc
#     solve_dummy_arg_defines.inc
#     solve_dummy_args.inc
# 
# 3.  Files that define data that is (1) local to the top level solver
#     (I1 data) and (2) associated with State variables in the
#     domain structure.
# 
#     decoupled_state.inc
#     tendencies.inc
# 
# 4.  Files that handle configuration of state via the namelist 
# 
#     config_namelist_01.inc 
#     config_namelist_02.inc
#     config_namelist_03.inc
#     config_namelist_04.inc
#     state_namelist_assigns.inc
#     state_namelist_defines.inc
#     state_namelist_reads.inc
#     state_namelist_statements.inc
# 
# 5.  A default (template) namelist file
# 
#     namelist.default
#
# 6.  Package specific actions
#     6a. Files generated if -DRSL argument is specified
#
#        rsl_data_calls.inc
# 
#############################################################################
#
# In the PERL script below, the following may be used as indices into 
# the array of tokens that are created by reading in a line of the 
# Registry file and then 'split'ing it on white space.  The position
# of the item corresponds to the position on the line of the Registry entry.
# (Note that numbering starts with 0.
#
# Record format:
#
# <Table> <Type> <Sym> <Part> <NumTLev> <Stagger> <Decoup>
#

$spc = "`" ;  # character to represent space character in strings

# prepass field specs for state and i1 tables
$pre_table    =0 ;
$pre_type     =1 ;
$pre_sym      =2 ;
$pre_dims     =3 ;
$pre_use      =4 ;
$pre_ntl      =5 ;
$pre_stag     =6 ;
$pre_io       =7 ;
$pre_dname    =8 ;
$pre_desc     =9 ;
$pre_units    =10 ;

# prepass field for rconfig (namelist) table
$pre_howset   =3 ;
$pre_nentries =4 ;
$pre_dflt     =5 ;
$pre_rconfig_io = 6 ;
$pre_rconfig_dname = 7 ;
$pre_rconfig_descr = 8 ;
$pre_rconfig_units = 9 ;

# If Table is 'state' or 'i1'

$table    =0 ;
$type     =1 ;
$sym      =2 ;
$dims     =3 ;
$use      =4 ;
$ntl      =5 ;
$stag     =6 ;
$io       =10 ;  # state only
$dname    =11 ;  # state only
$desc     =12 ;  # state only
$units    =13 ;  # state only
#
$howset   =7 ;
$nentries =8 ;
$dflt     =9 ;

# If Table is 'package'
$package      =1 ;
$assoc        =2 ;
$statevars    =3 ;
$assocscalars    =4 ;

# If Table is 'halo' or 'period'
$comm      =1 ;
$commdef        =2 ;

# 
#############################################################################
#
# This is initialization of a few variables that are used for putting
# more than one entry on a line in several of the output files.
#

$arglens = 0 ;
$darglens = 0 ;
$argspace = 0 ; $nargs = 7 ;
$dargspace = 0 ; $ndargs = 4 ;

# 
#############################################################################
#
# Switches in this script; initialized to default values here, and then
# possibly set by the command line arguments, which must start with '-'.
# All arguments to the script must come before the Registry file name.
#

$sw_deref_kludge = 0 ;
$sw_dm_parallel = 0 ;
$sw_distrib_io_layer = 0 ;
$sw_rsl          = 0 ;
$sw_bogus_tracers = 0 ;
$wrf_root        = "." ;

# Parse command line arguments.  When this loop finishes, the first
# item of @ARGV is the name of the registry file.

while ( substr( $ARGV[0], 0, 1 ) eq "-" )
 {
  if ( substr( $ARGV[0], 1, 13 ) eq "DDEREF_KLUDGE" )
  {
    $sw_deref_kludge = 1 ;
    $argspace = 0 ; $nargs = 5 ;
  }
  if ( substr( $ARGV[0], 1, 4 ) eq "DRSL" )
  {
    $sw_rsl = 1 ;
  }
  if ( substr( $ARGV[0], 1, 12 ) eq "DDM_PARALLEL" )
  {
    $sw_dm_parallel = 1 ;
  }
  if ( substr( $ARGV[0], 1, 16 ) eq "DDISTRIB_IO_LAYER" )
  {
    $sw_distrib_io_layer = 1 ;
  }
  shift @ARGV ;
 }

# 
#############################################################################
#
# Initialize some switches.

$max_time_level = 0 ;

# 
#############################################################################
#
# Do a first pass through the registry file.
#
# As each line is read in from the file, it is stored in the array, @inline,
# which contains the complete contents of the Registry file for subsequent
# passes through the data.
#
# Look at the dims flag and if the last character is 'f' (for field)
# then consider this a multi-field array; that is, the last index of the
# array is over fields.  Make a note of the field specifier and check
# it against prev entries to make sure it's the same. Error abort if not.
#
# Determine if 3d arrays are ijk, kij, or ikj
#

while ( <ARGV> )
{
  $line = $_ ;
  $line =~ s/#.*// ;
  next if ( $line eq "" ) ;
  $line =~ s/[ \t][ \t]*/ /g ;
  $line = lc $line ;

# fill in the blanks in quote delimited strings then remove the quotes so we can split on white space
  $inquote = 0 ;
  $newline = "" ;
  for ( $i = 0 ; $i < length($line) ; $i++ )
  {
    $ccc = substr($line,$i,1) ;
    if    ( ! $inquote && $ccc eq '"' ) { $inquote = 1 ; }
    elsif (   $inquote && $ccc eq '"' ) { $inquote = 0 ; }
    if ( $ccc eq " " && $inquote ) { $newline = $newline.$spc ; }
    else                           { $newline = $newline.$ccc ; }
  }
  $line = $newline ;
  $line =~ s/\"//g ;

  @t = split ( ' ',$line ) ;

  if    ( $t[$pre_table] eq "state" )
  {
    $revline = "state $t[$pre_type] $t[$pre_sym] $t[$pre_dims] $t[$pre_use] $t[$pre_ntl] $t[$pre_stag] - - - $t[$pre_io] $t[$pre_dname] $t[$pre_desc] $t[$pre_units]\n" ;
    @inline = ( @inline, $revline ) ;  
  }
  elsif ( $t[$pre_table] eq "i1" ) 
  {
    $revline = "state $t[$pre_type] $t[$pre_sym] $t[$pre_dims] $t[$pre_use] $t[$pre_ntl] $t[$pre_stag] - - - \n" ;  
    @inline = ( @inline, $line ) ;  
  }
  elsif ( $t[$pre_table] eq "rconfig" )
  {
    $revline = "state $t[$pre_type] $t[$pre_sym] - rconfig - - $t[$pre_howset] $t[$pre_nentries] $t[$pre_dflt] $t[$pre_rconfig_io] $t[$pre_rconfig_dname] $t[$pre_rconfig_desc] $t[$pre_rconfig_units]\n" ;  
    @inline = ( @inline, $revline ) ;
  }
  elsif ( $t[$pre_table] eq "package" || $t[$pre_table] eq "halo" || $t[$pre_table] eq "period" )
  {
    @inline = ( @inline, $line ) ;
  }
  elsif ( $t[$pre_table] )
  {
    print "REGISTRY WARNING: UNKNOWN TABLE ENTRY $t[$table]\n" ;
  }
}

$index_order_3d = "" ;

# do an integrity check on the table; specifically, make sure that if a variable is declared
# as state for one solver, it's declared the same way for all solvers.

foreach $_ ( @inline )                                         ## iterate through input lines
{
  s/#.*// ;
  s/[ \t][ \t]*/ /g ;
  $_ = lc $_ ;
  @t = split ' ' ;

  if ( $t[$table] eq "state" )
  {
    if ( $i1_follies{$t[$sym]} ne "" )
    {
      print "REGISTRY WARNING: $t[$sym] is listed as state when already i1\n" ;
      print "Registry file line: $_\n" ;
    }
    else
    {
      $state_follies{$t[$sym]} = "yes" ;
    }
  }
  if ( $t[$table] eq "i1" )
  {
    if ( $state_follies{$t[$sym]} ne "" )
    {
      print "REGISTRY WARNING: $t[$sym] is listed as i1 when already state\n" ;
      print "Registry file line: $_\n" ;
    }
    else
    {
      $i1_follies{$t[$sym]} = "yes" ;
    }
  }
}

foreach $_ ( @inline )                                         ## iterate through input lines
{
  s/#.*// ;
  s/[ \t][ \t]*/ /g ;
  $_ = lc $_ ;
  @t = split ' ' ;

  if ( $t[$table] eq "state" )
  {
    if ( $max_time_level < $t[$ntl] )     { $max_time_level = $t[$ntl] } ;
    if ( $t[$dims]=~m/f/ )               
    {
      if ( $multfieldarrays{$t[$use]} )
      {
        if ( $multfieldarrays{$t[$use]} ne $t[$dims] )
        {
          print "REGISTRY WARNING: INCONSISTENT DIM SPECS FOR USE FIELD $t[$use]\n" ;
          print "LINE: $_\n" ;
        }
      }
      $multfieldarrays{$t[$use]} = $t[$dims] ;
      $multfield_type{$t[$use]}  = $t[$type] ;
      if ( $multfield_ntl{$t[$use]} < $t[$ntl] )
        { $multfield_ntl{$t[$use]} = $t[$ntl] ; }
      $multfield_io{$t[$use]}  = $t[$io] ;
    }
    if ( $index_order_3d eq "" )
    {
      $xdims =  $t[$dims] ;
      $xdims =~ s/[ft]//g ;
      $ldims = length($xdims) ;
      if ( $ldims == 3 ) 
      {
        $index_order_3d = $xdims ;
      }
    }
    else
    {
      $xdims =  $t[$dims] ;
      $xdims =~ s/[ft]//g ;
      $ldims = length($xdims) ;
      if ( $ldims == 3 ) 
      {
                                          # kludge 20000628
        if ( $index_order_3d ne $xdims && $index_order_3d ne "ilj" )
        {
          print "REGISTRY WARNING: MORE THAN ONE INDEX ORDERING PRESENT FOR 3D ARRAYS\n" ;
          print "   $index_order_3d  $xdims  \n" ;
        }
      }
    }
  }
}

# kludge 20000628
if ( $index_order_3d eq "ilj" ) { $index_order_3d = "ikj" ; }

foreach $_ ( @inline )        # find and store the dyn-solver tags
{
  s/#.*// ;
  s/[ \t][ \t]*/ /g ;
  $_ = lc $_ ;
  @t = split ' ' ;

  if ( substr($t[$use],0,4) eq "dyn-" )
  {
    $dynsolver_tags{substr($t[$use],4)}++ ;
  }
}

# 
#############################################################################
#############################################################################
#
# Begin generating the output files 
#
# In each of the remaining sections, the particular output file is opened,
# a pass is made over the Registry data (stored in @inline) and the
# appropriate output is generated to the output file.  Finally, the output
# file is closed.
#
# 

use write_field_decls ;

#

use decls ;
write_decls() ;

#

use args_and_i1 ;
write_args_and_i1() ;

#

use config ;
write_config_calls() ;

#

use mm5_io ;
write_mm5_io() ;

#

use wrf_io ;
write_wrf_io()  ;

#

use rsl_comms ;
write_rsl_comms() ;
rsl_data_calls() ;

