Overview
Comment: | Implementation of lcos CR in Perl. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | origin/master | trunk |
Files: | files | file ages | folders |
SHA3-256: |
af94f50ad75139a5c3ccdfab8197fc77 |
User & Date: | geraint@users.sourceforge.net on 2004-09-02 00:06:21 |
Other Links: | branch diff | manifest | tags |
Context
2004-09-02
| ||
00:06:46 | Implementation of lsin CR in Perl. check-in: a8786d1ec4 user: geraint@users.sourceforge.net tags: origin/master, trunk | |
00:06:21 | Implementation of lcos CR in Perl. check-in: af94f50ad7 user: geraint@users.sourceforge.net tags: origin/master, trunk | |
2004-08-31
| ||
14:04:08 | Gracefully handles nonexistent implementation of a CR. check-in: cb79890836 user: geraint@users.sourceforge.net tags: origin/master, trunk | |
Changes
Added mttroot/mtt/lib/cr/perl/lcos.pm version [ef30e9647e].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 | #------------------------------------------------------------------------------- # Model Transformation Tools #------------------------------------------------------------------------------- package lcos; #------------------------------------------------------------------------------- # linear constitutive relationship with cosine modulation #------------------------------------------------------------------------------- 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(&lcos); # CR name %EXPORT_TAGS = ( ); } #------------------------------------------------------------------------------- # declaration of specific component implementations #------------------------------------------------------------------------------- sub lcos_emtf(@); # EMTF #------------------------------------------------------------------------------- # main function: selects which subfunction to call #------------------------------------------------------------------------------- sub lcos (@) { my $retval; $_ = $_[0]; s/\((.*)\)/$1/; # strip brackets my @args = split (/,/); # split arguments $_ = $args[0]; # get component type # select rule to use if (/EMTF|emtf/) { $retval = lcos_emtf (@args); } # if a substitution has been made ($retval) if ($retval) { return $retval; # return substituted expression } else # return nothing { return; } } #------------------------------------------------------------------------------- # EMTF #------------------------------------------------------------------------------- sub lcos_emtf (@) { my @args = @_; my $retval = ''; if ($#args == 11-1) { my ($component, $gain_causality, $gain, $out_causality, $out_port, $input, $in_causality, $in_port, $mod_input, $mod_causality, $mod_port) = @args; if ((($mod_port == 3) and ($out_causality eq $in_causality)) and ((($out_causality eq $gain_causality) and ($out_port == 2)) or (($out_causality ne $gain_causality) and ($out_port == 1)))) { $retval = "(($input)*($gain)*(cos($mod_input)))"; } elsif ((($mod_port == 3) and ($out_causality eq $in_causality)) and ((($out_causality ne $gain_causality) and ($out_port == 2)) or (($out_causality eq $gain_causality) and ($out_port == 1)))) { $retval = "(($input)/(($gain)*(cos($mod_input))))"; } } if ($retval) { return $retval; } else { return; } } #------------------------------------------------------------------------------- 1; # return true |