Over the past years, camcorders have excelled in capturing video, but the quality of the audio remains lagging.  Adding an external microphone is a must, but will only get you so far.  Quiet voices will barely rise above the noise floor, while it feels like the videographer yelling in your ear.

This article describes a three stroke approach to improve sound from camcorders.  The first step is to reduce the noise.  In the following steps the dialog loudness is set to a standard level and the dynamic range is reduced.  The last two steps are an integral part of AC-3 (A/52, Dolby Digital) but can also be applied to other streams such as Advanced Audio Codec (AAC) as shown in the last section.

Noise reduction

First things first.  Start with a good external microphone and a wind muff.  Personally, I use a Canon 5.1 microphone because it is small and mounts on the hot shoe.  The specs are not that impressive, but even an ideal microphone will pick up a significant amount of ambient noise.

The noise level is defined as the loudness perceived by the human ear.  The loudness is commonly measured using a frequency filter that mimics the human hearing and then measuring the energy as root-mean-square (LAeq).  Note that for a sine wave the RMS level is √2 × peak level.  Another popular measure is the K-scale for which there are several plugins such as mzuther's, DPMP, and meterplugs.

Personally, I take a shortcut by not applying the filter and simply measuring the RMS level of noise samples.  For this, I use the stats function from Sound Exchange.  In practice this appears to be good enough.  My typical indoor measurements are shown in the table below.  The values in the table are expressed at decibels below digital full-scale.

With the quiet dialog level this close to the noise floor, we can't amplify this dialog without also significantly amplifying the noise.  As a first step we lower the noise floor in post using an audio editor such as Adobe Sound Booth.  This usually reduce the noise by about 8 dB without causing significant distortion.

Dialog Normalization

The volume dial on AC-3 decoders controls the loudness of a normal dialog.  The listener is thus able to reliably set the volume level of the dialogue no matter what program is playing.  This does however require the audio to indicate the normal dialog level at which it is recorded.  In AC-3 this is accomplished using the metadata tag "dialnorm" as described in the AC-3 specification §5.4.2.8 and §7.6.  The decoder uses this parameter to automatically adjust the volume so that the dialog is always played at the same loudness.

Dialog loudness expresses how an average person perceives the volume of a dialog [DD1; DD2].  The film industry has long standardized the normal dialog level at -31 dBFS.  The corresponding Sound Pressure Level (SPL) for most movie theaters is 85 dB.

At home we have a volume dial that selects the SPL for normal dialog.  Assuming the volume dial is set to a sound pressure level of 67 dB for normal dialog.  When this decoder plays a stream with a normal dialog level of -31 dBFS, it will adjust the amplifier gain so that 0 dBFS ≡ 98 dB, what causes the normal dialog to reproduce at -31 dBFS ≡ 67 dB.  If the listener switches to another program with a normal dialog at -25 dBFS, the amplifier gain will be reduced so that 0 dBFS ≡ 92 dB, and the normal dialog stays at a 67 dB.

Dynamic Range Compression

The sound from camcorders often has an undesirable large dynamic range.  On one end, there may be people whispering in the distance, while on the other end we may have the videographer holding the camcorder.  The difference between these loudness levels in called dynamic range.  We can reduce the dynamic range by both amplifying the quiet sounds and attenuating the loud sounds.  Note that to successfully boost the quiet sounds, it is essential that they are well above the noise floor.

With AC-3 we can adjust the gain using the metadata tag "dynrng" as described in §7.7 of the AC-3 specification.   The AC-3 encoder generates these tags based on the loudness combined with a compression profile.  All standard profiles have a null-band that is centered around the normal dialog level.  Loudness levels within this null-band are left intact.  For the film compression profile at a normal dialog level of -31 dBFS, the transfer function can be visualized as shown below.

As shown in the graph above, signals from -33.5 to -28.5 dBFS stay the same.  The 12 dB below is boosted, while the 10 dB above is attenuated as also shown in the table below.

This film at dialnorm -31dBFS profile is a good fit for my camcorder recordings.  The quiet dialog is more or less in the middle of the boost range, the normal dialog is at the normal dialog level, while the loud dialog is in the early cut range.

The table above shows that the soft dialog is amplified by 4 dB, but at the cost of raising the noise level 2 dB.  If we had a constant background noise level, we could consider alter the transfer function so that it attenuate all signals below -45.5 dBFS.

Let's do it

As shown above, applying dialog normalization and dynamic range is straightforward using the metadata in AC-3.  For other audio streams, we will need to alter the samples to get the same effect.

AC-3

For AC-3, we only need to extract the audio stream using FFmpeg and compress it using Aften.

ffmpeg -y -vn -i in.avi out.wav
aften -v 0 -dnorm 31 -dynrng 1 out.wav out.ac3

AAC

The Advanced Audio Codec (AAC) doesn't support the metadata for dialog normalization or dynamic range compression.  Instead, we modify the samples directly using SoX as shown below.  Note that in this particular example it also applies a 13 dB overall gain.  The values printed in bold represent the compression curve.  The resulting stream is then compressed using Nero's AAC encoder.

ffmpeg -y -vn -i in.avi tmp.wav
set CURVE=-90.0,-84.0,-45.5,-39.5,-33.5,-33.5,-28.5,-28.5,-18.5,-23.5,0.0,-22.6
sox tmp.wav out.wav compand 0.1,3.0 %CURVE% 13.0 -90 1.6 stats
neroaacenc -lc -br 226000 -if out.wav -of out.aac

Those who like to experiment themselves find the transfer curves for other profiles at various dialog levels.

• film light

  -31:   -90.0,-84.0, -53.0,-47.0, -41.0,-41.0, -21.0,-21.0, -11.0,-16.0, 0.0,-15.5
  -28.5: -90.0,-84.0, -50.5,-44.5, -38.5,-38.5, -18.5,-18.5,  -8.5,-13.5, 0.0,-13.1
  -27:   -90.0,-84.0, -49.0,-43.0, -37.0,-37.0, -17.0,-17.0,  -7.0,-12.0, 0.0,-11.7

• film

  -31:   -90.0,-84.0, -45.5,-39.5, -33.5,-33.5, -28.5,-28.5, -18.5,-23.5, 0.0,-22.6
  -28.5: -90.0,-84.0, -43.0,-37.0, -31.0,-31.0, -26.0,-26.0, -16.0,-21.0, 0.0,-20.2
  -27:   -90.0,-84.0, -41.5,-35.5, -29.5,-29.5, -24.5,-24.5, -14.5,-19.5, 0.0,-18.8

• speech

  -31:   -90.0,-74.8, -52.5,-37.3, -33.5,-33.5, -28.5,-28.5, -18.5,-23.5, 0.0,-22.6
  -28.5: -90.0,-74.8, -50.0,-34.8, -31.0,-31.0, -26.0,-26.0, -16.0,-21.0, 0.0,-20.2
  -27:   -90.0,-74.8, -48.5,-33.3, -29.5,-29.5, -24.5,-24.5, -14.5,-19.5, 0.0,-18.8

• music light

  -31:   -90.0,-78.0, -65.0,-53.0, -41.0,-41.0, -21.0,-21.0, -21.0,-21.0, 0.0,-20.0
  -28.5: -90.0,-78.0, -62.5,-50.5, -38.5,-38.5, -18.5,-18.5, -18.5,-18.5, 0.0,-17.6
  -27:   -90.0,-78.0, -61.0,-49.0, -37.0,-37.0, -17.0,-17.0, -17.0,-17.0, 0.0,-16.2

• music

  -31:   -90.0,-78.0, -57.5,-45.5, -33.5,-33.5, -28.5,-28.5, -18.5,-23.5, 0.0,-22.6
  -28.5: -90.0,-78.0, -55.0,-43.0, -31.0,-31.0, -26.0,-26.0, -16.0,-21.0, 0.0,-20.2
  -27:   -90.0,-78.0, -53.5,-41.5, -29.5,-29.5, -24.5,-24.5, -14.5,-19.5, 0.0,-18.8

For more information

• Properly encoding AC-3
• Measuring LAeq
• Callibrate SPL

The NXT-G graphical integrated development environment (IDE) provides the five basic elements of programming: input/output, conditionals, loops, variables and functions.  It combines research ideas from MIT, with a graphical IDE from National Instruments.

The graphical IDE reduces the initial learning curve.  Novices can start programming by combining Action blocks to make the motors move and generate light or sound.  Once these concepts they can introduce flow elements such as conditionals, loops and wait.  These flow elements can used embedded sensor readings.  More advanced programmers can read the sensors directly and process the outputs using math and logic functions.

Coming from a more traditional text based programming environment, and trying stay a step ahead of my children, I read Terry Griffin's excellent book [1] along with some other resources [2,3,4,5,6,7,8].  This is a write up for my future reference.

Work Flow

To create a program, you connect blocks.

• Drag and drop blocks from the palette onto the work space.  Each block performs an unique function such as turning the motors, or measuring a distance.
• Use the tabs on the bottom of the palette to switch between sets of blocks.
• To save your work as a package use Tools > Create Pack and Go.
• As always, keep it simple.  Divide up the problem in small steps, and test each step before combining them.

To compile, download to the NXT robot and run, you use the controls in the bottom-right of the work space.

• middle-button, compiles the program, downloads and runs it to  the NXT
• top-right button, compiles selected blocks, downloads and runs it to  the NXT
• bottom-left button, compiles the program and downloads it to  the NXT
• bottom-right button, stops the program on the NXT.
• top-left button, manages the NXT memory space, click the top-left button; click on the bar graph on the left to select a memory.  This will also let you transfer files.

I/O blocks (equiv. to library functions in C)

A program is composed by connecting blocks on a sequence beam.  Blocks are executed sequentially.

Output

Outputs functions are called "Action blocks" in NXT-G jargon.  The Motor block controls a single motor that for example moves a robot arm, or rotate a wheel.  The Move block, on the other hand, drives two motors, such as to rotate the wheels on a robot to make it go forward.  The Move block synchronizes the motors to keep the robot travelling in a straight line.  In all cases, you specify how far the motor turns, not how far an arm moves or a wheel travels.  For a wheel, the distance traveled depends on the number of motor rotations, optional gears and the circumference of the wheel (14 cm for the snap-on tires).

Other output blocks generate sound, light or write to the display or Bluetooth device.

• Motor action
  • Motor block
    • Controls a single motor
    • Automatically corrects for rotation errors.
    • Parameters:
      • action, constant or ramp up/down until target is met.
      • power, <10 will not move; >75 moves out of control.
      • control, automatically adjust the power to correct for resistance or slipping.
      • duration, unlimited = switches the motor on and continues with the next block on the Sequence beam.
      • wait, when unchecked, it will move on to the next block on the Sequence beam while the motor meanwhile completes its action.
  • Move block
    • Controls two motors, synchronizing the B and C motors
    • Automatically corrects for rotation errors.
    • Parameters (also see the Motor block):
      • steering, middle = straight; far left/right = spin in place (motors turn opposite directions).
      • next action, brake = provides accurate travel distance and then hold the motor in place; coast = stop the power to the motor so it rolls to a stop (Because the motor coasts to a stop, it will move a little further than the Duration setting. When a following Move or Motor block runs, it will automatically adjust for the rotation error.)
  • Reset
    • Resets the accumulated rotation error, causing the next Motor or Move block to disregard prior rotation errors.  The Reset block should precede the first Motor or Move block in a program.
• Other action blocks
  • Sound
    • Plays a sound file or a single tone
    • Parameters:
      • wait, when unchecked, the next block on the Sequence beam will start while the sound is playing.
  • Display
    • Writes a text string or shapes to the NXT display
  • Send message
    • Transmits a wireless message to another NXT assuming it has been paired before.  Each NXT has 10 mailboxes each 5 messages deep.  Head-drop when mailbox is full.
  • Color lamp
    • Turns a color lamp on or off.

Input

Most input block read data from external sources and compare the data read to a preset value or range.  The results are made available at its data hub.  The data hub can be shown by clicking on the tab at the bottom of the block.  Data wires connect the outputs to other blocks.  Configuration parameters can also be set by incoming wires.

