#!/usr/bin/perl -w
#
# ampsr.pl v0.02        --crb3 30may03
#
# given input, output and reference voltages (high and low),
# calculate a feedback (attenuator) network for a noninverting
# op-amp buffer which will produce that amplifer behavior, first
# as ideal values, then as best values found by searching a
# standard array of resistor values.
#       program         picture (ampsr.png)
#       -------         -------
#       Rf (feedback)   R3
#       Rh (high)       R2
#       Rl (low)        R1
#
# This program is copyright (C) 1983-2003 Carroll R. Bryan III
# (crb3@stormbringer.org), All Rights Reserved. It is made
# available under the terms of the GNU General Public License,
# version 2 (http://www.gnu.org/licenses/gpl.txt).
#
# v0.01 --crb3 24may03  initial Perl version.
# v0.02 --crb3 30may03  put in argfile handling.
#

use POSIX qw(log10 pow);

$|=1;

$chatty=0;

@cfvals = (
    1.0,1.1,1.2,1.3,
    1.5,1.6,1.8,2.0,
    2.2,2.4,2.7,3.0,
    3.3,3.6,3.9,4.3,
    4.7,5.1,5.6,6.2,
    6.8,7.5,8.2,9.1,
    10.0
    );

@milvals = (
    1.00,1.02,1.05,1.07,
    1.10,1.13,1.15,1.18,
    1.21,1.24,1.27,1.30,
    1.33,1.37,1.40,1.43,
    1.47,1.50,1.54,1.58,
    1.62,1.65,1.69,1.74,
    1.78,1.82,1.87,1.91,
    1.96,2.00,2.05,2.10,
    2.15,2.21,2.26,2.32,
    2.37,2.43,2.49,2.55,
    2.61,2.67,2.74,2.80,
    2.87,2.94,3.01,3.09,
    3.16,3.24,3.32,3.40,
    3.48,3.57,3.65,3.74,
    3.83,3.92,4.02,4.12,
    4.22,4.32,4.42,4.53,
    4.64,4.75,4.87,4.99,
    5.11,5.23,5.36,5.49,
    5.62,5.76,5.90,6.04,
    6.19,6.34,6.49,6.65,
    6.81,6.98,7.15,7.32,
    7.50,7.68,7.87,8.06,
    8.25,8.45,8.66,8.87,
    9.09,9.31,9.53,9.76,
    10.0
    );

#
# what params are in already?
#
%gots = (
          vh => 0,
          vl => 0,
          ih => 0,
          il => 0,
          oh => 0,
          ol => 0,
          pr => 0,
        );

sub argswitch {
  my($key,$arg)=(@_);

  if($key eq "vh"){
    $Vrh=0+$arg;                # coerce all these strings to numeric
    $gots{"vh"}=1;
  }elsif($key eq "vl"){
    $Vrl=0+$arg;
    $gots{"vl"}=1;
  }elsif($key eq "ih"){
    $Vih=0+$arg;
    $gots{"ih"}=1;
  }elsif($key eq "il"){
    $Vil=0+$arg;
    $gots{"il"}=1;
  }elsif($key eq "oh"){
    $Voh=0+$arg;
    $gots{"oh"}=1;
  }elsif($key eq "ol"){
    $Vol=0+$arg;
    $gots{"ol"}=1;
  }elsif($key eq "pr"){
    $pr=0+$arg;
    $gots{"pr"}=1;
  }elsif($key eq '@'){
    $argfname=$arg;
    $gots{'@'}=1;
  }else{
    die "switch not recognized: -$key $arg\n";
  }
}

$argfname="";

while(defined($ARGV[0])){
  $arg=shift(@ARGV);
  if(substr($arg,0,1) eq '-'){
    substr($arg,0,1)="";
    if(index($arg,'=')>-1){
      ($key,$arg)=split('=',$arg,2);
      $key=lc($key);
    }else{
      $key=lc($arg);
      $arg=shift(@ARGV);
    }
    &argswitch($key,$arg);
  }else{
    die "commandline arg $arg not recognized\n";
  }
}
#
# we allow for implicit includes here, by looping on fresh argfiles.
#
while($gots{'@'}){
  $gots{'@'}=0;
  open(AFIL,"<$argfname") or die "can't open argfile $argfname\n";
  while(defined($inline=<AFIL>)){
    chomp $inline;
    next if $inline =~ /^\s*$/;
    next if $inline =~ /^\s*\#/;
    ($key,$arg)=split('=',$inline,2);
    &argswitch($key,$arg);
  }
  close(AFIL);
}

