%%HP: T(1)A(D)F(.);
DIR
  To2 0
  Fr2 8
  To 0
  Fr 3
  X 20
  Dev
"Br='Bn' Capacitor
"
  CST { }
  C 'B/A'
  PREV
     UPDIR
    
  Begin
     CLLCD
"    NFAP (c) 1990"
1 DISP
"   Analisis de Nudos"
3 DISP
"   Analysis Program"
4 DISP
"   By Don Robinson"
6 DISP { } MENU -40
CF 2 5
      FOR j j CF
      NEXT 1 SF
DELv CLEAR
"Number Nodes?" ""
INPUT OBJ 'N' STO
{ N N } (0,0) CON
'A' STO { N 1 }
(0,0) CON DUP 'B'
STO 'C' STO 0 'Bn'
STO "NONE" 'Dev'
STO "Frequency Hz?"
"" INPUT OBJ 'F'
STO Branch
    
  DELv
     'A' PURGE 'B'
PURGE 'C' PURGE 'F'
PURGE 'N' PURGE
'CST' PURGE 'Fr'
PURGE 'Y' PURGE 'X'
PURGE 'Bn' PURGE
'To' PURGE 'Dev'
PURGE '' PURGE
'To2' PURGE 'Fr2'
PURGE
      IF 1 FC?C
      THEN UPDIR
CLLCD
      END
    
  Solv
     CLLCD CLEAR
"Calculating" 1
DISP B A / 'C' STO
TEXT 0 STD 1 N
      FOR j C j GET
"V" j STR + TAG
      NEXT 4 ENG
    
  VcIs
     "VcIs
" Brn
"
Voltage Control gm?"
+ "" INPUT OBJ DUP
'X' STO "gm" LblD
"
Vx " + 3 SF From
LblF "
Is " + 3 SF
2 SF From LblG Add3
    
  R&Xj
     "R+Xj
" Brn
"
Resistance Value ?"
+ "" INPUT OBJ DUP
INV 'X' STO ""
LblD
"
Impedance Value (Xj)?"
+ "" INPUT OBJ DUP
X SWAP 2 *  NUM *
F * INV NEG RC 'X'
STO "Xj" LblD From
LblF Add
    
  Branch
    
      IF 4 FC?C
      THEN CLLCD
"    NFAP (c) 1990"
1 DISP "Last: " Dev
+ 2 DISP STD 1 'Bn'
STO+
"  Branch Number "
Bn STR + " ?" + 5
DISP
"   (Select Device)"
7 DISP Menu1 1 MENU
3 FREEZE
      END
    
  From
    
      IF 3 FC?C
      THEN "
" +
      END
"Node L+.E-?" + ""
INPUT OBJ DUP IP
      IF 2 FS?
      THEN 'Fr2'
      ELSE 'Fr'
      END STO FP N
LOG IP 1 + ALOG *
      IF 2 FS?C
      THEN 'To2'
      ELSE 'To'
      END STO
    
  Brn
     Offm "Br=" Bn
STR + " " + SWAP +
DUP 'Dev' STO
    
  Offm
     { } MENU
    
  Menu1
     { Resis Cap
Inductor Is Vs&R
IcIs VcIs R&Xj Solv
Begin DELv } MENU
    
  Resis
     "Resistor
"
Brn
"
Resistance Value ?"
+ "" INPUT OBJ DUP
INV 0 RC 'X' STO
"" LblD From LblF
Add
    
  Cap
     "Capacitor
"
Brn
"
Capacitor Value?"
+ "" INPUT OBJ DUP
0 SWAP F * 2 * 
NUM * RC 'X' STO
"f" LblD From LblF
Add
    
  Inductor
     "Inductor
"
Brn
"
Inductor Value?"
+ "" INPUT OBJ DUP
0 SWAP 2 * F * 
NUM * -1 SWAP /
RC 'X' STO "h"
LblD From LblF Add
    
  Is
     "I
" Brn
"
Current Source I?"
+ "" INPUT OBJ DUP
'X' STO "" LblD
From LblF Add2
    
  Vs&R
     "Vs+R
" Brn
"
Voltage Source (E)?"
+ "" INPUT OBJ DUP
'X' STO "E" LblD
"
Resistance  ?" +
"" INPUT OBJ DUP
INV DUP 'Y' STO X *
'X' STO STR ":" +
Dev SWAP + DUP
'Dev' STO From LblF
DUP 4 SF Add2 Y 'X'
STO Add
    
  IcIs
     "IcIs
" Brn
"
Resistance Value ?"
+ "" INPUT OBJ DUP
INV 'Y' STO ""
LblD
"
Contol factor ()?"
+ "" INPUT OBJ DUP
'' STO "" LblD
"
R " + 3 SF From
LblF Y 0 RC 'X'
STO 4 SF Add Dev
"
Is " + 2 SF 3 SF
From LblG  Y * 0
RC 'X' STO Add3
    
  Add
     CLLCD 1 DISP
"    Adding To Mat"
4 DISP 3 FREEZE
      IF Fr 0 
      THEN A { Fr
Fr } GET X + A { Fr
Fr } ROT PUT 'A'
STO
      END
      IF Fr 0 
      THEN
        IF To 0 
        THEN A { To
Fr } GET X - A { To
Fr } ROT PUT 'A'
STO A { Fr To } GET
X - A { Fr To } ROT
PUT 'A' STO
        END
      END
      IF To 0 
      THEN A { To
To } GET X + A { To
To } ROT PUT 'A'
STO
      END Branch
    
  Add2
     CLLCD 1 DISP
"    Adding To Mat"
4 DISP 3 FREEZE
      IF Fr 0 
      THEN B Fr GET
X - B Fr ROT PUT
'B' STO
      END
      IF To 0 
      THEN B To GET
X + B To ROT PUT
'B' STO
      END Branch
    
  Add3
     CLLCD 1 DISP
"    Adding To Mat"
4 DISP 3 FREEZE
      IF Fr2 0 
      THEN
        IF Fr 0 
        THEN A {
Fr2 Fr } GET X + A
{ Fr2 Fr } ROT PUT
'A' STO
        END
        IF To 0 
        THEN A {
Fr2 To } GET X - A
{ Fr2 To } ROT PUT
'A' STO
        END
      END
      IF To2 0 
      THEN
        IF Fr 0 
        THEN A {
To2 Fr } GET X - A
{ To2 Fr } ROT PUT
'A' STO
        END
        IF To 0 
        THEN A {
To2 To } GET X + A
{ To2 To } ROT PUT
'A' STO
        END
      END Branch
    
  LblD
     SWAP STR Dev
SWAP + " " + SWAP +
":" + DUP 'Dev' STO
    
  LblF
     Dev Fr STR +
":" + To STR + DUP
'Dev' STO
    
  LblG
     Dev ":" + Fr2
STR + ":" + To2
STR + DUP 'Dev'
STO
    
  Copyright
    
"V1.0 May 18,1990
(c) Copyright
Don C Robinson
(913)362-3969hm
(816)854-5243wk"
    
END