• Sensor blocks
  • Ultrasonic Sensor block
    • Measures the distance to an object and compares it to a criterion.
    • Outputs:
      • yes/no, true if criterion is met, false otherwise
      • distance, scaled value from sensor [0..255 cm | 0..100 inches].
  • Touch Sensor block
    • Reads the touch sensor's state and compares it to a criterion (pressed, released, bumped). Note that a program may not be fast enough to detect the "bumped" state.
    • Outputs:
      • yes/no, true if criterion is met, false otherwise
      • raw value, unscaled value from sensor [0..1024]
      • logic number, 0=released; 1=pressed.
  • NXT Buttons block
    • Reads a NXT button state and compares it to a criterion (pressed, released, bumped). Note that your program may not be fast enough to detect a condition as "bumped".
    • Output:
      • yes/no, true if criterion is met, false otherwise.
  • Color Sensor block
    • Measures color or light intensity and compares it to a criterion.  When the parameter "light" is checked it generates its own light and measure the reflected light.
    • Outputs:
      • yes/no, true if criterion is met, false otherwise
      • detected color, light intensity [0..100] or detected color (1=black; 2=blue; 3=green; 4=yellow; 5=red; 6=white).
  • Rotation sensor block
    • Measures the number of degrees that the motor turned and compares it to a criterion.  The same block can also be used to reset the rotation counter.
    • Output:
      • yes/no, true if criterion is met, false otherwise
      • direction, true=forwards; false=backwards
      • degrees, scaled value from sensor [0..2147483647].
• Other blocks
  • Timer block
    • Reads one of the tree timers and compares it against a criterion.  Time is specified in seconds on the configuration panel, but in milliseconds when using input data wires.  The block can also be used to reset a timer.
    • Output:
      • yes/no, true if criterion is met, false otherwise
  • Receive Message block
    • Receives a Bluetooth message and compare it against a criterion.
    • Outputs:
      • yes/no, true if criterion is met, false otherwise
      • message received, true when a message has been received, false otherwise
      • {text|number|logic} out, message data.
  • Random block
    • Generates a random number within a range.  Can be used to make the robot a little unpredictable and thus more interesting.
    • Output:
      • number, random value between specified lower and upper bounds.

Data manipulation

Sophisticated data manipulations are supported through combining several number and text blocks.

• Numbers
  • Math Block
    • Performs basic math operations (addition, subtraction, multiplication, division, square root, absolute value).
    • Output:
      • result, result of the operation [-2147483648 .. 2147483647]
  • Logic Block
    • Performs Boolean operations (AND, OR, XOR or NOT)
    • Output
      • result, result of the operation [true|false]
  • Compare Block
    • Performs less than (<), greater than (>) or equal (=) operations
    • Output
      • result, result of the operation [true|false]
  • Range Block
    • Determines if a value is within a range of numbers
    • Output
      • yes/no, true of the value is within range, false otherwise
• Text strings
  • Number to Text block
    • Converts a number to a text string
    • Output
      • text, text representation of number [string]
  • Text block
    • Concatenates a maximum of three text strings
    • Output
      • text, concatenation of text strings [string]

Program Flow

Flow elements can take input from an embedded sensor or from a data wire.

• Conditionals
  • Switch block (equiv. to switch())
    • Checks for a condition, and runs blocks on the sequence beam corresponding to that condition.
    • More then two conditions are allowed.
    • The '*' button selects the default condition.
    • Floating point inputs are rounded to the nearest integer before comparing them.
    • Comments should be left outside a switch block.
• Wait
  • Wait block
    • Busy-loop to poll an input until the specified condition is met.
• Loops
  • Loop block (equiv. to do while())
    • Repeats a set of blocks until the end condition is met.
    • The loop count output is updated at the start of the last run through the loop, it will be one fewer than the total number of times the loop repeats.

My blocks (equiv. to user functions)

My blocks should be used to abstract program sections that perform specific functions.  Dividing a program into smaller pieces, makes the program easier to read and maintain.  Each My block can be tested independently and reused in the same or other programs.

• Usage
  • Create, select the blocks; "Edit > Make a new My Block" from the menu
  • Open, double-click the My Block
  • Use, select from the Custom Palette (using the tab at the bottom of the Palettes)
  • Close, "File > Close" from the menu
  • Organize, "Edit > Manage Custom Palette" from the menu; then use the file system to organize.
• Creating My blocks that have a data hub
  • Use compare, text or math blocks to supply input values to the blocks that will become a new My block.  These additional blocks are only needed to supply the data wire, and will not become part of the My block.
  • Select the blocks for the new My Block and call "Edit > Make a new My Block" from the menu.  All the data wires will remain connected. The value of the wire will also become configurable using the Configuration Panel.
  • Note that once a My block is made, you can change the name of data plugs, but you can not add more plugs.  You will have to recreate the My block instead.
• Appears broken if
  • two data plugs have the same name, or
  • there is problem with the data wire connections, or
  • the source file for the block has been moved or renamed in the computer's file system.
• Note
  • If you absolutely have to copy a My block, then use the file system.  Don't use "save as" from the menu.
  • When moving a program to another computer, also move the My Blocks or better yet create a package that contains all the related files ("Tools > Create Pack and Go")

Data

Most blocks have input plugs that correspond to the parameters in its configuration panel.  Using the data inputs, a program can change these parameters.  For example, the output of an ultrasound sensor could be used to specify the power of the motors, thereby slowing down the robot when it approaches an object.

Data wires (equiv. to mailboxes)

In the NXT-G world, data passes over so called "Data wires".  A Data wire connects one output to one or more inputs.

• Scope
  • Local to the blocks that it connects to the wire.
• Usage
  • draw a wire between blocks
    • expand the data hubs (click on the tab at the bottom of a block).
    • the plugs on the left are inputs; the plugs on the right are outputs.
    • click on an output terminal
    • click on the input terminal that you want to connect.
  • draw a wire into the boundary of a Switch block
    • enable tabbed view (disable flat view)
    • connect a wire to the input
    • switch back to flat view
  • draw wires from within the boundary of a Switch block
    • enable tabbed view
    • select the "true" condition and connect a wire
    • select the "false" condition and connect a wire from the output to the edge of the block where the existing wire crosses it.
    • switch back to flat view
  • delete a wire
    • click the data plug at the right of the wire.
• Note
  • Use variables instead of passing data wires in/out of a Loop or Switch block.
  • Occasionally, a wire may be routed behind another block, making it appear as if its terminals are connected.
  • A dashed grey wire indicates a problem, such as
    • two plugs have different data types (Boolean, integer, float, string)
    • the output of a pass-through plug is not used without the input side connected
    • multiple inputs are connected to one output plug.
    • an input is connected to an output that appears later on the sequence beam.

Variable block (equiv. to variables)

Variables are expected to change over time, such as a distance to a wall.  A variable can be used to connect one or more outputs to one or more inputs.

• Scope
  • Local to the program (and its My blocks) that defines it.
• Usage
  • create a variable, "Edit > Define Variables" from the menu.
  • use a variable, insert a Variable block.
  • delete a variable, first remove any Variable blocks that use it.
• Notes
  • A program shares its variables with its My blocks if they have the same name and data type.
  • Perhaps not the best coding practice, but variables can be used when a My Block needs to remember a value.