#
# fill in with prompt-and-fetch, using %gots to say what's needed.
#
$Vih=query("highest input voltage") unless $gots{"ih"};
$Vil=query("lowest input voltage") unless $gots{"il"};
$Voh=query("highest output voltage") unless $gots{"oh"};
$Vol=query("lowest output voltage") unless $gots{"ol"};
$Vrh=query("high reference voltage") unless $gots{"vh"};
$Vrl=query("low reference voltage") unless $gots{"vl"};
$pr=query("5% or 1% array values") unless $gots{"pr"};

#
# now, just get on with it. first, the network calculations.
#

if($pr==1){     # use 1% value array?
  $precise=1;
  $endv = 96;
}else{          # use 5% array.
  $precise=0;
  $endv = 24;
  $pr=5;        # nail down the default
}

# start by deriving normalized ideals, working from a 10k Rf.

$Av = (($Voh-$Vol) / ($Vih-$Vil));
$Rf = 10E3;
$Ih = ($Voh - $Vih) / $Rf;
$Il = ($Vol - $Vil) / $Rf;
$Rp = ($Vih - $Vil) / ($Ih - $Il);
$V2 = $Vih - ($Ih * $Rp);

die "\areference voltages not usable (V2==$V2)\n" if($V2<=$Vrl || $V2>=$Vrh);

$N = ($V2 - $Vrl) / ($Vrh - $Vrl);
$Rh = 1 / ( (1 / $Rp) * $N);
$Rl = 1 / ( (1/$Rp) - (1/$Rh) );

printf("Av=\t%Lf\nRf=\t%Lf\nIh=\t%Lf\nIl=\t%Lf\nRp=\t%Lf\nV2=\t%Lf\n",
            $Av,$Rf,$Ih,$Il,$Rp,$V2) if $chatty;
printf("N=\t%Lf\nidealRh=%Lf\nidealRl=%Lf\n",$N,$Rh,$Rl) if $chatty;

#
# ideal values found. now the scaling search, to find the best
# resistor set among the chosen value array.
#
$besterr=9999.9999; $s_besterr=sprintf("%Lf",$besterr);
for($b=0;$b<$endv;$b++){
  if($precise==1){
    $scaler=$milvals[$b];
    $tryRh=get_best_mil($Rh*$scaler);
    $tryRl=get_best_mil($Rl*$scaler);
    $tryRf=get_best_mil($Rf*$scaler);
  }else{
    $scaler=$cfvals[$b];
    $tryRh=get_best_cf($Rh*$scaler);
    $tryRl=get_best_cf($Rl*$scaler);
    $tryRf=get_best_cf($Rf*$scaler);
  }

#
# values selected, now try em on for size, see if they fit better than the
# last set.
#

  $tryV2 = ( ($tryRl / ($tryRl + $tryRh)) * ($Vrh-$Vrl) ) + $Vrl;
  $tryRp= (1 / ((1/$tryRh)+(1/$tryRl)) );
  $tryAv= 1 + ($tryRf / $tryRp);
  $tryVoh = $tryV2 + (($Vih-$tryV2)*$tryAv);
  $tryVol = $tryV2 + (($Vil-$tryV2)*$tryAv);
  if($tryVoh>$Voh){
    $tryerr = abslut(pc_ch($tryVoh,$Voh));
  }else{
    $tryerr = abslut(pc_ch($Voh,$tryVoh));
  }
  if($tryVol>$Vol){
    $tryerr += abslut(pc_ch($tryVol,$Vol));
  }else{
    $tryerr += abslut(pc_ch($Vol,$tryVol));
  }

  $s_tryerr=sprintf("%Lf",$tryerr);

  print "Rf=$tryRf, tryerr=$s_tryerr...\n" if $chatty;

  if($b==0 or $s_tryerr lt $s_besterr){

    print "tryerr=$tryerr < besterr=$besterr\n"
        ."Rh\t$tryRh\tRl\t$tryRl\tRf\t$tryRf\n"
        ."Voh\t$tryVoh\tVol\t$tryVol\tAv\t$tryAv\n" if $chatty;

    $bestRl=$tryRl;
    $bestRh=$tryRh;
    $bestRf=$tryRf;
    $bestVoh=$tryVoh;
    $bestVol=$tryVol;
    $bestAv=$tryAv;
    $besterr=$tryerr;
    $s_besterr=sprintf("%Lf",$tryerr);
  }
}

# announce the best selection set, and go home.

