                                        1 
                                        1 fortran package 
                                        1 source code
                                        1 
                                               blr 1945  1950 entry power subr     total reservation 
                                               regp1951  1960 read band            1947 - 1999, 0000
                                               blr 1961  1968 entry built-in subr  (54 words)
                                               blr 1969  1976 entry func subr 
                                               regj1977  1986 punch band      
                                               blr 1987  1987
                                               regw1988  1998 storage band                                   
                                        1 
                                        1 save index registers 
                                        1
                                          ezzzastdezzzx
                                               ldd 8005
                                               stdezzia
                                               ldd 8006
                                               stdezzib
                                               ldd 8007
                                               stdezzic ezzzx
                                        1
                                        1 restore saved index registers and return to erthx
                                        1
                                          ezzzblddezzia
                                               raa 8001
                                               lddezzib
                                               rab 8001
                                               lddezzic 
                                               rac 8001 erthx
                                          ezzzx 00 0000  0000
                                          ezzia 00 0000  0000
                                          ezzib 00 0000  0000
                                          ezzic 00 0000  0000
                                        1 
                                        1 overflow checking
                                        1
                                          e00aabov       8001
                                               hlt 0100  8001 alarm arithmetic overflow
                                        1 
                                        1 (l) fixed point <- (u) float
                                        1
                                          e00thstderthx       float upper
                                               srt 0002       to fix lower        
                                               stuartha       save mantissa                      
                                               ram 8002       test exp              
                                               slon51         store zero            
                                               bmiad1         if less than          
                                               slon10         51     alarm          
                                               bmi      ad3   if grtr than          
                                               srt 0004       60                    
                                               aloonet                               
                                               lddad2a        modify                
                                               sdaad2          shift                
                                               ralartha                             
                                               slt 0002 ad2                         
                                          ad1  ral 8003 erthx store zero            
                                          ad2  srt 0000 erthx shift const           
                                          ad2a srt 0000 erthx                       
                                          ad3  ldderthx
                                               hlt 0501  8001 alarm float >= 10e10 thus cannot be converted to fix 
                                          n10   10 0000  0000                       
                                          n51   51 0000  0000                                 
                                          onet  00 0001  0000                
                                          erthx 00 0000  0000                 
                                          artha 00 0000  0000                   
                                        1 
                                        1 (u) and (acc) float <- (l) fixed point 
                                        1
                                          e00afstdartha       float to up   
                                               ldd      e00ae and acc        
                                               stuacc   artha
                                        1 
                                        1 (u) float <- (l) fixed point 
                                        1
                                          e00aestderthx       float to up             
                                               rau 8002 ae0    only                   
                                          ae0  sct 0000       normalize               
                                               stlarthb                                
                                               bovad1         zero check              
                                               ral 8003                               
                                               srd 0002       round for               
                                               slt 0002       placing exp             
                                               nzu      ae6   check round             
                                               ldd 8003        overflow               
                                               srt 0001                               
                                               alo 8001 ae6                           
                                          ae6  bmiae2         insert                  
                                               aloaj3   ae5    exponent               
                                          ae2  sloaj3   ae5                           
                                          ae5  sloarthb  
                                               rau 8002 erthx
                                          aj3   00 0000  0060
                                          arthb 00 0000  0000                   
                                        1 
                                        1 punch card
                                        1
                                          e00arstderthx       punch out 
                                               lddj0008     
                                               siaj0008       store stmnt     
                                               lddonet
                                               sdanvars       and nvars to pch
                                               slo 8001       if stmt zero 
                                               nzear3         punch if 
                                               ral 8000       8000 is neg 
                                               bmiar3   erthx else exit
                                          ar3  lddar3a  ar5   init pch card
                                          ar3a ralnvars       dec nvars              
                                               sloonet                         
                                               bmiar8         test word       
                                               stlnvars       count           
                                               alo       8002 get nword addr
                                               ralw0002       in lower
                                               lddnword
                                               sdanword       store num of words to punch
                                               slt 0004
                                               lddadwrd
                                               sdaadwrd ar4   store addr of word to punch
                                          ar4  ralnpch        is card full 
                                               sloarn7         
                                               bmiar4a
                                               pchj0001        yes punch and
                                               lddar4a  ar5    call init card
                                          ar4a ralnpch        incr no of 
                                               aloonet         punched words npch 
                                               stlnpch        
                                               raladwrd       indr adwrd
                                               aloonet        
                                               stladwrd
                                               sloonet
                                               alo       8002 get adwrd 
                                               raly0000        contents
                                               stldatwd        store in datwd
                                               raudatld
                                               alonpch        store at 
                                               alo       8003  j0000 plus 
                                               stdj0000        npch
                                               ralnword       decr var nwords
                                               sloonet         to be punched
                                               nze      ar3a   
                                               bmiar3a
                                               stlnword ar4
                                          ar5  stdar5x        sub init pch card
                                               ralj0008       incr card
                                               aloonet         number
                                               stlj0008
                                               stunpch        card with zero
                                               stdj0001        punched words 
                                               stdj0002       set punch     
                                               stdj0003        band to       
                                               stdj0004        zeroes        
                                               stdj0005
                                               stdj0006
                                               stdj0007 ar5x
                                          ar8  pchj0001 erthx punch           
                                          onet  00 0001  0000                
                                          arn7  00 0007  0000                
                                          j0008 00 0000  0000 card counter   
                                          j0010 80 0000  0080 control cnst   
                                          ar5x  00 0000  0000 exit for sub init pch card
                                          nvars 00 0000  0000 num of vars to pch
                                          nword 00 0000  0000 num of words per var to pch
                                          adwrd 00 0000  0000 addr of word to pch
                                          npch  00 0000  0000 num of words punched in chard
                                          datwd 00 0000  0000 data word to be punched
                                        1 
                                        1 read card
                                        1
                                          e00aqstderthx       read in
                                               lddonet
                                               sdanvars       nvars to read
                                               stunpch  aq3a  init to zero
                                          aq3a ralnvars       dec nvars              
                                               sloonet                         
                                               bmierthx       exit if zero
                                               stlnvars           
                                               alo       8002 get nword addr
                                               ralw0002       in lower
                                               lddnword
                                               sdanword       store num of words to rd
                                               slt 0004
                                               lddadwrd
                                               sdaadwrd aq4   store addr of word to rd
                                          aq4  ralnpch        check if should rd new card
                                               nzeaq4a
                                               rcdp0001        yes read card
                                               lddarn7
                                               stdnpch  aq4a
                                          aq4a ralnpch        decr no of available
                                               sloonet        punched words npch in read card
                                               stlnpch 
                                               ralarn7
                                               slonpch        get word at 
                                               alo       8002  p0000 plus 
                                               lddp0000        npch in dist
                                               stddatwd        store it in datwd
                                               raudatld
                                               aloadwrd       incr adwrd
                                               aloonet        
                                               stladwrd
                                               sloonet
                                               alo       8003 set adwrd 
                                               stdy0000        contents from upper
                                               ralnword       decr var nwords
                                               sloonet         to be read
                                               nze      aq3a   
                                               bmiaq3a
                                               stlnword aq4
                                          onet  00 0001  0000                
                                          datldldddatwd  8002 load card word into dist and jump to lower                 
                                        1                                
                                        1 alarm if try to use a not defined subroutine
                                        1
                                          e00akhlt 9010  8001 alarm fix ** fix undef
                                          e00alhlt 9011  8001 alarm float ** fix undef
                                          e00lqhlt 9302  8001 alarm float ** float undef
                                          e00abhlt 9001  8001 alarm logf undef
                                          e00achlt 9002  8001 alarm expf undef
                                          e00lohlt 9300  8001 alarm lnf undef
                                          e00lphlt 9301  8001 alarm expnf undef
                                          e00avhlt 9021  8001 alarm cosf undef
                                          e00awhlt 9022  8001 alarm sinf undef
                                          e00axhlt 9023  8001 alarm sqrtf undef
                                          e00ayhlt 9024  8001 alarm absf undef
                                          e00azhlt 9025  8001 alarm intf undef
                                          e00bahlt 9026  8001 alarm maxf undef
                                          ezztyhlt 9099  8001 alarm function arg is fix but should be float
                                        1                                  
                                        1 start of subroutines
                                        1
                                        1 
                                        1 (l) and (acc) fixed <- (l) fixed ** (acc) fixed
                                        1
                                          e00akstderthx       power fix fix. m ** p 
                                               stlartha ak1   m is argmnt     
                                          ak1  ramacc         p equals        
                                               stlarthb        abval power    
                                               ralone         h is result        
                                               stlarthc ak3    init to one          
                                          ak3  rauarthb       p is gtst           
                                               mpyn50          intgr in           
                                               stuarthb        p over two         
                                               ral 8002       is remainder        
                                               nze      ak5     zero              
                                               rauarthc       if not h is         
                                               mpyartha        h times m          
                                               nzuak12
                                               stlarthc ak5                       
                                          ak5  rauarthb                           
                                               nzu      ak6   is p zero           
                                               rauartha       if not              
                                               mpy 8001        m equals           
                                               nzuak12
                                               stlartha ak3    m squared          
                                          ak6  rauacc         is power neg        
                                               bmi      ak7   if so is h          
                                               ramarthc          zero             
                                               nze      ak8   if not is h         
                                               sloone            one            
                                               nzeak10  ak7                       
                                          ak7  ralarthc ak11  exhibit h           
                                          ak10 ral 8003 ak11
                                          ak11 stlacc   erthx 
                                          ak12 ldderthx       
                                               hlt 0003  8001 alarm overflow. fix**fix results in value >= 10e10
                                          ak8  ldderthx        
                                               hlt 0010  8001 alarm zero raised to neg
                                          n50   50 0000  0000                     
                                          one   00 0000  0001                     
                                          arthc 00 0000  0000                   
                                        1 
                                        1 (u) and (acc) float <- (u) float ** (acc) fixed
                                        1
                                          e00alstderthx       power float fix. m ** p 
                                               stuartha al1   m is argmnt     
                                          al1  ramacc         p equals        
                                               stlarthb        abval power    
                                               ralfp1         h is result 
                                               stlarthc al3    init to float one          
                                          al3  rauarthb       p is gtst           
                                               mpyn50          intgr in           
                                               stuarthb        p over two         
                                               ral 8002       is remainder        
                                               nze      al5     zero              
                                               rauarthc       if not h is         
                                               fmpartha        h times m          
                                               boval12
                                               stuarthc al5                       
                                          al5  rauarthb                           
                                               nzu      al6   is p zero           
                                               rauartha       if not              
                                               fmp 8001        m equals           
                                               boval12
                                               stuartha al3    m squared          
                                          al6  rauacc         is power neg        
                                               bmi      al7   if so is h          
                                               ramarthc        zero             
                                               nze      al8   if not calc
                                               raufp1          h reciprocal
                                               fdvarthc al11    
                                          al7  rauarthc al11  exhibit h           
                                          al11 stuacc   erthx
                                          al12 ldderthx       
                                               hlt 0049  8001 alarm overflow. float**fix results in value >= 10e49
                                          al8  ldderthx       
                                               hlt 0011  8001 alarm zero raised to neg
                                          n50   50 0000  0000                     
                                          fp1   10 0000  0051                     
                                        1 
                                        1 (u) float <- 10 ** (u) float 
                                        1
                                          e00acstderthx       exponential     
                                               nze      ac5   is argument   
                                               nzu      ezzty alarm function arg is fix but should be float
                                               srt 0002         zero          
                                               stuarthc       if not let      
                                               rsm 8002        n be mantsa    
                                               alon52          x be power     
                                               bmiac4         is x grtr       
                                               slt 0001        than ten       
                                               nzuac5         or less than    
                                               srt 0005        minus eight    
                                               aloac6         if x within     
                                               stlarthb        bounds gen     
                                               rauarthc       int and        
                                               srt 0006 arthb fract parts     
                                          n52   52 0000  0000  of argument    
                                          ac6  srt 0000       is arg neg      
                                               bmiac8         if so int is    
                                               stuarthb ac1   int minus 1     
                                          ac8  supone         and fract is    
                                               stuarthb       fract plus 1    
                                               ral 8002                       
                                               alon999  ac1                   
                                          ac1  stlarthc       arthc is frac part
                                               rau 8002       arthb is int part                
                                               mpyac18        generate        
                                               rau 8003                       
                                               aupac17         polynomial     
                                               mpyarthc                       
                                               rau 8003        approximation     
                                               aupac16              
                                               mpyarthc                       
                                               rau 8003          for          
                                               aupac15                        
                                               mpyarthc       exponential     
                                               rau 8003                       
                                               aupac14                        
                                               mpyarthc                       
                                               rau 8003                       
                                               aupac13                        
                                               mpyarthc                       
                                               rau 8003                       
                                               aupac12                        
                                               mpyarthc        square         
                                               rau 8003          result       
                                               aupn10         scale and       
                                               mpy 8003        float then     
                                               srt 0001          exit         
                                               stuartha                        
                                               rauac19                        
                                               auparthb                       
                                               bmiac20                        
                                               srt 0002                       
                                               nzuac21                        
                                               aupartha                        
                                               srt 0008 ac20                  
                                          ac4  ralarthc                       
                                               bmi      ac21                  
                                               rau 8003 erthx result zero
                                          ac5  raufp1   erthx result 1 because argmnt is zero  
                                          ac20 rau 8002 erthx result in upper
                                          ac21 ldderthx       
                                               hlt 0049  8001 alarm overflow. 10**float results in value >= 10e49
                                          ac12  11 5129  2776                 
                                          ac13  06 6273  0884                 
                                          ac14  02 5439  3575                 
                                          ac15  00 7295  1737                 
                                          ac16  00 1742  1120                 
                                          ac17  00 0255  4918                 
                                          ac18  00 0093  2643                 
                                          ac19  00 0000  0051                 
                                          n999  99 9999  9999
                                          n10   10 0000  0000                       
                                          one   00 0000  0001                     
                                          fp1   10 0000  0051                 
                                          arthc 00 0000  0000                   
                                        1 
                                        1 (u) float <- log 10 (u) float 
                                        1
                                          e00abnze      ab10  if log arg zero      
                                               nzu      ezzty alarm function arg is fix but should be float
                                               bmiab10        or neg alarm      
                                               stderthx     
                                               srt 0002                         
                                               stlarthb       store power 
                                               rau 8003       form  z          
                                               aupab1         equal arg        
                                               stuarthc       minus root       
                                               supab2         ten over arg     
                                               dvrarthc       plus root        
                                               stlartha           ten          
                                               rau 8002                         
                                               mpy 8001         z square       
                                               stuarthc                         
                                               rau 8003         generate       
                                               mpyab7                           
                                               rau 8003       polynomial       
                                               aupab6                           
                                               mpyarthc       approximatn      
                                               rau 8003                         
                                               aupab5                           
                                               mpyarthc                          
                                               rau 8003                         
                                               aupab4                           
                                               mpyarthc                          
                                               rau 8003                         
                                               aupab3                           
                                               mpyartha                         
                                               ral 8003                         
                                               alon50                           
                                               srt 0002                         
                                               aloarthb       add power         
                                               slon50                           
                                               srd 0002         round           
                                               rau 8002                         
                                               sct 0000       normalize         
                                               bovab12                          
                                               bmi      ab13                    
                                               supab9   ab11  adjust            
                                          ab11 sup 8002 ab12   power            
                                          ab12 rau 8003 
                                               fsbfp1   erthx                   
                                          ab13 aupab9   ab11                    
                                          ab10 hlt 0001  8001 alarm log (zero or negavive)
                                          ab1   00 3162  2780                   
                                          ab2   00 6324  5560                   
                                          ab3   86 8591  7180                   
                                          ab4   28 9335  5240                   
                                          ab5   17 7522  0710                   
                                          ab6   09 4376  4760                   
                                          ab7   19 1337  7140                   
                                          n50   50 0000  0000                   
                                          fp1   10 0000  0051                 
                                          ab9   00 0000  0054
                                          arthc 00 0000  0000 
                                        1 
                                        1 (u) and (acc) float <- (u) float ** (acc) float     
                                        1               u**acc = 10**(log10(u)*acc) 
                                        1                      = exp(log10(u)*acc)
                                        1
                                          e00lqstdlq1                          
                                               ldd      e00ab log 10 (u)
                                               fmpacc         mult by acc
                                               lddlq1   e00ac 10 ** u
                                          lq1   00 0000  0000 
                                        1 
                                        1 (u) float <- log e (u) float                        
                                        1              ln(u) = log(u) / log(e) 
                                        1              log10(e)=0.4342944819 
                                        1
                                          e00lostdlq1
                                               ldd      e00ab log 10 (u)
                                               fdvloge  lq1   div by log(e) const
                                          lq1   00 0000  0000 
                                          loge  43 4294  4850
                                        1 
                                        1 (u) float <- e ** (u) float                         
                                        1              expn(u) = e ** u = exp(log10(e)*u)
                                        1              e=2.71828182846 
                                        1
                                          e00lpstdlq1
                                               fmploge        mult by log(e) const
                                               lddlq1   e00ac 10 ** u
                                          lq1   00 0000  0000 
                                          loge  43 4294  4850
                                        1 
                                        1 (u) float <- absolute value (u) float                         
                                        1
                                          e00aynze       8001 exit if zero
                                               nzu      ezzty alarm function arg is fix but should be float
                                               stderthx 
                                               ram 8003       remove sgn 
                                               rau 8002 erthx result in upper and exit
                                        1 
                                        1 (u) float <- integer part (u) float                         
                                        1
                                          e00aznze       8001 exit if zero
                                               nzu      ezzty alarm function arg is fix but should be float
                                               stderthx 
                                               stuarthc       save arg
                                               srt 0002       exp in lower         
                                               stuartha       mant in h
                                               rsm 8002       make exp neg
                                               alon57         
                                               bmiaz4         big num so no fract part to remove
                                               alon01
                                               slt 0001        
                                               nzuaz5         small num so no int part
                                               srt 0005       set as right 
                                               aloaz6         shifts to do   
                                               stlarthb       
                                               rauartha arthb 
                                          n57   57 0000  0000 
                                          n01   01 0000  0000
                                          az6  srt 0000 
                                               rau 8003 ae0   go to fix to float conversion routine
                                          az5  rau 8002
                                               rau 8002 erthx return zero
                                          az4  rauarthc erthx return the arg unchanged
                                        1 
                                        1 (u) float <- max (float, float, ...)
                                        1              should have two or more float parameters 
                                        1
                                          e00bastderthx 
                                               stuartha       arg is max
                                               ralerthx ba0
                                          ba0  sloba10
                                               bmiba9         no more args
                                               ralerthx       set arg addr
                                               lddba1          to be read
                                               sdaba1   ba1
                                          ba1  rau 0000       read arg
                                               stuarthb
                                               fsbartha       is grtr than
                                               bmiba2         current result
                                               rauarthb       yes store as
                                               stuartha ba2   new result
                                          ba2  ralerthx       select next
                                               sloonet         arg
                                               stlerthx ba0
                                          ba9  rauartha erthx result in upper
                                          ba10  00p0000  0000 fist arg addr
                                        1 
                                        1 (u) float <- square root (u) float 
                                        1
                                          e00axnze       8001 exit if zero
                                               nzu      ezzty alarm function arg is fix but should be float
                                               bmiax1         alarm sqrt(neg)                     
                                               stderthx 
                                               srt 0002                                                  
                                               nzu      ax2   test for zro                               
                                               slon01         convert fortransit exp (1.0=1e51) to it exp (1.0=1e50)
                                               stlarthb       break up exp                               
                                               ral 8003       and mantissa                               
                                               slt 0002       calculate                                  
                                               stlartha        initial x                                 
                                               aupone   ax3                                              
                                          ax4  rauartha       calculate                                  
                                               dvrarthc        next x                                    
                                               slo 8001        value                                     
                                               nze      ax5                                              
                                               bmi      ax5   test for end                               
                                               alo 8001                                                  
                                               alo 8001 ax3                                              
                                          ax3  dvrtwo         recycle                                    
                                               stlarthc ax4                                              
                                          ax5  ralarthb       modify                                     
                                               alon49         exponent                                  
                                               srt 0008                                                  
                                               divtwo                                                    
                                               alo 8003                                                  
                                               stlarthb       test even or                               
                                               nzu      ax6    odd exp                                   
                                               rauarthc       exp odd                                    
                                               srt 0001                                                  
                                               mpyax11        mpy by sqrt                                
                                               srd 0010 ax7    of 10                                     
                                          ax7  slt 0002                                                  
                                               aloarthb 
                                               aloone         exp 50 to 51
                                               rau 8002 erthx go to exit                                 
                                          ax6  ralarthc       exp even                                   
                                               srd 0002 ax7                                              
                                          ax2  rau 8003 erthx result zero                                 
                                          ax1  hlt 0012  8001 alarm sqrt with negative argument
                                          one   00 0000  0001 constants                                  
                                          two   00 0000  0002                                            
                                          n49   49 0000  0000                                            
                                          ax11  03 1622  7766                                            
                                        1 
                                        1 (u) float <- cosinus (u) float (arg in radians: cos(pi/2) = 0)
                                        1
                                          e00avstderthx av0
                                          av0  nze      av4   cos(0) is one
                                               nzu      ezzty alarm function arg is fix but should be float
                                               srt 0002         argument                                 
                                               stuartha       alarm if pwr                               
                                               rsm 8002         overscale                                
                                               alon01         convert fortransit exp (1.0=1e51) to it exp (1.0=1e50)
                                               alon57         cosx equals                                
                                               bmiav2          one if pwr                                
                                               sloav3          underscale                                            
                                               bmi      av4                                                
                                               srt 0004                                                   
                                               aloav5                                                     
                                               stlav6                                                     
                                               rauartha       form                                         
                                               mpyav7   av6    fractional                                  
                                          av6  hltav6   av23   and intgrl                                  
                                          av23 stlarthc         parts                                      
                                               rau 8003                                                   
                                               mpyn50         form s as                                  
                                               stlarthb        one minus                                 
                                               rsmarthc        twice abval                               
                                               sml 8001        of fractnl                                
                                               alon999           part                                    
                                               rau 8002                                                   
                                               stuartha                                                   
                                               mpy 8001        form sine                                 
                                               stuarthc                                                   
                                               rauav16         polynomial                                
                                               mpyarthc       approximator                               
                                               rau 8003                                                   
                                               aupav15                                                    
                                               mpyarthc                                                   
                                               rau 8003                                                   
                                               aupav14                                                    
                                               mpyarthc                                                   
                                               rau 8003                                                   
                                               aupav13                                                    
                                               mpyarthc                                                   
                                               srt 0001                                                   
                                               rau 8003                                                   
                                               auppih         equals one                                 
                                               mpyartha                                                   
                                               sct 0000                                                   
                                               bovav19                                                    
                                               stlartha                                                   
                                               ral 8003        round                                      
                                               srt 0002        and                                        
                                               stlarthc        adjust                                     
                                               rsuartha         power                                     
                                               srt 0002                                                   
                                               bmi      av25                                               
                                               sup 8003                                                   
                                               alon50   av24                                               
                                          av24 auparthc                                                   
                                               slt 0002 av22                                               
                                          av22 stuartha       determine                                   
                                               rauarthb        sign of                                    
                                               nzu      av20    result                                   
                                               rslartha av26
                                          av20 ralartha av26                                            
                                          av25 sup 8003                                                   
                                               slon50   av24                                                
                                          av2  rauarthb       overscale                                     
                                               ldderthx        display                                     
                                               hlt 0013  8001 alarm radian arg too big
                                          av26 rau 8002
                                               bmiav27
                                               aupone   erthx
                                          av27 supone   erthx
                                          av4  ralav21  av26  cosx is one                                   
                                          av19 ral 8002       cosx is zero                                  
                                               slo 8001 av26                                               
                                          av17 rauav21  av22  cosx is plus                                  
                                          av3   11 0000  0000  or minus 1                                                                                    
                                          av5  srd 0011 av23                                                
                                          av7   31 8309  8862                                               
                                          pih   15 7079  6327 pi / 2  integer
                                         -av13  64 5963  7111                                               
                                          av14  07 9689  6793                                               
                                         -av15  00 4673  7656                                               
                                          av16  00 0151  4842                                               
                                          av21  10 0000  0050                                               
                                          n999  99 9999  9999                                               
                                          n50   50 0000  0000                     
                                          one   00 0000  0001                     
                                          n01   01 0000  0000
                                          n57   57 0000  0000 
                                        1 
                                        1 (u) float <- sinus (u) float (arg in radians: sin(pi/2) = 1)
                                        1
                                          e00awnze       8001 sin(0) is zero
                                               nzu      ezzty alarm function arg is fix but should be float
                                               stderthx   
                                               stuartha
                                               raufpih
                                               fsbartha av0   sin a = cos(pi/2 - a)
                                          fpih  15 7079  6351 pi / 2 float
                                        1                                
                                        1 end of fortran package   
                                        1                                 