Constant block (equiv. to const or #defines)

As the name implies, constant values do not change.  An example is the diameter of the wheels on a robot.  A constant block supplies a constant value to more or one inputs.

• Scope
  • Global to all programs.
• Usage
  • create, "Edit > Define Constants" from the menu.  Specify the action "choose from list".
  • use, insert a Constant block.
  • change, save any open programs that use that constant.
  • delete, "Edit > Define constants" from the menu.  Note that any Constant block that uses that constant will change to Custom.
• Note
  • When working with a program that uses custom constants, note that:
    • changing the value in one Constant block won’t affect the other programs.
    • creating a constant using the Edit Constant dialog will change all "Custom" constants with the same name.

File Access block

Files can store settings or input/output data for a program.

• Scope
  • Global to all programs running on a NXT.  Remain available after the program ends.
• Usage
  • create, insert a File Access block; select create as the action.  A list of files already on the NXT will appear (assuming it is connected using either USB or BT).
  • write, insert a File Access block; select write as the action to appends to a file.
  • read, insert a File Access block; select read as the action.
  • delete, insert a File Access block; select delete as the action.
  • close, insert a File Access block; select close.  Remember to close a file after writing to it.  Otherwise you can not delete or read from it.
• Note
  • A program can write to or read from up to four files at once.
  • The Initial File Size data plug that allows you to specify how much memory to allocate for the file. If the file grows past the initial size, the NXT will move the file to larger memory space, thereby introducing a slight delay.

Wireshark is a open-source protocol analyzer that can visualize the frames passing through the router. This analyzer is available on many platforms, but can not run directly on the router.

using tcpdump

While one could run tcpdump directly on the router, interpreting its output takes a bit of work. Another option run tcpdump on the router and pipe its output to wireshark on a Linux host. Details can be found in Remote Packet Capture. An excerpt.  To capture traffic on bridge br0, use the following commands on a Linux host.

mkfifo /tmp/$PPID
ssh rtr "tcpdump -i br0 -w - 'not ((src host rtr and src port 22) or (dst host rtr and dst port 22))'" > /tmp/$PPID. &
wireshark -k -i /tmp/$PPID

using etherpuppet

Instead we forward all packets from an interface on the router to a Linux host, where they the protocol analyzer runs.

Prepare the router

cd /jffs
wget http://www.secdev.org/projects/etherpuppet/files/etherpuppet-mipsel
chmod 755 etherpuppet-mipsel

Prepare the Linux host

wget http://hg.secdev.org/etherpuppet/raw-files/top/etherpuppet.c
gcc -o etherpuppet etherpuppet.c
sudo yum install wireshark-gnome
sudo usermod -a -G wireshark $NAME

Instruct the router to forward all packets on the bridge that joins the LAN and wireless traffic (br0).

./etherpuppet-mipsel -i br0 -s 999 -C

Receive the packets on the Linux host and start the protocol analyzer.

sudo ./etherpuppet -m -c rtr2.vonk:999 &

sudo ifconfig puppet0 up
sudo wireshark # select interface puppet0

In Wireshark select the puppet0 interface.

• VLANs, allows wired LAN ports to be grouped and each group to be treated differently.
• multiple SSIDs, allows multiple wireless network names (SSID) and security settings.  The traffic over each SSID can be treated differently.

Before we start

• the web based user interface (WebGUI)
• networking concepts such as IP addresses, sub nets, routing, bridging and network interfaces.  Some of the more specific terminology used in this article is:
  • A broadcast domain, is a network segment, in which all nodes can communicate directly by layer-2 broadcasts.  Examples are a wired GigE network, or a wireless network.
  • A switch, handles frames at the data link layer (layer 2).
  • A router, handles packets at the network layer (layer 3).  A router forms a boundary between broadcast domains.
  • A bridge, connects two or more network segments into a single broadcast domain (layer 2).
  • A virtual LAN (VLAN), creates distinct broadcast domains within one ore more physical networks.  A VLAN is a switched network that is logically segmented by functions, project teams, or applications without regard to the physical location of users.

Inside the router

Hardware block diagram

• System-on-Chip BCM4718, provides the CPU, WiFi and USB.
• Switch Fabric BCM53115, provides  the WAN and four LAN ports

• the LAN port numbers on the case do not correspond to the port numbers on the switch;
• the WAN port connects to a special interface on the switch and can't be reassigned;
• port 8 connects the VLAN trunk from the switch to interface eth0 on the CPU.

Firmware mapping

nvram show | grep vlan.*ports | sort
vlan0ports=1 2 3 4 5*
vlan1ports=4 3 2 1 8*
vlan2ports=0 8

nvram show | grep port.*vlan | sort
port0vlans=2 18 19
port1vlans=1 18 19
port2vlans=1 18 19
port3vlans=1 18 19
port4vlans=1 18 19
port5vlans=1 2 16

nvram show | grep vlan.*hwname | sort
vlan0hwname=et0
vlan1hwname=et0
vlan2hwname=et0

Creating to separate networks

Create a virtual wireless network (wl0.1)

1. Wireless > Virtual Interfaces > Add.  Specify the basic wireless settings.  For the network configuration, choose bridged.  Click Save.
2. Wireless > Wireless Security > Virtual Interface wl0.1.  Specify the security settings.  Click Apply Settings, to save and apply the changes.

Create a virtual local area network (vlan3)

nvram set vlan3hwname=et0       # VLAN3 is enabled
nvram set vlan1ports="3 4 8*"   # assign LAN1/LAN2 to VLAN1
nvram set vlan3ports="1 2 8*"   # assign LAN3/LAN4 to VLAN3
nvram set port4vlans="1 18 19"  # LAN1 is part of VLAN1 (GUI only)
nvram set port3vlans="1 18 19"  # LAN2 is part of VLAN1 (GUI only)
nvram set port2vlans="3 18 19"  # LAN3 is part of VLAN3 (GUI only)
nvram set port1vlans="3 18 19"  # LAN4 is part of VLAN3 (GUI only)
nvram commit
reboot

Bridge vlan3 and wl0.1 (br1)

1. Bridge the vlan3 and wl0.1 interfaces together as br1
   • Setup > Networking > Bridging > Create Bridge > Add.  Enter br1 in the first field and click Apply Settings.
   • Setup > Networking > Bridging > Create Bridge > For br1 enter a private IP address and subnet mask.  E.g. 10.0.4.1 and 255.255.255.0.  Click Apply Settings.
   • Setup > Networking > Assign to bridge > Add.  Select br1, interface vlan3 (LAN3 and LAN4) and click Apply Settings.
   • Setup > Networking > Assign to bridge > Add.  Select br1, interface wl0.1 (the virtual wireless interface) and click Apply Settings.
2. Configure the DHCP server for br1
   • Setup > Networking > DHCPD > Multiple DHCP Server > Add.  Select br1 and fill in the first m maximum number of DHCP addresses and lease time in minutes.  E.g. 200, 50 and 1440.  Click Apply Settings.

Separate the networks

iptables -I FORWARD -i br0 -o br1 -m state --state NEW -j DROP
iptables -I FORWARD -i br1 -o br0 -m state --state NEW -j DROP

iptables -I INPUT -i br1 -m state --state NEW -j DROP
iptables -I INPUT -i br1 -p udp --dport 67 -j ACCEPT
iptables -I INPUT -i br1 -p udp --dport 53 -j ACCEPT
iptables -I INPUT -i br1 -p tcp --dport 53 -j ACCEPT

Test

• remote access, providing remote users access to a private network, and
• site-to-site, connecting a remote network to a private network.

Before you start

Writable storage

1. Insert the memory stick into any available USB port on the back of your DD-Wrt router.
2. In the WebGUI:
   • Administration > JFFS2 Support > Enable = true, click Save
   • Wait a few seconds, the click Apply, wait a few seconds
   • Administration > JFFS2 Support > Clean JFFS = true, click Apply
   • Wait for the router to finish formatting the memory stick and brings up the WebGUI again.
   • Administration > JFFS2 Support > Clean JFFS = true, click Save
3. Reboot the router (just to make sure)
4. The memory stick will auto mount at /jffs.

Certificates and keys

1. Copy the easy-rsa directory and initialize:

   cp -R /usr/share/openvpn/easy-rsa/2.0 ~/openvpn-ca  # easy-rsa may be elsewhere
   cd ~/openvpn-ca
   vi vars  # update the fields at the end of the file 
   . ./vars
   ./clean-all

2. While we're at it, assign extended key usage that will allow you to use the client certificates for other purposes such as code signing and email.

   vi .`./whichopensslcnf`
   # under [ usr_cert ], extend the extendedKeyUsage parameter to
   # "clientAuth, emailProtection, codesigning"

   later if so desired, you can convert client certificates to PKCS12 format using

   openssl pkcs12 -export -in client.crt -inkey client.key \
              -out client.p12 -certfile ca.crt

   You can then import the certificates in windows by running "certmgr.msc" and importing the ca.crt to the Trusted Root Certificate Authority, and the client.p12 to the Personal certificates.

3. Create a certifying authority certificate and corresponding secret key.  Use your name followed by CA as the common name:

   ./build-ca

4. Create Diffie Hellman parameters and shared secret key for tls-auth:

   ./build-dh
   openvpn --genkey --secret keys/ta.key

5. Show certificate details:

   openssl -x509 -in keys/rtr2.crt --noout -text

Real-time clock

• Setup > Basic Setup > Time Settings.  For my locality the settings are:
  • Time Zone = UTC-08:00
  • Summer Time = 2nd Sun Mar - first Sun Nov
  • Server IP/Name = 0.north-america.pool.ntp.org

Domain name

• Setup > DDNS > Dynamic Domain Name System (my personal favorite is afraid.org)
  • DDNS Service = freedns.afraid.org
  • Host Name = yourhostname,hash (the hash value can be obtained as described in DD-Wrt and freedns.afraid.org).

SSH and emacs

emacs /rtr:/jffs/etc/config/rtr-server.wanup

Routing versus Bridging

• Routing uses the kernel device TUN to simulate a network layer device.  It operates at the network layer where it handles IP packets.  As a result, it:
  • has a low overhead, because it does not support broadcasts or require Ethernet headers;
  • for IPv6, OpenVPN version >=2.3 is required.
• Bridginguses the kernel device TAP to simulates a link layer device.  It operates at the link layer and handles Ethernet frames.  Consequently it:
  • supports non-IP based traffic;
  • supports Windows network neighborhood discovery without using WINS;
  • broadcasts and Ethernet headers cause overhead (for examples, you need to tell DHCP server not to respond to request coming over TAP).

Routing example: Site-to-Site

• rtr, the server, with
  • WAN address rtr.yourdomain.com
  • LAN network 10.0.1.0/24
• rtr2, the client.
  • LAN network 10.0.2.0/24

Certificates

• On the Linux host, create certificates and corresponding secret keys for the server and client.

  ./build-key-server rtr-server # common name = rtr, no passwd
  ./build-key        rtr2       # common name = rtr2, no passwd

OpenVPN Server

• From the Linux host, copy the certificates/keys files to /jffs/etc/openvpn on the server.

  ssh rtr mkdir -p /jffs/etc/config
  ssh rtr mkdir -p /jffs/etc/openvpn/ccd
  scp ca.crt dh1024.pem ta.key rtr-server.crt rtr-server.key rtr:/jffs/etc/openvpn/

• Create a startup script /jffs/etc/openvpn/config/rtr-server.wanup on the server.  Make the script executable (chmod 755).  DD-Wrt will call this script each time the WAN link comes up.

  #!/bin/sh
  
  DEV=tun0
  PORT=1194
  PROTO=udp
  
  BASE=$(basename $0)
  NAME=${BASE%\.*}
  TMP=/tmp/$NAME
  PID=$TMP/pid
  LOG=$TMP/log
  #LOG=/dev/null
  DIR=$(dirname $0)/../openvpn
  
  [ -d $TMP ] || mkdir -p $TMP
  
  if [ -e $PID ] ; then
      kill -0 `cat $PID`
      if [ $? -eq 1 ] ; then
  	rm $PID  # remove false PID
      fi
  fi
  
  if [ -e $PID ] ; then
      kill -HUP `cat $PID`  # restart
  else
      rm $PID
      ln -s /usr/sbin/openvpn $TMP/openvpn
      $TMP/openvpn \
  	--daemon --writepid $PID --log-append $LOG \
  	--cd $DIR --config $NAME.ovpn \
  	--dev $DEV --port $PORT --proto $PROTO \
  	--up "$DIR/$NAME.helper $DEV $PORT $PROTO up" \
  	--down "$DIR/$NAME.helper $DEV $PORT $PROTO down" \
  	--ifconfig-pool-persist $TMP/ip-pool 86400
  fi

• Create an helper script /jffs/etc/openvpn/rtr-server.helper on the server. Make the script executable (chmod 755).

  #!/bin/sh
  DEV=$1
  PORT=$2
  PROTO=$3
  case "$4" in
      'up')
          iptables -I INPUT -p $PROTO --dport $PORT -j ACCEPT
          iptables -I INPUT   -i $DEV -j ACCEPT
          iptables -I FORWARD -i $DEV -j ACCEPT
          iptables -I FORWARD -o $DEV -j ACCEPT
  	;;
      'down')
          iptables -D INPUT -i $DEV -j ACCEPT
          iptables -D INPUT -p $PROTO --dport $PORT -j ACCEPT
          iptables -D FORWARD -i $DEV -j ACCEPT
          iptables -D FORWARD -o $DEV -j ACCEPT
  	;;
      *)
  	exit 1
  esac
  exit 0

• Create the configuration file /jffs/etc/openvpn/rtr-server.ovpn on the server

  server 10.0.3.0 255.255.255.0
  ca ca.crt
  cert rtr-server.crt
  key rtr-server.key
  dh dh1024.pem
  tls-auth ta.key 0
  tls-server
  keepalive 10 120
  cipher bf-cbc
  auth sha1
  mtu-disc yes
  topology subnet
  fast-io
  verb 4
  mute 5
  management 127.0.0.1 5002
  management-log-cache 50
  push "route 10.0.1.0 255.255.255.0"
  client-config-dir ccd                  # run client script matching CN
  route 10.0.2.0 255.255.255.0 10.0.3.1  # kernel to OpenVPN server
  client-to-client

• Create the client specific configuration file /jffs/etc/openvpn/ccd/rtr2 on the server

  iroute 10.0.2.0 255.255.255.0  # OpenVPN server to remote clients

• Start the OpenVPN server

  /jffs/etc/config/rtr-server.wanup

• See how it is going.  Note that you can also use the WebGUI (Status > OpenVPN) to inspect the OpenVPN log messages.

  more /tmp/rtr-server/log  # a treasure trove of debug information
  netstat -lu               # should be listening on port 1194
  iptables -nvL             # INPUT chain should have port 1194 open

OpenVPN Client

• From the Linux host, copy the certificates/keys files to /jffs/etc/openvpn

  ssh rtr2 mkdir -p /jffs/etc/config
  ssh rtr2 mkdir -p /jffs/etc/openvpn
  scp ca.crt ta.key rtr2.crt rtr2.key rtr2:/jffs/etc/openvpn/

• Create a startup script /jffs/etc/openvpn/config/rtr2-to-rtr.wanup on the server.  Remember to make the script executable (chmod 755).  DD-Wrt will call this script each time the WAN link comes up.

  #!/bin/sh
  
  DEV=tun0
  PORT=1194
  PROTO=udp
  
  BASE=$(basename $0)
  NAME=${BASE%\.*}
  TMP=/tmp/$NAME
  PID=$TMP/pid
  LOG=$TMP/log
  #LOG=/dev/null
  DIR=$(dirname $0)/../openvpn
  
  [ -d $TMP ] || mkdir -p $TMP
  
  if [ -e $PID ] ; then
      kill -0 `cat $PID`
      if [ $? -eq 1 ] ; then
  	rm $PID  # remove false PID
      fi
  fi
  
  if [ -e $PID ] ; then
      kill -HUP `cat $PID`  # restart
  else
      rm $PID
      ln -s /usr/sbin/openvpn $TMP/openvpn
      $TMP/openvpn \
  	--daemon --writepid $PID --log-append $LOG \
  	--cd $DIR --config $NAME.ovpn \
  	--dev $DEV --port $PORT --proto $PROTO \
  	--up "$DIR/$NAME.helper $DEV up" \
  	--down "$DIR/$NAME.helper $DEV down"
  fi

• Create an helper script /jffs/etc/openvpn/rtr2-to-rtr.helper on the server. Remember to make the script executable (chmod 755).

  #!/bin/sh
  DEV=$1
  case "$2" in
      'up')
          iptables -I INPUT   -i $DEV -j ACCEPT
          iptables -I FORWARD -i $DEV -j ACCEPT
          iptables -I FORWARD -o $DEV -j ACCEPT
  	;;
      'down')
          iptables -D INPUT -i $DEV -j ACCEPT
          iptables -D FORWARD -i $DEV -j ACCEPT
          iptables -D FORWARD -o $DEV -j ACCEPT
  	;;
      *)
  	exit 1
  esac
  exit 0

• Create the configuration file /jffs/etc/openvpn/rtr2-to-rtr.ovpn on the client

  client
  remote rtr.yourdomain.com
  ns-cert-type server
  ca ca.crt
  cert rtr2.crt
  key rtr2.key
  tls-auth ta.key 1
  tls-client
  cipher bf-cbc
  auth sha1
  resolv-retry infinite
  nobind
  persist-key
  persist-tun
  mtu-disc yes
  fast-io
  verb 4
  mute 5
  management 127.0.0.1 5001
  management-log-cache 50

• Start the OpenVPN client

  /jffs/etc/config/rtr2-to-rtr.wanup

• See how things are going.  Note that you can also use the WebGUI (Status > OpenVPN) to inspect the OpenVPN log messages.

  more /tmp/rtr2-to-rtr/log

Bridging example: Remote Access

• rtr2, the server with:
  • LAN network 10.0.2.0/24
  • WAN address rtr2.yourdomain.com
• client, connecting from a public IP address, running either
  • Windows 7 x64 with OpenVPN GUI >=2.1.3 installed, or
  • Mac OS X with  Tunnelblick >=3.2.8  installed.

Certificates

• On the Linux host, create certificates and corresponding secret keys for the server and clients.

  ./build-key-server rtr2-server  # common name = rtr2, no passwd
  ./build-key        username1    # common name = username1, no passwd
  ./build-key        username2    # common name = username2, no passwd

OpenVPN Server

• From the Linux host, copy the certificates/keys files to /jffs/etc/openvpn on the server.

  ssh rtr mkdir -p /jffs/etc/config
  ssh rtr mkdir -p /jffs/etc/openvpn/ccd
  scp ca.crt dh1024.pem ta.key rtr-server.crt rtr-server.key rtr:/jffs/etc/openvpn/