print "Best fits:\tAv=$bestAv\terr=$besterr\n"
        ."Rh=$bestRh\tVih=$Vih\tVoh=$bestVoh\n"
        ."Rl=$bestRl\tVil=$Vil\tVol=$bestVol\n"
        ."Rf=$bestRf\tVrefhi=$Vrh\tVreflo=$Vrl\n";

if(0){
printf( "\nBest fits:\n"
        ."Rl=%Lf\nRh=%Lf\nRf=%Lf\n"
        ."Voh=%Lf\tVol=%Lf\tAv=%Lf\terr=%Lf\n",
        $bestRl,
        $bestRh,
        $bestRf,
        $bestVoh,
        $bestVol,
        $bestAv,
        $besterr
        );
}

exit(0);

#----------------------------------------

# get_best_mil.
# Get the closest fit, in the standard 1% array of values, to the provided
# ideal calculated value. There are 96 values in the array. Rather than a
# simple linear iterative search, a modified binary-tree search (modified
# because there's a '3' in the components, so there's a triplet in there
# somewhere) ... kind of an SAR.
#
sub get_best_mil {
  my $ideal = shift(@_);
  my($v,$a,$b,$sel);
  my($err,$lasterr,$try,$ord,$mult);

  $v = int(log10($ideal));      # crack off the fraction

  $mult = pow10($v);

  $ord = $ideal / $mult;        # just the array-size val

# get the triplet out of the way first

  for($sel=$a=0;$a<3;$a++){
    $try=$milvals[$a*32];
    $sel = $a*32 if($try < $ord);
  }

# now the bit-shift part.

  for($a=0,$b=16;$a<5;$a++,$b>>=1){
    $try=$milvals[$sel+$b];
    $sel += $b if($try < $ord);
  }

# one final pass to knock out quantization error and include the '10' in the
# search

  $try = $milvals[$sel];


  $lasterr=pc_ch($ord,$try);
  $try=$milvals[$sel+1];
  if($try>$ord){
    $err=pc_ch($try,$ord);
  }else{
    $err=pc_ch($ord,$try);
  }
  if($err<$lasterr){
    $sel+=1;
  }
  return($milvals[$sel] * $mult);

}

#---------------------------------------

# get_best_cf.
# Get the closest fit, in the standard 5% array of values, to the provided
# ideal calculated value. There are 24 values in the array. Rather than a
# simple linear iterative search, a modified binary-tree search (modified
# because there's a '3' in the components, so there's a triplet in there
# somewhere) ... kind of an SAR.
#

sub get_best_cf {
  my $ideal = shift(@_);
  my($v,$a,$b,$sel);
  my($err,$lasterr,$try,$ord,$mult);

  $v = int(log10($ideal));      # crack off the fraction

  $mult = pow10($v);

  $ord = $ideal / $mult;        # just the array-size val

print "ideal=$ideal, mult=$mult, ord=$ord\n" if $chatty;

# get the triplet out of the way first

  for($sel=$a=0;$a<3;$a++){
    $try=$cfvals[$a*8];
    $sel = $a*8 if($try < $ord);
  }

# now the bit-shift part.

  for($a=0,$b=4;$a<3;$a++,$b>>=1){
    $try=$cfvals[$sel+$b];
    $sel += $b if($try < $ord);

print "a=$a, b=$b, sel=$sel, try=$try, ord=$ord\n" if $chatty;

  }

# one final pass to knock out quantization error and include the '10' in the
# search

  $try = $cfvals[$sel];

  $lasterr=pc_ch($ord,$try);
  $try=$cfvals[$sel+1];
  if($try>$ord){
    $err=pc_ch($try,$ord);
  }else{
    $err=pc_ch($ord,$try);
  }
  if($err<$lasterr){
    $sel+=1;
  }

  return($cfvals[$sel] * $mult);

}

#--------------------------------------

# abslut.
# this was a macro in the C version.
# #define abslut(x)  (x>=0 ? x : (0-x))
#
sub abslut {
  my $x=shift(@_);

  return($x >= 0 ? $x : (0-$x));
}

#--------------------------------------

# pc_ch.
# this was a macro in the C version.
# #define pc_ch(x,y)  (((x-y) / x) * 100)
#
sub pc_ch {
  my($x,$y)=(@_);

  return( ( ($x-$y / $x) * 100) );
}

#--------------------------------------

# pow10.

sub pow10 {
  my $x = shift(@_);

  return( pow(10,$x) );
}

#--------------------------------------

# query

sub query {
  my ($ask)=(@_);

  print "$ask? ";
  my $resp = <STDIN>;


  return($resp);
}

__END__


 Grab a
gzipped
copy
here
 
Syntax highlighting using Syntax::Highlight::Engine::Kate