ADDED   mttroot/mtt/lib/cr/perl/lin.pm
Index: mttroot/mtt/lib/cr/perl/lin.pm
==================================================================
--- /dev/null
+++ mttroot/mtt/lib/cr/perl/lin.pm
@@ -0,0 +1,440 @@
+#-------------------------------------------------------------------------------
+#			Model Transformation Tools
+#-------------------------------------------------------------------------------
+
+
+package lin;
+
+#-------------------------------------------------------------------------------
+#		Default linear constitutive relationship
+#-------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+#-------------------------------------------------------------------------------
+# standard module header (see perlmod for explanation)
+#-------------------------------------------------------------------------------
+BEGIN {
+    use Exporter   ();
+    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
+
+    $VERSION     = 1.00;
+
+    @ISA         = qw(Exporter);
+    @EXPORT      = qw(&lin);	# CR name
+    %EXPORT_TAGS = ( );
+}
+
+#-------------------------------------------------------------------------------
+# declaration of specific component implementations
+#-------------------------------------------------------------------------------
+sub lin_amp (@);		# AE AF
+sub lin_cir (@);		# C I R
+sub lin_emtf(@);		# EMTF
+sub lin_fmr (@);		# FMR
+sub lin_gy  (@);		# GY
+sub lin_tf  (@);		# TF
+
+#-------------------------------------------------------------------------------
+# main function: selects which subfunction to call
+#-------------------------------------------------------------------------------
+sub lin (@) {
+
+    my $retval;
+
+    $_ = $_[0];
+
+    s/\((.*)\)/$1/;		# strip brackets
+    my @args = split (/,/);	# split arguments
+
+    $_ = $args[0];		# get component type
+
+    # select rule to use
+    if (/AE|ae/)	{ $retval = lin_amp	(@args); }
+    if (/AF|af/)	{ $retval = lin_amp	(@args); }
+    if (/C|c/)		{ $retval = lin_cir	(@args); }
+    if (/EMTF|emtf/)	{ $retval = lin_emtf	(@args); }
+    if (/FMR|fmr/)	{ $retval = lin_fmr	(@args); }
+    if (/GY|gy/)	{ $retval = lin_gy	(@args); }
+    if (/I|i/)		{ $retval = lin_cir	(@args); }
+    if (/R|r/)		{ $retval = lin_cir	(@args); }
+    if (/TF|tf/)	{ $retval = lin_tf	(@args); }
+    
+    # if a substitution has been made ($retval)
+    if ($retval)
+    {
+	return $retval;		# return substituted expression
+    }
+    else			# return nothing
+    {
+	return;
+    }
+}
+
+#-------------------------------------------------------------------------------
+# AE and AF
+#-------------------------------------------------------------------------------
+sub lin_amp (@) {
+
+    my @args = @_;
+    my $retval = '';
+
+    if ($#args == 8-1) {
+
+	my ($component,
+	    $gain_causality,
+	    $gain,
+	    $out_causality,
+	    $out_port,
+	    $input,
+	    $in_causality,
+	    $in_port) = @args;
+
+	if (($out_port == 2) and
+	    ($in_port  == 1))
+	{			# uni-causal
+	    $retval = "((input)*(gain))";
+	}
+
+	elsif (($out_port == 1) and
+	       ($in_port  == 2))
+	{			# bi-causal
+	    $retval = "((input)/(gain))";
+	}
+    }
+    
+    if ($retval)
+    {
+	return $retval;
+    }
+    else
+    {
+	return;
+    }
+}
+
+#-------------------------------------------------------------------------------
+# C, I and R
+#-------------------------------------------------------------------------------
+sub lin_cir (@) {
+
+    my @args = @_;
+    my $retval = '';
+
+    if ($#args == 8-1)
+    {
+	my ($component,
+	    $gain_causality,
+	    $gain,
+	    $out_causality,
+	    $out_port,
+	    $input,
+	    $in_causality,
+	    $in_port) = @args;
+	
+	if (
+	    ($out_port == 1)
+	    and
+	    ($in_port  == 1)
+	    )
+	{			# single port	    
+	    if ($out_causality eq $gain_causality)
+	    {
+		$retval = "(($input)*($gain))";
+	    }	    
+	    elsif ($out_causality ne $gain_causality)
+	    {
+		$retval = "(($input)/($gain))";
+	    }
+	}
+    }
+    
+    if ($retval)
+    {
+	return $retval;
+    }
+    else
+    {
+	return;
+    }
+}
+
+#-------------------------------------------------------------------------------
+# EMTF
+#-------------------------------------------------------------------------------
+sub lin_emtf (@) {
+
+    my @args = @_;
+    my $retval = '';
+
+    if ($#args == 10-1)
+    {				# modulation only
+	my ($component,
+	    $gain_causality,
+	    $out_causality,
+	    $out_port,
+	    $input,
+	    $in_causality,
+	    $in_port,
+	    $mod_input,
+	    $mod_causality,
+	    $mod_port) = @args;
+
+	if ((($mod_causality eq 'effort') and
+	     ($mod_port == 3))
+	    and
+	    ((($out_causality eq $gain_causality) and
+	      ($out_port == 2))
+	     or
+	     (($out_causality ne $gain_causality) and
+	      ($out_port == 1))))
+	{
+	    $retval = "(($input)*($mod_input))";
+	}
+	elsif ((($mod_causality eq 'effort') and
+		($mod_port == 3))
+	       and
+	       ((($out_causality ne $gain_causality) and
+		 ($out_port == 2))
+		or
+		(($out_causality eq $gain_causality) and
+		 ($out_port == 1))))
+	{
+	    $retval = "(($input)/($mod_input))";
+	}
+    }
+    elsif ($#args == 11-1)
+    {				# modulation and gain
+	my ($component,
+	    $gain_causality,
+	    $gain,
+	    $out_causality,
+	    $out_port,
+	    $input,
+	    $in_causality,
+	    $in_port,
+	    $mod_input,
+	    $mod_causality,
+	    $mod_port) = @args;
+
+	if ((($mod_causality eq 'effort') and
+	     ($mod_port == 3))
+	    and
+	    ((($out_causality eq $gain_causality) and
+	      ($out_port == 2))
+	     or
+	     (($out_causality ne $gain_causality) and
+	      ($out_port == 1))))
+	{
+	    $retval = "(($input)*(($gain)*($mod_input)))";
+	}
+	elsif ((($mod_causality eq 'effort') and
+		($mod_port == 3))
+	       and
+	       ((($out_causality ne $gain_causality) and
+		 ($out_port == 2))
+		or
+		(($out_causality eq $gain_causality) and
+		 ($out_port == 1))))
+	{
+	    $retval = "(($input)/(($gain)*($mod_input)))";
+	}
+    }
+    
+    if ($retval)
+    {
+	return $retval;
+    }
+    else
+    {
+	return;
+    }
+}
+#-------------------------------------------------------------------------------
+# FMR
+#-------------------------------------------------------------------------------
+sub lin_fmr (@) {
+
+    my @args = @_;
+    my $retval = '';
+
+    if ($#args == 7-1)
+    {				# uni-causal
+	# flow modulation multiplies effort on port 1 (or divides flow)
+	my ($component,
+	    $gain_causality,
+	    $gain,
+	    $out_causality,
+	    $input,
+	    $in_causality,
+	    $mod_input) = @args;
+
+	if (($gain_causality eq $in_causality) and
+	    ($out_causality eq 'flow'))
+	{
+	    $retval = "(($input)*($gain)*($mod_input))";
+	}
+	elsif (($gain_causality eq $in_causality) and
+	       ($out_causality eq 'effort'))
+	{
+	    $retval = "(($input)*($gain)/($mod_input))";
+	}
+	elsif (($gain_causality ne $in_causality) and
+	       ($out_causality eq 'flow'))
+	{
+	    $retval = "(($input)*($mod_input)/($gain))";
+	}
+	elsif (($gain_causality ne $in_causality) and
+	       ($out_causality eq 'effort'))
+	{
+	    $retval = "(($input)/(($gain)*($mod_input)))";
+	}
+    }
+    elsif ($#args == 11-1)
+    {				# bi-causal
+	# deduces the flow on port 2
+	my ($component,
+	    $gain_causality,
+	    $gain,
+	    $out_causality,
+	    $out_port,
+	    $e_input,
+	    $e_causality,
+	    $e_port,
+	    $f_input,
+	    $f_causality,
+	    $f_port) = @args;
+
+	if (($gain_causality eq 'effort') and
+	    ($out_causality eq 'flow') and
+	    ($out_port == 2) and
+	    ($e_causality eq 'effort') and
+	    ($e_port == 1) and
+	    ($f_causality eq 'flow') and
+	    ($f_port == 1))
+	{
+	    $retval = "((($f_input)/($e_input))/($gain))";
+	}
+    }
+    
+    if ($retval)
+    {
+	return $retval;
+    }
+    else
+    {
+	return;
+    }
+}
+
+#-------------------------------------------------------------------------------
+# GY
+#-------------------------------------------------------------------------------
+sub lin_gy (@) {
+
+    my @args = @_;
+    my $retval = '';
+
+    if ($#args == 8-1)
+    {
+	my ($component,
+	    $gain_causality,
+	    $gain,
+	    $out_causality,
+	    $out_port,
+	    $input,
+	    $in_causality,
+	    $in_port) = @args;
+
+	if (($out_causality ne $in_causality) and
+	    ($out_port != $in_port)
+	    and
+	    (($out_causality ne $gain_causality) and
+	     ($out_port == 2))
+	    or
+	    (($out_causality ne $gain_causality) and
+	     ($out_port == 1)))
+	{
+	    $retval = "(($input)/($gain))";
+	}
+
+	elsif (($out_causality ne $in_causality) and
+	       ($out_port != $in_port)
+	       and
+	       (($out_causality eq $gain_causality) and
+		($out_port == 2))
+	       or
+	       (($out_causality eq $gain_causality) and
+		($out_port == 1)))
+	{
+	    $retval = "(($input)*($gain))";
+	}
+    }
+    
+    if ($retval)
+    {
+	return $retval;
+    }
+    else
+    {
+	return;
+    }
+}
+
+#-------------------------------------------------------------------------------
+# TF
+#-------------------------------------------------------------------------------
+sub lin_tf (@) {
+
+    my @args = @_;
+    my $retval = '';
+
+    if ($#args == 8-1)
+    {
+	my ($component,
+	    $gain_causality,
+	    $gain,
+	    $out_causality,
+	    $out_port,
+	    $input,
+	    $in_causality,
+	    $in_port) = @args;
+
+	if (($out_causality eq $in_causality) and
+	    ($out_port ne $in_port)
+	    and
+	    (($out_causality eq $gain_causality) and
+	     ($out_port == 2))
+	    or
+	    (($out_causality ne $gain_causality) and
+	     ($out_port == 1)))
+	{
+	    $retval = "(($input)*($gain))";
+	}
+	
+	elsif (($out_causality eq $in_causality) and
+	       ($out_port ne $in_port)
+	       and
+	       (($out_causality ne $gain_causality) and
+		($out_port == 2))
+	       or
+	       (($out_causality eq $gain_causality) and
+		($out_port == 1)))
+	{
+	    $retval = "(($input)/($gain))";
+	}
+    }
+
+    if ($retval)
+    {
+	return $retval;
+    }
+    else
+    {
+	return;
+    }
+}
+#-------------------------------------------------------------------------------
+1;				# return true
+