• Create a startup script /jffs/etc/openvpn/config/rtr2-server.wanup on the server. Make the script executable (chmod 755). DD-Wrt will call this script each time WAN link comes up.

  #!/bin/sh
  
  BR=br0
  DEV=tap0
  ETHDEV=eth0
  PORT=1194
  PROTO=udp
  
  BASE=$(basename $0)
  NAME=${BASE%\.*}
  TMP=/tmp/$NAME
  PID=$TMP/pid
  LOG=$TMP/log
  #LOG=/dev/null
  DIR=$(dirname $0)/../openvpn
  
  [ -d $TMP ] || mkdir -p $TMP
  echo "$(date) $NAME: WAN up" >$LOG
  
  if [ -e $PID ] ; then
      kill -0 `cat $PID`
      if [ $? -eq 1 ] ; then
  	rm $PID  # remove false PID
      fi
  fi
  
  if [ -e $PID ] ; then
      kill -HUP `cat $PID`  # restart
  else
      rm $PID
  
      ln -s /usr/sbin/openvpn $TMP/openvpn
      $TMP/openvpn \
  	--daemon --writepid $PID --log-append $LOG \
  	--cd $DIR --config $NAME.ovpn \
  	--dev $DEV --port $PORT --proto $PROTO \
  	--up "$DIR/$NAME.helper $BR $DEV $PORT $PROTO up" \
  	--down "$DIR/$NAME.helper $BR $DEV $PORT $PROTO down" \
  	--ifconfig-pool-persist $TMP/ip-pool 86400
  fi

• Create an helper script /jffs/etc/openvpn/rtr2-server.helper on the server. Make the script executable (chmod 755). Note that the tap interface will get a random MAC address and the bridge (br0) picking up the lowest address.  This confuses Windows Network Discovery in Windows 7, triggering a "Set Network Location" dialog.  To prevent this, you can take the last random MAC address and reuse it for subsequent tap interfaces.  (More details here.)

  #!/bin/sh
  BR=$1
  DEV=$2
  PORT=$3
  PROTO=$4
  case "$5" in
      'up')
  	#ifconfig $DEV hw ether enter_your_last_mac_address
          ifconfig $DEV 0.0.0.0 promisc up 
          brctl addif $BR $DEV 
          iptables -I INPUT -p $PROTO --dport $PORT -j ACCEPT
  	iptables -I INPUT   -i $DEV -j ACCEPT
  	iptables -I FORWARD -i $DEV -j ACCEPT
  	iptables -I FORWARD -o $DEV -j ACCEPT
  	;;
      'down')
  	brctl delif $DEV
  	ifconfig $DEV down
  	iptables -D INPUT -i $DEV -j ACCEPT
  	iptables -D INPUT -p $PROTO --dport $PORT -j ACCEPT
  	iptables -D FORWARD -i $DEV -j ACCEPT
  	iptables -D FORWARD -o $DEV -j ACCEPT
  	;;
      *)
  	exit 1
  esac
  exit 0

• Create the configuration file /jffs/etc/openvpn/rtr2-server.ovpn on the server. Note that port 5002 is used by the /etc/openvpn*.shscripts.

  server-bridge 10.0.2.1 255.255.255.0 10.0.2.150 10.0.2.159
  ca ca.crt
  cert rtr2-server.crt
  key rtr2-server.key
  dh dh1024.pem
  tls-auth ta.key 0
  keepalive 10 120
  cipher bf-cbc
  auth sha1
  mtu-disc yes
  topology subnet
  client-to-client
  push "route 10.0.1.0 255.255.255.0 10.0.2.1" # optional across other VPN
  fast-io
  verb 4
  mute 5
  management 127.0.0.1 5002
  management-log-cache 50

• Start the OpenVPN server

  /jffs/etc/config/rtr2-server.wanup

• See how it is going. Note that you can also use the WebGUI (Status > OpenVPN) to inspect the OpenVPN log messages.

  more /tmp/rtr2-server/log  # a treasure trove of debug information
  netstat -lu                # should be listening on port 1194
  iptables -nvL              # INPUT chain should have port 1194 open

OpenVPN Server (using WebGUI)

• Copy the certificates/keys files.  Remember to limit access to the key files (chmod 600).
  • ca.crt
  • rtr2-server.crt
  • rtr2-server.key
  • dh1024.pem
  • ta.key
• Services > VPN > OpenVPN Server.  These values will be used to create the configuration file /tmp/openvpn/openvpn.conf
  • Start OpenVPN Server = enable
  • Start Type = WAN up (after domain resolver is up)
  • Switch Server config = new Style
  • Pool IP = 10.0.2.150 .. 10.0.2.159
  • Gateway = 10.0.2.1
  • Netmask = 255.255.255.0
  • Port = 1194
  • Tunnel Protocol = UDP
  • Encryption Cipher = Blowfish CBC
  • Hash Algorithm = SHA1
  • Advanced Options = disable
  • The Cert, Key fields are left blank.  Instead use the Additional Config field to refer to the files on the USB stick  (see OpenVPN with key and certificate files via WebGUI).

    cert /jffs/rtr2.crt
    ca /jffs/ca.crt
    key /jffs/rtr2.key
    dh /jffs/dh2048.pem
    tls-auth /jffs/ta.key 0
    push "route 10.0.2.0 255.255.255.0"

OpenVPN Client, running Windows 7

• Use explorer to show the directory "C:\Program Files (x86)\OpenVPN\config\"
  • Populate the directory with the certificate and key files from the Linux host:
    • ca.crt
    • username1.crt
    • username1.key
    • ta.key
  • Create the configuration file rtr2.ovpn in that same directory

    remote rtr2.yourdomain.com 1194
    client
    ca ca.crt 
    cert username1.crt 
    key username1.key 
    tls-auth ta.key 1
    ns-cert-type server
    dev tap
    proto udp 
    nobind 
    resolv-retry infinite 
    persist-key 
    persist-tun 
    remote-cert-tls server 
    float
    script-security 2
    cipher BF-CBC
    auth SHA1
    verb 3
    mute 5

• With OpenVPN running, right-click on its icon in the task area (bottom right) > connect > rtr2.

OpenVPN Client, running OS X

• Create folder rtr2.yourdomain.com on your Desktop.  (details can be found in the wiki)
  • Copy the certificate/key files to that folder
    • ca.crt
    • username2.crt
    • username2.key
    • ta.key
  • In that folder, create configuration file rtr2.ovpn

    remote rtr2.yourdomain.com 1194  # update me
    client
    ca ca.crt 
    cert username2.crt 
    key username2.key 
    tls-auth ta.key 1
    ns-cert-type server
    dev tap
    proto udp 
    nobind 
    resolv-retry infinite 
    persist-key 
    persist-tun 
    remote-cert-tls server 
    float
    script-security 2
    cipher BF-CBC
    auth SHA1
    verb 3
    mute 5

• Append the extension .tblk to the folder name. This will change the folder icon into a Tunnelblick VPN Configuration.
• Double-click the folder's new icon to install it. Choose private configuration when asked.

Preventing Double NAT

DHCP Lease Time

iptables -I input -p udp --dport 68 -j ACCEPT

History

Instructions

Stack

Entering and displaying complex numbers

Start

The program consist of two parts. The first part labeled "CA" fits in a mere 5 registers of main memory (after removing the GTO "X"). It handles the initialization and then jumps to the second part labeled "X". This second part is intended to be placed in extended memory, but can also be used in main memory.

Start the program with XEQ "CA". This clears the complex stack and initializes relevant flags and angular mode. The program will display the top of the complex stack (Z1), and halt at line 13 in "X" and will also return to this place after each operation. At this point, you have the option of enter an operand.

Operations

Pressing COMPLEX will activate the GETKEY keyboard. The program waits of a keystroke, and uses the key code to call the corresponding operation.

Most operation require one or two operand from the stack. Exceptions to this rule are functions that take a real number argument (Zⁿ, Z^1/n, n^Z, VIEWZn, Z1 Zn) and mode switches (RECT, POL) and prefixes (g, ARC, HYP).

For the function Z^1/n, the above is also valid, but this function does not immediately return to the normal halting point. Also, n must be a positive integer. Instead, this operation shows all the n^th roots of the complex number in Z1. The ALPHA annunciator is used to indicate that more roots are to follow. When the operation is finished displaying the roots, the first root will be available as Z1 on the complex stack (and X,Y on the regular stack).

The use of the prefixes ARC and HYP is similar to the use of the shift key, with flag 03 and 04 acting as the annunciator for ARC and HYP respectively. They can be used in any combination to denote and execute the desired function. The state of these flags only affects trigonometric operations.

Note that operations can anywhere between 1 and take up to 6 seconds to execute.

Entering operands

Depending on the operation, the operand can be a real or complex number. Real numbers must always be in the X register before pressing COMPLEX. Complex numbers can either be entered on the regular stack as an X,Y pair, or taken from the complex stack.

The functions VIEWZn and Z1 Zn require an integer number between 0 and the complex stack size (default 6). The functions RECT and POL will also recall Z1 into the normal stack, so that it can be shown correctly in the new mode.

Error handling

The program has no accommodation (apart from the SF 25) at line 40 in "X" to avoid error halts. This implies that attempts to divide by zero, take the log of zero, etc. will usually cause a DATA ERROR halt. Pressing INIT lets the program return to its normal halting point at line 13 in "X".

Extended memory

As mentioned earlier, the second part of the program can be placed in extended memory. To do so, save it on 4 magnetic cards and then load it into x-memory. Note that it is not possible to change the program while in extended memory, because once the program executes in x-memory, the bytes near the GTO and XEQ instructions will be changed to match to the corresponding LBL address. This would cause the check sum of the fill to mismatch. For more details on running a program in extended memory, refer to the book "Extend your HP-41" [6].

Examples

1. Calculate: (2 + 3j).(7 - 6j) + (4 + 5j)

   input	display
   XEQ "CA"	0.00E0+0.00E0J
   3 ENTER	3.000
   2 COMPLEX ENTER	2.00E0+3.00E0J
   6 CHS
   ENTER	-6.000
   7 COMPLEX ENTER	7.00E0-6.00E0J
   5 ENTER	5.000
   4 COMPLEX +	11.0E0-1.00E0J
   COMPLEX *	25.0E0+31.0E0J
   X Y	31.000
   X Y	25.000

   The answer is 25 + 31j
2. Calculate: (3 + 4.5j)^5

   input	display
   4.5 ENTER	4.500
   3 COMPLEX ENTER	3.00E0+4.50E0J
   5 COMPLEX ZN	926.E0-4.53E3J
   X Y	-4.533 03
   X Y	926.4 00

   The answer is 926.4 - -4533j:
3. Show what is in LASTZ1

   input	display
   COMPLEX LASTZ1	3.00E0+4.50E0J

   Note that the complex number is saved, not the power 5
4. Calculate: 1 / (3, Φ40°)

   input	display
   COMPLEX POL	5.41E0<56.3E0
   40 ENTER	40.00 00
   3 COMPLEX 1/Z	333.E-3<-40.0E0

   The answer is 0.3333 Φ -40º :
5. Calculate: asinh(8 - 5j)

   input	display
   COMPLEX RECT	255.E-3-214.E-3J
   5 CHS
   ENTER	-5.000 00
   8 COMPLEX ARC
   HYP SIN	2.94E0-556.E-3J

   The first answer is still there

   input	display
   5 COMPLEX Z1 Zn	94E0-556.E-3J

   :
6. Calculate the the 3 cube roots of 5 + 3j

   input	display
   3 ENTER	3.000 00
   5 COMPLEX VIEW	5.00E0+3.00E0J
   3 COMPLEX Z1/n	1.77E0+322.E-3J (alpha)
   COMPLEX	-1.16E0+1.37E0J (alpha)
   COMPLEX	-606.E-3-1.69E0J (alpha)
   COMPLEX	1.77E0+322.E-3J

   :
7. Calculate: csch(1 + 2j)

   input	display
   2 ENTER	2.000 00
   1 COMPLEX HYP CSC	-489.E-3+1.40E0J

   :
8. Calculate: ln(4 + 5j) + (3 - 2j)^{(2 - 3j)}

   input	display
   5 ENTER	5.000 00
   4 COMPLEX LN	1.86E0+896.E-3J
   2 CHS
   ENTER	-2.000 00
   3 COMPLEX ENTER	3.00E0-2.00E0J
   3 CHS
   ENTER	-3.000 00
   2 COMPLEX Z2Z1	-1.79E-3-3.19E-3J
   COMPLEX +	1.85E0+893.E-3J

   :
9. Calculate: 2^(3+4j)

   input	display
   4 ENTER	4.000 00
   3 COMPLEX ENTER	3.00E0+4.00E0J
   2 COMPLEX NZ	-7.46E0+2.89E0J

   The number N must always be the last one that is entered. :

Tweaks

• The size of the complex stack can be adjusted in line 008 of program "CA".
• If flag 14 is set when calling "CA", the stack will not be cleared, which may be useful if you left "CA" temporarily and want to continue. This however assumes that the data registers used for the complex stack are left undisturbed.
• The program uses flag 22 "numeric entry" to determine if there is a new entry in X,Y. If there is a numeric entry, the number is first pushed onto the complex stack, respecting stack lift status. This implies that you can clear flag 22 manually if you have made an accidental digit entry and still want the next operation to be performed on the current Z1.
• Operands that require a real number input, will always take that number from the X register, new entry or not. If stack lift is disabled, the stack will first be shifted down, so the function will be performed on Z2. This is done, so that you may have ENTER 'ed the complex number on which you want the function to be executed, and without the shift down there would be left a superfluous copy of that number on the stack.

Program listing

1. Requires
   • X-Functions module on the HP-41cv
2. Part 1 should be placed in main memory and is available as
   • source code
   • raw code for the V41 emulator
   • bar code for the HP Wand (HP82153A)
3. Part 2, can be placed in either main or extended memory. When placed in extended memory, the instruction GTO "X" should be removed. This part is available as
   • source code
   • raw code for the V41 emulator
   • bar code for the HP Wand
4. The keyboard overlay is available as
   • image, scaled down by 98% so when printed on 4×6", it typically comes out as true-size.
   • inverted image, scaled down by 98% so when printed on 4×6", it typically comes out as true-size.

part 1

; The program consists of two parts.  The part listed below should be in main
; memory.  The other part (listed in CA300xm.txt) can be placed in either main
; or extended memory.  When placed in extended memory, THE INSTRUCTION GTO "X"
; SHOULD BE REMOVED.
;
; Before placing the second part in XM, the program should be PACKed
; and run in RAM.  This should be done to compile all the GTO's and
; XEQ's.  If this is not done one will see CHKSUM ERR when trying to
; download this program into RAM. [9]

1	LBL "CA"
2	CF 03		; clear prefix flags (ARC, HYP)
3	CF 04
4	RAD
5	FS? 14		; if the "do not clear stack" flag is set
6	GTO 00		;   then jump to LBL 00,
7	SIZE?		;   else if needed extended the # of data registers
8	6
9	STO 00
10	ST+ X
11	3
12	+
13	X>Y?
14	PSIZE
15	CLX
16	STO 01		; clear LASTZ
17	STO 02
18	LBL 00
19	GTO "X"		 ; REMOVE THIS LINE when LBL "X" in X-memory !!
20	"\8D\BE"
21	RCL M
22	STO b		; jump to "X" in extended memory at address 0x8DBE
22	END

part 2

• Stack and alpha registers:
  • The program uses all registers
• Data registers:
  • R00, depth of complex stack (default value is 6)
  • R01, real part of LASTZ1
  • R02, imaginary part of LASTZ1
  • R03, real part of complex number Z1
  • R04, imaginary part of complex number Z1
  • :
  • R13, real part of complex number Z6
  • R14, imaginary part of complex number Z6
  • Note that the internal format of the complex stack is always rectangular.
• Flags:
  • flag 00, "POL", when set indicates Polar notation (POL), otherwise rectangular notation (RECT)
  • flag 02, "no stack lift", when set disables the stack lift
  • flag 03, "ARC", when set indicates inverse trigonometric operation (ARC)
  • flag 04, "HYP", when set indicates hyperbolic operation (HYP)
  • flag 10, "alt operation", allows similar operations to reuse code
  • flag 14, "clipped corner", is used for all but magnetic cards. During initialization it indicates "do not clear stack"; during keyboard fetching it indicates more key strokes need to follow; and during triogonometry operations, indicates inverse operation.
  • flag 22, "keyboard input", set when numeric input is entered from the keyboard, cleared on power cycle. [7]
  • flag 25, "ignore error", when set, ignores improper operations (like div by zero) or range errors.
  • flag 30, used for "always false" test. Used to negate prior test. [7]
  • flag 47, "shift set", used internally in shifted operations.
  • flag 44-46, cleared as a side effect of showing the "shift" annunciator
  • flag 48-55, cleared as a side effect of showing the "shift" annunciator
• Legend:
  • (x + y.j), complex number held on the regular stack
  • X register holds the real part (x)
  • Y register holds the imaginary part (y)
  • (M . e^j.phi), complex number in polar notation

; INITIALIZE AND MAIN LOOP
;
; An infinite loop to fetch a keystroke identifying the operation to be
; executed.  The "shift" key causes the "shift" status to be toggled, for all
; other keys the LBL that matches the key code will be called (or keycode+5 if
; "shift" was active).
;
; called      : from "CA" in main memory, or
;               in response to [CINIT] keycode (labeled [ON] on keyboard)
; on entry    : when flag 14 is set, the complex stack will not be cleared
; on exit     : value of Z1 shown.  Also available as X,Y.

1	LBL "X"
2	RDN
3	FC?C 14		; if the "do not clear stack" flag is not set
4	XEQ 48		;   then clear the complex stack

5	LBL 01		; [CINIT] operation
6	CF 10
7	CF 22
8	CF 25
9	FS? 00
10	R-P
11	XEQ 10		; display complex number (x + y.j)
12	STOP
13	ENTER^
14	LBL 02
15	CLX
16	GETKEY		; wait for an operation keycode
17	X=0?
18	GTO 02
19	31
20	X#Y?		; if not the "shift" key
21	GTO 00		;   then handle that operation
22	R^  		;   else update the shift annunciator
23	R^
24	"\01\00"
25	FS? 47
26	CLA
27	RCLFLAG
28	ASTO d
29	STOFLAG
30	AOFF
31	GTO 02

32	LBL 00	   	; handle operation associated with a keycode
31	CLX
34	5
35	FC? 47		; if "shift was active"
36	CLX 		;   then increment key code by 5
37	+
38	RDN
39	CLD
40	SF 25
41	XEQ IND T	; call the corresponding operation
42	FC?C 14
43	GTO 01
44	ENTER^
45	GTO 02

; TOGGLE [ARC] MODIFIER, for ASIN, ACOS, ATAN

46	LBL 11		; [ARC], key label [sigma+]
47	FC?C 03
48	SF 03
49	SF 14		; indicate "more key strokes to follow"
50	RTN

; TOGGLE [HYP] MODIFIER, for SINH, COSH and TANH

51	LBL 16		; [HYP], key label [sigma-]
52	FC?C 04
53	SF 04
54	SF 14		; indicate "more key strokes to follow"
55	RTN

; SWITCH BETWEEN POLAR AND RECTANGULAR NOTATION

56	LBL 68		; [RECT], key label [P>R]
57	CF 00
58	GTO 00
59	LBL 69		; [POL], key label [R>P]
60	SF 00
61	LBL 00
62	RCL 04		; get Z1 from the complex stack as (x + y.j)
63	RCL 03
64	RTN

; COMPLEX RECIPROCAL (1/Z)
;
; on entry : Z in X,Y registers in the form (x + y.j)
; on exit  : the result is stored as Z1 on the complex stack
;    	     the result is stored in X,Y in the form (x + y.j)
;	     LASTZ1 holds a copy of the operation operand Z

65	LBL 12	    	; [1/Z] operation

66	XEQ 09		; push (x + y.j) onto complex stack and update LASTZ1
67	XEQ 31		; compute (x + j.y) = 1 / (x + j.y)
68	GTO 03		; copy (x + y.j) to complex stack, and return

; COMPLEX ENTER^
;
; on entry : Z in X,Y registers in the form (x + y.j)
; on exit  : Z is pushed up the complex stack as Z1 and Z2
;    	     Z is X,Y in the form (x + y.j)
;    	     LASTZ1 is unchanged

69	LBL 41	        ; [CENTER^] operation

70	XEQ 04		; push (x + y.j) onto complex stack
71	XEQ 11		; move complex stack up, Z1 > Z2 > Z3 > Z4 > Z5 > Z6
72	SF 02		; "no stack lift"
73	RTN

; COMPLEX CLEAR STACK
;
; on entry : n/a
; on exit  : Z1..Z6 on the complex stack are set to (0 + 0j)
;    	     LASTZ1 is unchanged

74	LBL 48	        ; [CCLST] operation

75	RCL 00
76	ISG X
77	""
78	ST+ X
79	 E3
80	/
81	3
82	+
83	.
84	LBL 36
85	STO IND Y
86	ISG Y
87	GTO 36
88	CF 02		; no "no stack lift"
89	CLST
90	RTN

; COMPLEX CHANGE SIGN AND COMPLEX CONJUGATE (Complement)
;
;     -(x + y.j) = -x - y.j  (change sign)
;     (x + y.j)* =  x - y.j  (conjugate)
;
; on entry : Z in X,Y registers in the form (x + y.j)
; on exit  : the result is stored as Z1 on the complex stack
;    	     the result is stored in X,Y in the form (x + y.j)
;	     LASTZ1 holds a copy of the operation operand Z

91	LBL 42		; [CHSZ] operation
92	SF 10
93	LBL 47		; [COMPLZ] operation

94	XEQ 04		; push (x + y.j) onto complex stack
95	FS? 10
96	CHS
97	X<>Y
98	CHS
99	X<>Y
100	GTO 03		; copy (x + y.j) to complex stack, and return

; CLEAR Z1
;
; on entry : Z in X,Y registers in the form (x + y.j)
; on exit  : Z is pushed up the complex stack as Z1 and Z2
;    	     Z is X,Y in the form (x + y.j)
;    	     LASTZ1 is unchanged

101	LBL 49	        ; [CLZ1] operation

102	XEQ 04		; push (x + y.j) onto complex stack
103	CLST
104	SF 02		; "no stack lift"
105	GTO 03		; copy (x + y.j) to complex stack, and return

; LAST Z1
;
; on entry : n/a
; on exit  : the operand from the last numeric operation (except CHSZ)
;              is pushed onto the complex stack
;    	     the operand from the last numeric operation (except CHSZ)
;              is stored in X,Y in the form (x + y.j)

106	LBL 88 	  	; [LASTZ1] operation

107	FS? 02
108	FS? 22		; if "no stack lift" or "input from keyboard"
109	XEQ 41		;   then perform ENTER^
110	CF 02
111	RCL 02		; LASTZ1
112	RCL 01
113	GTO 03		; copy (x + y.j) to complex stack, and return

; COMPLEX ADDITION AND SUBTRACTION
;
;     (z + t.j) + (x + y.j) = (x + z) + j.(y + t)
;     (z + t.j) - (x + y.j) = (x - z) + j.(y - t)
;
; on entry : if number was entered on the keyboard,
;              then (x + y.j) as entered in X,Y registers, and
;                   (z + t.j) from Z1 on the complex stack
;              else (x + y.j) from Z1 on the complex stack, and
;                   (z + t.j) from Z2 on the complex stack
; on exit  : the result is stored as Z1 on the complex stack
;    	     the result is stored in X,Y in the form (x + y.j)
;	     LASTZ1 holds a copy of (x + y.j)

114	LBL 51		; [C-] operation
115	SF 10
116	LBL 61		; [C+] operation

117	XEQ 07		; get two operands, as (x + j.y) and (z + j.t)
118	FS? 10
119	CHS
120	X<>Y
121	FS? 10
122	CHS
123	ST+ T
124	RDN
125	+
126	GTO 03		; copy (x + y.j) to complex stack, and return

; COMPLEX MULTIPLICATION AND DIVISION
;
;     Z2 * Z1 = (re1 + j.im1) * (re2 + j.im2) =
;             = (re1.re2 - im1.im2 ) + j.(im1.re1 + re1.im2)
;
;     Z2 / Z1 = Z2 * 1/Z1

127	LBL 81		; [C/] operation
128	SF 10
129	LBL 71		; [C*] operation

130	XEQ 07		; get two operands, as (x + j.y) and (z + j.t)
131	FS? 10		; if division
132	XEQ 31		;   then compute (x + j.y) = 1 / (x + j.y)
133	XEQ 00		; compute (x + j.y) * ( z + j.t)
134	GTO 03		; copy (x + y.j) to complex stack, and return

; COMPLEX POWER OF A COMPLEX NUMBER
;
;           (x+y.j)      z    -t.phi1    j.(z.phi1 + t.ln(r1))
;     (z+t.j)       =  r1  . e        . e
;
;   where:
;         r1   = sqrt(x^2+y^2)
;         phi1 = .... x + y.j ....????

135	LBL 17		; [Z2^Z1] operation

136	XEQ 07		; get two operands, as (x + j.y) and (z + j.t)
137	R^
138	R^
139	RAD
140	R-P
141	LN
142	XEQ 00		; compute (x + j.y) * ( z + j.t)
143	E^X
144	P-R
145	GTO 03		; copy (x + y.j) to complex stack, and return

; COMPLEX PARALLEL CIRCUIT, useful in network theory
;
;            Z1 . Z2
; Z1 // Z2 = -------    {for |Z1+Z2| <> 0}
;            Z1 + Z2

146	LBL 32		; [CPAR] operation
147	XEQ 07		; get two operands, as (x + j.y) and (z + j.t)
148	XEQ 31		; compute 1 / ( x + j.y)
149	R^
150	R^
151	XEQ 31		; compute 1 / ( x + j.y)
152	X<>Y
153	ST+ T
154	RDN
155	+
156	XEQ 31		; compute 1 / ( x + j.y)

; REPLACE Z1 with (x + y.j) ON COMPLEX STACK

157	LBL 03	    	; [PRGM] keycode
158	DEG		; switch to DEG mode
159	STO 03
160	X<>Y
161	STO 04
162	X<>Y
163	RTN

; MULTIPLY TWO COMPLEX NUMBERS subroutine
;
;     (x + y.j) * (z + t.j) = (x + j.y) * (z + j.im2) =
;                           = (x.z - y.t ) + j.(y.x + x.t)

164	LBL 00
165	STO L
166	R^
167	ST* L
168	X<> Z
169	ST* Z
170	R^
171	ST* Y
172	ST* Z
173	X<> L
174	+
175	X<> Z
176	-
177	RTN

; COMPLEX COMMON (base 10) and NATURAL (base e) LOGARITHM
;
;     ln(x + y.j) = ln(r) + j.phi
;
;     Z1
;       log(Z2) = ln(Z2) / ln(Z1)

178	LBL 14		; [LOG(Z)] operation
179	XEQ 08		; get operand, as (x + j.y) and update LASTZ
180	LN  		; x=ln(M1), y=phi1
181	GTO 00

182	LBL 15		; [LN(Z)] operation
183	XEQ 09		; push (x + y.j) onto complex stack and update LASTZ
184	 E		; x=1

185	LBL 00
186	RDN
187	RAD
188	R-P
189	LN
190	R^
191	ST/ Z
192	/
193	GTO 03		; copy (x + y.j) to complex stack, and return

; COMPLEX COMMON (base 10) and NATURAL (base e) EXPONENTIAL
;
;     (x + j.y)    x              x
;    e          = e .sin(y) + j.e .cos(y)

194	LBL 19		; [n^Z] operation
195	XEQ 08		; get operand, as (x + j.y) and update LASTZ
196	LN
197	GTO 00		; reuse part of  [E^Z] operation

198	LBL 20		; [E^Z] operation
199	XEQ 09		; push (x + y.j) onto complex stack and update LASTZ
200	 E

201	LBL 00
202	ST* Z
203	*
204	E^X
205	RAD
206	P-R
207	GTO 03		; copy (x + y.j) to complex stack, and return

; COMPLEX EXPONENTIATION WITH REAL EXPONENT n

208	LBL 18		; [Z^n] operation

209	XEQ 08		; get operand, as (x + j.y) and update LASTZ
210	RDN
211	R-P
212	R^
213	ST* Z
214	Y^X
215	P-R
216	GTO 03		; copy (x + y.j) to complex stack, and return

; COMPLEX ROOT OF REAL NUMBER n
;        __
;     Z1/         1/Z1
;     \/ Z2   = Z2
;        __
;     n /        1/n   j.(phi/n)
;     \/ Z    = M   . e

217	LBL 13		; [Z^1/n] operation

218	XEQ 08		; get operand, as (x + j.y) and update LASTZ
219	RDN
220	R-P
221	R^
222	1/X
223	Y^X
224	360
225	R^
226	ST/ T
227	ST/ Y
228	R^
229	R^
230	LBL 05
231	FC? 00
232	P-R
233	XEQ 10		; display complex number (x + y.j)
234	AON
235	STOP
236	FC? 00
237	R-P
238	R^
239	ST+ Z
240	RDN
241	DSE Z
242	GTO 05		; loop back to LBL 05
243	P-R
244	AOFF
245	GTO 03		; copy (x + y.j) to complex stack, and return

; COMPLEX SINE, COSECANT, COSINE AND SECANT
;
;     sin( x + j.y) = sin(x).cosh(y) + j.cos(x).sinh(y)
;     cos( x + j.y) = cos(x).cosh(y) - j.sin(x).sinh(y)
;     sinh(x + j.y) = cos(y).sinh(x) + j.sin(y).cosh(x)
;     cosh(x + j.y) = cos(y).cosh(x) + j.sin(y).sinh(x)
;     csc(x + j.y)  = 1 / sin( x + j.y)
;     sec(x + j.y)  = 1 / cos( x + j.y)
;     csch(x + j.y) = 1 / sinh(x + j.y)
;     sech(x + j.y) = 1 / cosh(x + j.y)
;
; Flags used:
;     flag 04, indicates [HYP]
;     flag 10, indicates [SIN], otherwise [COS]
;     flag 14, indicates inverse operation (CSC and COS, aka SIN^-1 and COS^-1)
;
; Reference:
;     http://en.wikipedia.org/wiki/Complex_number#Complex_analysis

246	LBL 28		; [CSC(Z)] operation
247	SF 14

248	LBL 23		; [SIN(Z)] operation
249	SF 10

250	LBL 29		; [SEC(Z)] operation
251	FC? 10
252	SF 14

253	LBL 24		; [COS(Z)] operation

254	XEQ 09		; push (x + y.j) onto complex stack and update LASTZ
255	FS?C 03		; ARC?
256	GTO 13
257	XEQ 00		; calculate cos/sin/cosh/sinh
258	ST* T
259	RDN
260	*
261	CHS
262	FC? 04		; HYP?
263	FS? 10		; SIN?
264	CHS
265	FC?C 04		; HYP?
266	FC? 10		; COS?
267	X<>Y
268	FS?C 14		; inverse operation?
269	XEQ 31		;   then compute Z1 = 1 / Z1
270	GTO 03		; copy (x + y.j) to complex stack, and return

; COMPLEX TANGENT AND COTANGENT, doesn't support ARC or HYP variations
;
;     tan(x + j.y) = sin(2.x)  / ( cosh(2.y) + cos(2.x) ) +
;                    sinh(2.y) / ( cosh(2.y) + cos(2.x) ) . j
;     cot(Z) = 1 / tan(Z)
;
; Flags used:
;     F03 indicates [ARC]
;     F04 indicates [HYP]
;     F14 indicates inverse operation (COT aka TAN^-1]

271	LBL 30		; [COT(Z)] operation
272	SF 14
273	LBL 25		; [TAN(Z)] operation
274	FS?C 03		; ARC?
275	GTO 02		;   UNSUPPORTED, jump back to main routine
276	FS?C 04		; HYP?
277	GTO 02		;   UNSUPPORTED, jump back to main routine
278	XEQ 09		; push (x + y.j) onto complex stack and update LASTZ
279	2		; multiply x and y by 2
280	ST* Z
281	*
282	XEQ 00		; calculate cos/sin/cosh/sinh (F04=0, F10=0)
283	R^
284	+
285	ST/ Z
286	/   		; answers is now as (x + y.j)
287	FS?C 14		; inverse operation?
288	XEQ 31		;   then compute Z1 = 1 / Z1
289	GTO 03		; copy (x + y.j) to complex stack, and return

; TRIGONOMIC OPERATIONS HELPER subroutine
;
; Call with:
;   complex number on the stack as (x + y.j).
;   F04 indicates [HYP]
;   F10 indicates [SIN], otherwise [COS]
;
; This operation returns:
;
;           | [HYP]    [HYP]
;	    | [SIN]    [COS]	[SIN]	[COS]
;     ------+----------------------------------
; re  y-reg | sin(y)   sin(y)   sin(x)  sin(x)
; re  z-reg | cosh(x)  sinh(x)  cosh(y) sinh(y)
;     ------+----------------------------------
; im  x-reg | cos(y)   cos(y)   cos(x)  cos(x)
; im  t-reg | sinh(x)  cosh(x)  sinh(y) cosh(y)
;
;            x     -x      2.x
;           e  -  e       e    -  1                    1
; sinh(x) = ---------  =  ---------  ,    csch(x) = -------
;                              x                    sinh(x)
;              2            2.e
;
;            x     -x      2.x
;           e  +  e       e    +  1                   1
; cosh(x) = ---------  =  ---------  ,    sech(x) = -------
;                              x                    cosh(x)
;               2           2.e
; Reference:
;     http://en.wikipedia.org/wiki/Hyperbolic_trig_operations

290	LBL 00
291	FS? 04		; HYP?
292	X<>Y		;
293	2
294	RCL Z
295	ST+ X
296	E^X-1
297	ST+ Y
298	R^
299	E^X
300	ST+ X
301	ST/ Z
302	/
303	FS? 10		; SIN? (not COS)
304	X<>Y		;
305	R^
306	RAD
307	SIN
308	R^
309	COS
310	RTN

; INVERSE TRIGONOMIC OPERATIONS, ARC and HYP-ARC
;
;     arcsin(x + y.j) = arcsin(b) + j.sign(y).ln(a + sqrt(a^2-1)
;     arccos(x + y.j) = arccos(b) - j.sign(y).ln(a + sqrt(a^2-1))
;     arccsc(Z)  =    arcsin(1/Z)
;     arcsec(Z)  =    arccos(1/Z)
;     arcsinh(Z) = -j.arcsin(j.Z)
;     arccosh(Z) =  j.arccos(Z)
;     arccsch(Z) =  j.arccsc(j.Z)
;     arcsech(Z) =  j.arcsec(Z)
;   where
;     a = ( sqrt( (x+1)^2 + y^2 ) + sqrt( (x-1)^2 + y^2) ) / 2
;     b = ( sqrt( (x+1)^2 + y^2 ) - sqrt( (x-1)^2 + y^2) ) / 2
;     sign(y) returns 1 when y>=0, othewise returns -1
;
; Flags used:
;     F04 indicates [HYP]
;     F10 indicates [SIN], otherwise [COS]
;     F14 indicates inverse operation (CSC and COS, aka SIN^-1 and COS^-1]
;
; Reference:
;     http://en.wikipedia.org/wiki/Inverse_trigonometric_operation

311	LBL 13
312	FS?C 14		; inverse operation?
313	XEQ 31		; compute Z1 = 1 / Z1
314	FS? 04		; HYP flag
315	FC? 10
316	GTO 00
317	X<>Y
318	CHS
319	LBL 00		; entered with Z1 as (x + y.j)
320	RCL X
321	 E
322	ST- Z
323	+
324	X^2
325	X<>Y
326	X^2
327	X<> Z
328	X^2
329	ST+ Z
330	+
331	SQRT
332	STO Z
333	X<>Y
334	SQRT
335	ST- Z
336	+
337	2
338	ST/ Z
339	/   		; X holds a;  Y holds b; Z holds y
340	ENTER^
341	X^2
342	SIGN
343	ST- L
344	X<> L
345	SQRT
346	+
347	LN
348	R^
349	SIGN
350	*
351	FC? 10
352	CHS
353	X<>Y
354	RAD
355	FS? 10
356	ASIN
357	FC? 10
358	ACOS		; Z1 (x + y.j) now holds the answer to simple ARCSIN or ARCCOS
359	FC?C 04
360	GTO 03		; we're done for non-HYP operations;
361	FS? 10		; proceed for for HYP or inverse-HYP
362	CHS
363	X<>Y
364	FC? 10
365	CHS
366	GTO 03		; copy (x + y.j) to complex stack, and return

; VIEW COMPLEX NUMBER Zn

367	LBL 89		; [VIEWZn] operation
368	RCL 00
369	X<Y?		; if n > complex stack depth, recall Z1 and return
370	GTO 14		; get (x + y.j) from complex stack, and return
371	SIGN
372	+
373	ST+ X
374	SIGN
375	CLX
376	RCL IND L	; recall imaginary part of Zn
377	DSE L
378	RCL IND L	; recall real part of Zn
379	FS? 00		; if notation selected
380	R-P 		;   then convert to polar notation
381	XEQ 10		; display complex number (x + y.j)
382	PSE 		; pause, but allow number input
383	GTO 14		; get (x + y.j) from complex stack, and return

; EXCHANGE COMPLEX STACK REGISTERS

384	LBL 21		; [Z1<>Z2] operation
385	XEQ 04		; push (x + y.j) onto complex stack
386	2
387	LBL 26		; [Z1<>Zn] operation
388	RCL 00
389	X<Y?
390	GTO 14		; get (x + y.j) from complex stack, and return
391	X<>Y
392	ST+ X
393	1.003002	; X register holds 1.003002; Y register holds 2.n,
394	CF 02		; no "no stack lift"
395	GTO 00		; perform register swap and return

; COMPLEX STACK ROLL, up or down
;
; Does not roll around
; Uses block rotate trick form PPC Journal V10N3p15a

396	LBL 22		; [CR^] operation
397	SF 10
398	LBL 27		; [CRDN] operation

399	XEQ 04		; push (x + y.j) onto complex stack
400	3
401	ENTER^
402	5
403	FS? 10		; CR^?
404	X<>Y
405	RCL 00		; complex stack depth (csdepth)
406	DSE X
407	ST+ X
408	 E3
409	ST/ Z
410	X^2
411	/
412	+		; for CRDN
413	LBL 00
414	+
415	REGSWAP		; register swap for sss.dddnnn

; GET (x + y.j) FROM COMPLEX STACK

416	LBL 14
417	RCL 04		; imaginary part of Z1
418	RCL 03		; real part of Z1
419	RTN

; COMPLEX 1/Z1
;
; Formula:
;      1             x                 y
;    -------  =  ---------  -  j . ---------
;    x + y.j     x^2 + y^2         x^2 + y^2
;
; doesn't disturb Z and T
420	LBL 31
421	X^2
422	X<>Y
423	STO M
424	ST* X
425	ST+ Y
426	X<> M
427	CHS
428	X<>Y
429	ST/ Y
430	ST/ L
431	X<> L
432	RTN

; GET TWO OPERANDS as (x + j.y) and (z + j.t)
; 1st operand is from keyboard, otherwise from Z1
; stack management subroutine for operations with two complex number operands

433	LBL 07
434	XEQ 06		; get one operand (x + y.j) from keyboard input
                        ;  otherwise from Z1 on the complex stack
435	FC?C 02
436	FC? 22		; if "no stack lift" or no "input from keyboard"
437	XEQ 12		;   then move complex stack down
438	RCL 04		; get operand (z + t.j) from Z1 on the complex stack
439	RCL 03
440	R^
441	R^
442	GTO 00

; GET OPERAND, as (x + j.y) and UPDATE LASTZ
; stack management subroutine for operations with one complex and one real number operand

443	LBL 08	   	; called with n in register X
444	FS?C 02		; if "no stack lift"
445	XEQ 12		;   then move complex stack down, Z1 < Z2 < Z3 < Z4 < Z5 < Z6
446	RCL 04		; copy Z1 to LASTZ
447	STO 02
448	RCL 03
449	STO 01
450	RCL Z		; n in register X, complex operand as (y + z.j)
451	RTN

; PUSH (x + y.j) ONTO COMPLEX STACK and UPDATE LASTZ
; stack management subroutine for operations with one complex number operand

452	LBL 09
453	XEQ 04		; push (x + y.j) onto complex stack
454	LBL 00
455	STO 01		; copy to LASTZ1
456	X<>Y
457	STO 02
458	X<>Y
459	RTN

; COMPLEX ALPHA/ALPHA ROUTINE

460	LBL 04	      	; [CVIEW] key code [ALPHA]
461	FC?C 02
462	FC? 22
463	FS? 30		; if both "no stack lift" and "keyboard input"
464	XEQ 11		;   then move complex stack up, Z1 > Z2 > Z3 > Z4 > Z5 > Z6

465	XEQ 06		; get one operand
466	STO 03
467	X<>Y
468	STO 04
469	X<>Y
470	RTN

; GET ONE OPERAND (x + y.j)
; from keyboard input, otherwise from Z1 on the complex stack 

471	LBL 06
472	FS? 00		; if in polar mode, then convert it to Rect
473	FC? 22
474	FS? 30
475	P-R
476	FS? 22		; keyboard input?
477	RTN
478	RCL 04
479	RCL 03
480	RTN

; DISPLAY
; in rectangular mode "x + y.j", or in polar mode "x <y" with the
; angle in degrees
; subroutine that views both parts of the complex number in X and Y in
; condensed format in the display, without disturbing Z, T or the display
; mode.  ENG 2 was chosen because, to display complex numbers in analog
; electronics.

481	LBL 10		; Z1 = x + j.y
482	SIGN		; save X in LASTX
483	RDN
484	CLA
485	RCLFLAG		; save flags
486	ENG 2
487	ARCL L
488	RDN
489	FS? 00		; in Rectangular notation append real part,
490	GTO 00		; and '+' sign if imaginary part is positive
491	X<0?
492	GTO 00
493	>"+"
494	LBL 00
495	R^
496	FS? 00		; for Polar notation, append angle ('<') sign
497	>"<"
498	ARCL Y
499	FC? 00
500	>"J"		; in Rectangular notation append 'J' char
501	AVIEW
502	STOFLAG		; restore flags
503	X<> L		; restore X from LASTX
504	RTN

; ROLL THE COMPLEX STACK, by one position up or down
; subroutine to shift the stack up or down by one complex register
;
; Does not roll around like RDN or R^
; Does not enter or retrieve data.
;
; Example:
;                  | stack lift | stack drop
;    --------------+------------+------------
;    Z6    6 + 6j  |   5 + 5j   |   6 + 6j
;    Z5    5 + 5j  |   4 + 4j   |   6 + 6j
;    Z4    4 + 4j  |   3 + 3j   |   5 + 5j
;    Z3    3 + 3j  |   2 + 2j   |   4 + 4j
;    Z2    2 + 2j  |   1 + 1j   |   3 + 3j
;    Z1    1 + 1j  |   1 + 1j   |   2 + 2j

505	LBL 11		; stack lift, Z1 > Z2 > Z3 > Z4 > Z5 > Z6
506	3.005		;   typically when a new number is moved into Z1
507	GTO 00
508	LBL 12		; stack drop, Z1 < Z2 < Z3 < Z4 < Z5 < Z6
509	5.003		;   typically when a operation combines Z1 and Z2
510	LBL 00
511	SIGN
512	RCL 00		; complex stack depth (csdepth)
513	X<>Y
514	ST- Y
515	RDN
516	ST+ X
517	 E6
518	ST/ Y
519	X<> L
520	+		; register X is in sss.dddnnn format
521	REGMOVE		; copies 2*(csdepth-1) registers from sss to ddd
522	RDN
523	END

References

History

Theory

Examples

1. Calculate the roots for: x⁵ - x⁴ - 101.x³ + 101.x² + 100.x - 100 = 0

   entry	display
   XEQ "POL5"	ORDER?
   5 R/S	X^5= ?
   1 R/S	X^4= ?
   1 CHS
   R/S	X^3= ?
   101 CHS
   R/S	X^2= ?
   101 R/S	X^1=?
   100 R/S	CONST?
   100 CHS
   R/S	1.000
   R/S	-1.000
   R/S	10.000
   R/S	1.000
   R/S	-10.000
   R/S	END

2. Calculate the roots for: x⁴ + x³ + x² + 11.x + 10 = 0

   entry	display
   R/S	ORDER?
   4 R/S	X^4= ?
   1 R/S	X^3= ?
   1 R/S	X^2= ?
   1 R/S	X^1= ?
   11 R/S	CONST= ?
   10 R/S	-1.000
   R/S	-2.000
   R/S	1.000+2.000J
   R/S	1.000-2.000J
   R/S	END

3. Calculate the roots for: x³ - x² + x - 1 = 0

   entry	display
   XEQ "POL5"	ORDER?
   3 R/S	X^3= ?
   1 R/S	X^2= ?
   1 CHS
   R/S	X^1= ?
   1 R/S	CONST?
   1 CHS
   R/S	1.000E-10+1.000J
   R/S	1.000E-10-1.000J
   R/S	1
   R/S	END

Method

Program listing

• Requires
  • X-Functions module on the HP-41cv
• Available as
  • source code
  • raw code for the V41 emulator
  • bar code for the HP Wand (HP82153A)
• Size
  • The program takes 527 bytes including the END, and fits on 5 magnetic tracks.
• Registers used
  • R00, constant
  • R01, 1st order coefficient
  • :
  • R05, 4th order coefficient
  • R06, highest order
  • R07, loop variable for coefficient input
  • R08, subroutine label (highest coefficient + 10)
  • R09, display loop variable (dd)
• Flags used
  • flag 00, when set R00/R01 holds complex roots (R00+-R01.j), otherwise R00/R01 holds real roots
  • flag 02, when set, R02/R03 holds complex roots (R02+-R03.j), otherwise R02/R03 holds real roots

01	LBL "POL5"
02	SF 00		; no complex root in R00/R01
03	FIX 0
04	CF 29
05	"ORDER ?"
06	PROMPT
07	STO 06		; highest order coefficient
08	STO 07		; loop variable for coefficient input
09	 E1
10	+
11	STO 08

12	LBL 21		; coefficients input
13	"X^"
14	ARCL 07
15	>"= ?"
16	PROMPT
17	FS?C 00		; complex root in R00/R01?
18	GTO 20
19	RCL IND 06	; convert to depressed form
20	/
21	LBL 20
22	STO IND 07
23	DSE 07		; decrement loop variable
24	GTO 21
25	"CONST ?"
26	PROMPT
27	RCL IND 06
28	/
29	STO 00

30	SF 29		; "digit grouping"
31	FIX 3
32	 E		; x=1
33	STO IND 06	; highest order coefficient is 1 (because depressed form)
34	-1
35	STO 09		; init dd to -1
36	GTO IND 08	; jump to label matching highest order of polynomial

; SOLVE 2nd ORDER

37	LBL 12
38	XEQ 08		; find two roots
39	XEQ 09		; display two roots
40	GTO 11

; SOLVE 3rd ORDER

41	LBL 13
42	XEQ 10		; Find 3 roots
43	XEQ 09		; display first two roots
44	XEQ 16		; display next root
45	GTO 11

; SOLVE 4th ORDER

46	LBL 14
47	XEQ 18		; find four roots
48	XEQ 09		; display first two roots
49	XEQ 09		; display next two roots
50	GTO 11

; SOLVE 5th ORDER

51	LBL 15
52	XEQ 19		; find five roots
53	XEQ 09		; display first two roots
54	XEQ 09		; display next two roots
55	XEQ 16		; display next root

; FINISH UP, and get ready to do it again

56	LBL 11
57	"END"
58	PROMPT
59	XEQ "POL5"

; DISPLAY TWO ROOTS

60	LBL 09
61	CLA
62	ISG 09		; dd++
63	""              ; NOP
64	FC?C IND 09	; if they are not a complex roots,
65	GTO 17		;   then display two real roots

66	RCL IND 09	; display complex root in rectangular form
67	ISG 09
68	""
69	RCL IND 09
70	ABS
71	ARCL Y
72	>"+"
73	ARCL X
74	>"J"
75	AVIEW
76	STOP
77	CLA		; display conjugate of that root in rectangular form
78	ARCL Y
79	CHS
80	ARCL X
81	>"J"
82	PROMPT
83	RTN

; DISPLAY TWO REAL ROOTS

84	LBL 17
85	DSE 09		; dd
86	""              ; NOP
87	XEQ 16		; display next root, then fall through to show the next one

; DISPLAY ONE REAL ROOT

88	LBL 16
89	CLA
90	ISG 09		; dd points to next root
91	""              ; NOP
92	ARCL IND 09	; display register pointed to by dd
93	PROMPT
94	RTN

; FIND FIVE ROOTS
;
; on entry:
;   depressed form coefficients a0, a1, a2, a3, a4 in R00 .. R04
;
; on exit:
;   if FS?00 then root1 = (R00 + R01.j) and root2 = (R01 - R01.j)
;            else root1 = (R00 +   0.j) and root2 = (R01 -   0.j)
;   if FS?02 then root3 = (R02 + R03.j) and root4 = (R02 - R03.j)
;            else root3 = (R02 +   0.j) and root4 = (R03 -   0.j)
;   root5 = (R04 + 0.j)

95	LBL 19
96	RCL 00
97	STO N		; N = a0
98	 E
99	%
100	STO M		; M = a0 / 100
101	CLST

102	LBL 00		; on entry Z=1
103	RCL Z		; X=Z
104	STO O		; O = starts with 1
105	4   		; fn = a0 + n*(a1 + n*(a2 + n*(a3 + n*(a4 + n))))
106	RCL N
107	LBL 01
108	RCL IND Y
109	+
110	RCL N
111	*
112	DSE Y
113	GTO 01
114	RCL 00
115	+
116	ST* M		; M = M * fn
117	ST- O		; O = O - fn
118	RCL M
119	RCL O
120	X#0?		; if (O <> 0 )
121	/		;   then M = M / O
122	STO M		;   else M = 0

123	X<> N           ; N = N + M
124	ST+ N
125	RCL N
126	X#Y?		; if ( N <> M )
127	GTO 00		;   then next iteration

128	RCL O		; Eliminate 5th root
129	R^  		;   a3' = a4 + root5->re
130	*		;   a2' = a3 + root5->re * a3
131	+		;   a1' = a2 + root5->re * a2
132	X<> 04          ;   a0' = a1 + root5->re * a1
133	3
134	X<>Y            ; root5 = N + O * fn
135	 E
136	LBL 02
137	RCL 04
138	*
139	+
140	ENTER^
141	X<> IND Z
142	X<>Y
143	DSE Z
144	GTO 02
145	RCL 04
146	*
147	+
148	STO 00		; rolls over to "FIND FOUR ROOTS"

; FIND FOUR ROOTS
;
; on entry:
;   depressed form coefficients a0, a1, a2, a3 in R00 .. R03
;
; on exit:
;   if FS?00 then root1 = (R00 + R01.j) and root2 = (R01 - R01.j)
;            else root1 = (R00 +   0.j) and root2 = (R01 -   0.j)
;   if FS?02 then root3 = (R02 + R03.j) and root4 = (R02 - R03.j)
;            else root3 = (R02 +   0.j) and root4 = (R03 -   0.j)

149	LBL 18
150	RCL 01
151	STO N		; N = a1
152	X^2
153	RCL 00
154	STO M		; M = a0
155	RCL 02
156	CHS
157	STO O		; O = -a2
158	STO 02
159	4
160	*
161	RCL 03
162	ST* 01
163	X^2
164	+
165	*
166	+
167	CHS
168	X<> 00          ; Now:
169	4		;   a2' = -a2                  (R02)
170	*		;   a1' = a1*a3-4*a0	       (R01)
171	ST- 01		;   a0' = a0*(4*a2-a3^2)-a1^2  (R00)

172	XEQ 07		; Find 3 roots

173	RCL 02		; Determine largest root
174	FS? 00		;   if complex root in R00/R01, then
175	GTO 06          ;     X = root3->re
176	RCL 01		;   else
177	X<Y?            ;     X = maximum of root1->re, root2->re, root3->re
178	X<>Y
179	RCL 00
180	X<Y?
181	X<>Y            ; X = largestRoot

182	LBL 06 		; Eliminate the largest root
183	STO 00		;   A = a3/2
184	STO 02     	;   B = largestRoot/2
185	RCL O		;   C = sqrt(A*A-a2+largestRoot);
186	+   		;   D = sqrt(B*B-a0);
187	RCL 03		;   S = sign(A*B-a1/2))    (sign returns 1 if >=0, -1 if  02
225	STO 00
226	RCL 01
227	X<> 03
228	STO 01
229	CF 02
230	FS? 00
231	SF 02		; Find the next two roots
232	CLA		;   a1' = A - S.C;
233	GTO 03 		;   a0' = B - D;

; FIND THREE ROOTS
;
; on entry:
;   depressed form coefficients a0, a1, a2 in R00 .. R02
;
; on exit:
;   if FS?00 then root1 = (R00 + R01.j) and root2 = (R01 - R01.j)
;            else root1 = (R00 +   0.j) and root2 = (R01 -   0.j)
;   root3 = (R02 + 0.j)

234	LBL 10		; Find the 3rd root
235	LBL 07
236	XEQ 04
237	RCL 02
238	3
239	/
240	-

241	STO 00		; Eliminate the 3rd root
242	ST+ 02
243	RCL 02
244	*
245	ST+ 01
246	RCL 02
247	X<> 01          ; Find the next two roots (rolls over to LBL 08)
248	X<> 00          ;     a1' = a2 + root3->re                           (R01)
249	STO 02		;     a0' = a1 + root3->re * ( a2 + root3->re)       (R00)

; FIND TWO ROOTS
;
; on entry:
;   depressed for coefficients a0, a1 in R00 .. R01
;
; on exit:
;   if FS?00 then root1 = (R00 + R01.j) and root2 = (R01 - R01.j)
;            else root1 = (R00 +   0.j) and root2 = (R01 -   0.j)

250	LBL 08
251	LBL 03
252	CF 00
253	RCL 00
254	4
255	*
256	RCL 01
257	STO 00
258	X^2
259	-		; discr = (a1^2)/4 - a0;
260	X>0?            ; discr > 0?
261	SF 00
262	ABS
263	SQRT
264	2
265	CHS
266	ST/ 00
267	/
268	CHS
269	STO 01
270	FS? 00		; complex root in R00/R01?
271	RTN 		; X = sqrt(abs(a0-a1^2/4))

272	RCL 00
273	STO 01
274	RDN
275	ST+ 00
276	ST- 01
277	RTN 		; X = sqrt(abs(a0-a1^2/4))

; FIND 3RD ROOT HELPER, returns the real part + a2/3 in X
;
; on entry:
;   depressed form coefficients a0, a1, a2 in R00 .. R02
;
; on exit:
;   Note the ' sign, because to get root3, 2/3 needs to be subtracted
;   X register holds (root3 + a2/3)

278	LBL 04
279	RCL 01	        ; Method:
280	RCL 02	        ;   p = a1/3 - a2^2/9
281	X^2 		;   q = a1*a2/6 - a2^3/27 - a0/2;
282	3		;   tmp = p^3 + q^2
283	/
284	-
285	3
286	/
287	RCL 01
288	RCL 02
289	*
290	6
291	/
292	RCL 02
293	3
294	/
295	LASTX
296	Y^X
297	-
298	RCL 00
299	2
300	/
301	-
302	X=0?		; if (q==0) then
303	RTN		;     X = (0 + 0.j)

304	STO Z  	        ; else
305	X^2
306	X<>Y
307	3
308	Y^X
309	+		;     if (tmp < 0)
310	Xre' = 2*(q^2+sqrt(-tmp)^2)^1/3 *
311	GTO 05		;             cos(phi(q,sqrt(-tmp))/3)

312	SQRT		;     else
313	ST- Z		;         X = sign(q-sqrt(tmp))*abs(q-sqrt(tmp))^1/3 +
314	+   		;             sign(q+sqrt(tmp))*abs(q+sqrt(tmp))^1/3
315	SIGN
316	LASTX
317	ABS
318	3
319	1/X
320	Y^X
321	*
322	X<>Y
323	SIGN
324	LASTX
325	ABS
326	3
327	1/X
328	Y^X
329	*
330	+
331	RTN

332	LBL 05
333	CHS
334	SQRT
335	X<>Y
336	R-P
337	3
338	1/X
339	Y^X
340	X<>Y
341	3
342	/
343	COS
344	*
345	ST+ X
346	RTN

347	END

References

History

Instructions

Examples

1. Calculate the sinh(1)

   GTO "HYP"
   USER
   1 SIN	1.1752

Listing

• Requires
  • X-Functions module on the HP-41cv
• Available as
  • source code
  • raw code for the V41 emulator
  • bar code for the HP Wand (HP82153A)
• Size
  • 12 registers; 78 bytes including END; 1 magnetic track (78/112=0.70)

01	LBL "HYP"

02	LBL H	; [sinh]
03	STO M
04	E^X-1
05	LASTX
06	E^X
07	/
08	RCL M
09	E^X-1
10	+
11	LBL 00
12	2
13	/
14	RTN

15	LBL I 	; [cosh]
16	E^X
17	1/X
18	LASTX
19	+
20	GTO 00

21	LBL J	; [tanh]
22	XEQ H
23	RCL M
24	XEQ I
25	/
26	RTN

27	LBL C	; [asinh]
28	X^2
29	LASTX
30	X<>Y
31	 E
32	+
33	GTO 01

34	LBL E	; [atanh]
35	 E
36	+
37	ENTER^
38	ENTER^
39	2
40	-
41	/
42	CHS
43	LN
44	GTO 00

45	LBL D	; [acosh]
46	X^2
47	LASTX
48	X<>Y
49	 E
50	-
51	LBL 01
52	SQRT
53	+
54	LN
55	END

Theory

A.x = λ.x

Method

• There are no two identical eigenvalues.
• The start vector is not the null vector.
• The matrix does not contain complex eigenvalues. (The method will typically work well with a strongly dominated diagonal).

Examples

1. Matrix A

   keystrokes	display
   FIX 3
   XEQ "EW"	DIM?
   2 R/S	INV.MATRIX:
   	1:1=0.000?
   8 R/S	1:2=0.000?
   4 R/S	2:1=0.000?
   3 R/S	2:2=0.000?
   6 R/S	INV.STARTV.:
   	1:1=0.000?
   1 R/S	2:1=0.000?
   1 R/S	EPS=0.001?
   R/S	10.500
   	:
   	10.605
   	EW=10.606
   R/S	INV.STARTV.:
   	1:1=0.838?
   1 R/S	2:1=0.546?
   1 R/S	EPS=0.001?
   R/S	-0.230
   	3.393
   	3.394
   	EW=3.394
   R/S	EINDE

   The computed eigenvalues 10.606 and 3.394 can be verified through: This is also verified through the characteristic polynomial. The eigenvalues of A are precisely the solutions λ to the equation listed below with I is the n×n identify matrix. Therefore: The solutions to this equation are the eigenvalues λ_i. The JavaScript calculator "Eigenwerte und Eigenvektoren berechnen" provides another verification [7].

Listing

• Requires
  • X-Functions module on the HP-41cv
  • Advantage ROM
• Available as
  • source code
  • raw code for the V41 emulator
  • bar code for the HP Wand (HP82153A)
• Size
  • 39 registers
• Registers:
  • alfa, X, Y, Z, T, L
  • R00: epsilon
  • R01: loop counter
  • R02: eigenvalue
• Long jumps:
  • 41
  • 95

;  /---------------------------------------------------------------------\
;  |                      E i g e n v a l u e s                          |
;  |                                                                     |
;  |                            for the HP-41                            |
;  \---------------------------------------------------------------------/
;
;                                   1.00
;                               Coert Vonk
;
;            http://www.coertvonk.com/technology/hp41/eigenvalues-4606

01      LBL "EW"
02       E-4            ; default eps
03      STO 00
04      CF 08
05      "DIM ?"         ; invoer dimensie
06      PROMPT
07      ABS
08      INT
09      STO 01
10      ENTER^
11      ENTER^
12       E3
13      /
14      +
15      "INP. MATRIX:"
16      AVIEW
17      "B"
18      XROM 22,29      ; MATDIM: creeer B-matrix
19      "A"
20      XROM 22,29      ; MATDIM: creer A-matrix
21      XROM 22,61      ; MEDIT: invoer A-matrix

22      LBL 00
23      "A"
24      XROM 22,18      ; DIM?
25      INT
26      "INP. STARTV.:"
27      AVIEW
28      "W"             ; creer W-vector
29      XROM 22,29      ; MATDIM
30      "V"             ; creer V-vector
31      XROM 22,29      ; MATDIM
32      XROM 22,61      ; MEDIT: invoer V-vector
33      XROM 22,19      ; FNRM
34      "STARTV. ERR"
35      X=0?
36      AVIEW
37      X=0?
38      PSE             ; als startvector
39      X=0?            ; de nulvector is
40	GTO 00		; dan opnieuw
41	XEQ 03
42	RCL 00
43	"EPS="
44	ARCL X
45	>"?"
46	PROMPT		; invoer epsilon
47	STO 00
48	LBL 01
49	"W"
50	XROM 22,57      ; SUM
51	XROM 22,18      ; DIM?
52	INT
53	/
54	VIEW X		; tussenresultaat v/d e.g. laten zien
55	STO 02
56	RCL 00
57	XROM 22,33      ; MIN
58	+
59	XROM 22,30      ; MAX
60	X<=Y?		; test of er aan de nauwkeurigheid eps word voldaan
61	GTO 00		; zo  ja, spring
62	XEQ 03		; zo nee, ga verder
63	GTO 01

; toon de gevonden e.w.

64	LBL 00
65	RCL 02
66	"EV="
67	ARCL X
68	PROMPT
69	DSE 01		; alle ew nog niet gevonden?
70	GTO 04		; dan spring naar 04
71	"V"
72	PURFL		; maak de extended-memory weer schoon
73	"W"
74	PURFL
75	"A"
76	PURFL
77	"B"
78	PURFL
79	"EINDE"		; we're done
80	PROMPT
81	GTO E

; zeef de gevonden eigenwaarde uit de laatst gebruikte matrix (A)

82	LBL 04
83	 E
84	"X,V,W"
85	XROM 22,25      ; MAT*
86	"W"
87	XROM 22,59      ; TRNPS
88	"V,W,B"
89	XROM 22,24      ; M*M
90	RCL 02
91	"X,B"
92	XROM 22,25      ; MAT*
93	"A,B,A"
94	XROM 22,27      ; MAT-
95	GTO 00

; voer een iteratie slag uit volgens de powermethode
; zodat v:=A*v en w:=e.w. vector

96	LBL 03
97	"A,V,W"
98	XROM 22,24      ; M*M
99      "W,V"
100     XROM 22,28      ; MAT/
101     1.001
102     XROM 22,18      ; DIM?
103     RCL Y
104     "V,W"
105     XROM 22,49      ; MSWAP
106     "V"
107     XROM 22,19      ; FNRM
108     1/X
109     "X,V"
110     XROM 22,25      ; MAT*
111	RTN

112	END

References