1184 lines
No EOL
247 KiB
HTML
1184 lines
No EOL
247 KiB
HTML
<!DOCTYPE html>
|
|
<html lang="en">
|
|
<head>
|
|
<meta charset="utf-8">
|
|
<meta http-equiv="X-UA-Compatible" content="IE=edge">
|
|
<meta name="viewport" content="width=device-width, initial-scale=1">
|
|
<meta name="description" content="RPN calculator in modern Fortran">
|
|
<meta name="author" content="sgeard" >
|
|
<link rel="icon" href="../favicon.png">
|
|
|
|
<title>main.f90 – hp</title>
|
|
|
|
<link href="../css/bootstrap.min.css" rel="stylesheet">
|
|
<link href="../css/pygments.css" rel="stylesheet">
|
|
<link href="../css/font-awesome.min.css" rel="stylesheet">
|
|
<link href="../css/local.css" rel="stylesheet">
|
|
<link href="../tipuesearch/tipuesearch.css" rel="stylesheet">
|
|
|
|
<!-- HTML5 shim and Respond.js for IE8 support of HTML5 elements and media queries -->
|
|
<!--[if lt IE 9]>
|
|
<script src="https://oss.maxcdn.com/html5shiv/3.7.2/html5shiv.min.js"></script>
|
|
<script src="https://oss.maxcdn.com/respond/1.4.2/respond.min.js"></script>
|
|
<![endif]-->
|
|
|
|
<script src="../js/jquery-2.1.3.min.js"></script>
|
|
<script src="../js/svg-pan-zoom.min.js"></script>
|
|
|
|
</head>
|
|
|
|
<body>
|
|
|
|
<!-- Fixed navbar -->
|
|
<nav class="navbar navbar-inverse navbar-fixed-top">
|
|
<div class="container">
|
|
<div class="navbar-header">
|
|
<button type="button" class="navbar-toggle collapsed" data-toggle="collapse" data-target="#navbar" aria-expanded="false" aria-controls="navbar">
|
|
<span class="sr-only">Toggle navigation</span>
|
|
<span class="icon-bar"></span>
|
|
<span class="icon-bar"></span>
|
|
<span class="icon-bar"></span>
|
|
</button>
|
|
<a class="navbar-brand" href="../index.html">hp </a>
|
|
</div>
|
|
<div id="navbar" class="navbar-collapse collapse">
|
|
<ul class="nav navbar-nav">
|
|
<li class="dropdown hidden-xs visible-sm visible-md hidden-lg">
|
|
<a href="#" class="dropdown-toggle"
|
|
data-toggle="dropdown" role="button"
|
|
aria-haspopup="true"
|
|
aria-expanded="false">Contents <span class="caret"></span></a>
|
|
<ul class="dropdown-menu">
|
|
<li><a href="../lists/files.html">Source Files</a></li>
|
|
<li><a href="../lists/modules.html">Modules</a></li>
|
|
<li><a href="../lists/procedures.html">Procedures</a></li>
|
|
<li><a href="../lists/absint.html">Abstract Interfaces</a></li>
|
|
<li><a href="../lists/types.html">Derived Types</a></li>
|
|
<li><a href="../lists/programs.html">Programs</a></li>
|
|
|
|
</ul>
|
|
|
|
</li>
|
|
<li class="visible-xs hidden-sm visible-lg"><a href="../lists/files.html">Source Files</a></li>
|
|
<li class="visible-xs hidden-sm visible-lg"><a href="../lists/modules.html">Modules</a></li>
|
|
<li class="visible-xs hidden-sm visible-lg"><a href="../lists/procedures.html">Procedures</a></li>
|
|
<li class="visible-xs hidden-sm visible-lg"><a href="../lists/absint.html">Abstract Interfaces</a></li>
|
|
<li class="visible-xs hidden-sm visible-lg"><a href="../lists/types.html">Derived Types</a></li>
|
|
<li class="visible-xs hidden-sm visible-lg"><a href="../lists/programs.html">Programs</a></li>
|
|
</ul>
|
|
<form action="../search.html" class="navbar-form navbar-right" role="search">
|
|
<div class="form-group">
|
|
<input type="text" class="form-control" placeholder="Search" name="q" id="tipue_search_input" autocomplete="off" required>
|
|
</div>
|
|
<!--
|
|
<button type="submit" class="btn btn-default">Submit</button>
|
|
-->
|
|
</form>
|
|
</div><!--/.nav-collapse -->
|
|
</div>
|
|
</nav>
|
|
|
|
<div class="container">
|
|
<div class="row">
|
|
<h1>main.f90
|
|
<small>Source File</small>
|
|
|
|
</h1>
|
|
<div class="row" id="info-bar">
|
|
<div class="col-lg-12">
|
|
<div class="well well-sm">
|
|
<ul class="list-inline" style="margin-bottom:0px;display:inline">
|
|
|
|
<li id="statements"><i class="fa fa-list-ol"></i>
|
|
<a data-toggle="tooltip"
|
|
data-placement="bottom" data-html="true"
|
|
title="35.9% of total for source files.">749 statements</a>
|
|
</li>
|
|
|
|
<li id="source-file">
|
|
<i class="fa fa-code"></i>
|
|
<a href="../src/main.f90"> Source File</a>
|
|
</li>
|
|
</ul>
|
|
<ol class="breadcrumb in-well text-right">
|
|
<li class="active">main.f90</li>
|
|
</ol>
|
|
</div>
|
|
</div>
|
|
</div>
|
|
<script>
|
|
$(function () {
|
|
$('[data-toggle="tooltip"]').tooltip()
|
|
})
|
|
</script>
|
|
|
|
</div>
|
|
<div class="row">
|
|
<div class="col-md-3 hidden-xs hidden-sm visible-md visible-lg">
|
|
<div id="sidebar">
|
|
<h3>Contents</h3>
|
|
|
|
|
|
|
|
|
|
<div class="panel panel-primary">
|
|
<div class="panel-heading text-left">
|
|
<h3 class="panel-title">
|
|
<a data-toggle="collapse" href="#progs-0">Programs</a>
|
|
</h3>
|
|
</div>
|
|
<div id="progs-0" class="panel-collapse collapse">
|
|
<div class="list-group">
|
|
<a class="list-group-item" href="../program/hp15c.html">hp15c</a>
|
|
</div>
|
|
</div>
|
|
</div>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<div class="panel panel-primary">
|
|
<div class="panel-heading text-left"><h3 class="panel-title">Source Code</h3></div>
|
|
<div class="list-group">
|
|
<a class="list-group-item" href="../sourcefile/main.f90.html#src">main.f90</a>
|
|
</div>
|
|
</div>
|
|
|
|
|
|
</div>
|
|
|
|
</div>
|
|
<div class="col-md-9" id='text'>
|
|
|
|
<br>
|
|
|
|
<section class="visible-xs visible-sm hidden-md">
|
|
<h3>Contents</h3>
|
|
|
|
|
|
|
|
|
|
<div class="panel panel-primary">
|
|
<div class="panel-heading text-left">
|
|
<h3 class="panel-title">
|
|
<a data-toggle="collapse" href="#progs-1">Programs</a>
|
|
</h3>
|
|
</div>
|
|
<div id="progs-1" class="panel-collapse collapse">
|
|
<div class="list-group">
|
|
<a class="list-group-item" href="../program/hp15c.html">hp15c</a>
|
|
</div>
|
|
</div>
|
|
</div>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<div class="panel panel-primary">
|
|
<div class="panel-heading text-left"><h3 class="panel-title">Source Code</h3></div>
|
|
<div class="list-group">
|
|
<a class="list-group-item" href="../sourcefile/main.f90.html#src">main.f90</a>
|
|
</div>
|
|
</div>
|
|
|
|
|
|
</section>
|
|
<br class="visible-xs visible-sm hidden-md">
|
|
|
|
<section>
|
|
<h2><span class="anchor" id="src"></span>Source Code</h2>
|
|
<div class="hl"><pre><span></span><a id="ln-1" name="ln-1" href="#ln-1"></a><span class="k">program </span><span class="n">hp15c</span><span class="w"></span>
|
|
<a id="ln-2" name="ln-2" href="#ln-2"></a><span class="w"> </span><span class="k">use </span><span class="n">rpn_stack</span><span class="w"></span>
|
|
<a id="ln-3" name="ln-3" href="#ln-3"></a><span class="w"> </span><span class="k">use </span><span class="n">linked_list</span><span class="p">,</span><span class="w"> </span><span class="n">print_ll</span><span class="w"> </span><span class="o">=></span><span class="w"> </span><span class="k">print</span><span class="p">,</span><span class="w"> </span><span class="n">clear_ll</span><span class="w"> </span><span class="o">=></span><span class="w"> </span><span class="n">clear</span><span class="p">,</span><span class="w"> </span><span class="n">size_ll</span><span class="w"> </span><span class="o">=></span><span class="w"> </span><span class="n">size</span><span class="w"></span>
|
|
<a id="ln-4" name="ln-4" href="#ln-4"></a><span class="w"> </span><span class="k">use </span><span class="n">amap</span><span class="w"></span>
|
|
<a id="ln-5" name="ln-5" href="#ln-5"></a><span class="w"> </span>
|
|
<a id="ln-6" name="ln-6" href="#ln-6"></a><span class="w"> </span><span class="k">implicit none</span>
|
|
<a id="ln-7" name="ln-7" href="#ln-7"></a><span class="k"> </span>
|
|
<a id="ln-8" name="ln-8" href="#ln-8"></a><span class="k"> </span><span class="kt">real</span><span class="p">(</span><span class="mi">8</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">x</span><span class="w"></span>
|
|
<a id="ln-9" name="ln-9" href="#ln-9"></a><span class="w"> </span><span class="kt">integer</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">ios</span><span class="p">,</span><span class="w"> </span><span class="n">i</span><span class="w"></span>
|
|
<a id="ln-10" name="ln-10" href="#ln-10"></a><span class="w"> </span><span class="kt">integer</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">verbosity</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="mi">0</span><span class="w"></span>
|
|
<a id="ln-11" name="ln-11" href="#ln-11"></a><span class="w"> </span><span class="kt">character</span><span class="p">(</span><span class="mi">100</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">buff</span><span class="w"></span>
|
|
<a id="ln-12" name="ln-12" href="#ln-12"></a><span class="w"> </span><span class="kt">integer</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">blen</span><span class="w"></span>
|
|
<a id="ln-13" name="ln-13" href="#ln-13"></a><span class="w"> </span><span class="kt">integer</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">argl</span><span class="p">,</span><span class="w"> </span><span class="n">argc</span><span class="w"></span>
|
|
<a id="ln-14" name="ln-14" href="#ln-14"></a><span class="w"> </span><span class="k">type</span><span class="p">(</span><span class="n">llist</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">tokens</span><span class="w"></span>
|
|
<a id="ln-15" name="ln-15" href="#ln-15"></a><span class="w"> </span><span class="k">type</span><span class="p">(</span><span class="n">llist_node</span><span class="p">),</span><span class="w"> </span><span class="k">pointer</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">token</span><span class="w"></span>
|
|
<a id="ln-16" name="ln-16" href="#ln-16"></a>
|
|
<a id="ln-17" name="ln-17" href="#ln-17"></a><span class="w"> </span><span class="kt">real</span><span class="p">(</span><span class="mi">8</span><span class="p">),</span><span class="w"> </span><span class="k">parameter</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">ag</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="mf">9.80665d0</span><span class="w"></span>
|
|
<a id="ln-18" name="ln-18" href="#ln-18"></a><span class="w"> </span><span class="kt">real</span><span class="p">(</span><span class="mi">8</span><span class="p">),</span><span class="w"> </span><span class="k">parameter</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">g</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="mf">6.67430d-11</span><span class="w"></span>
|
|
<a id="ln-19" name="ln-19" href="#ln-19"></a><span class="w"> </span><span class="kt">real</span><span class="p">(</span><span class="mi">8</span><span class="p">),</span><span class="w"> </span><span class="k">parameter</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">e</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">exp</span><span class="p">(</span><span class="mf">1.0d0</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-20" name="ln-20" href="#ln-20"></a><span class="w"> </span><span class="kt">real</span><span class="p">(</span><span class="mi">8</span><span class="p">),</span><span class="w"> </span><span class="k">parameter</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">c</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="mf">2.99792458d8</span><span class="w"></span>
|
|
<a id="ln-21" name="ln-21" href="#ln-21"></a><span class="w"> </span><span class="k">type</span><span class="p">(</span><span class="n">amap_t</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">constants</span><span class="w"></span>
|
|
<a id="ln-22" name="ln-22" href="#ln-22"></a><span class="w"> </span>
|
|
<a id="ln-23" name="ln-23" href="#ln-23"></a><span class="w"> </span><span class="k">type</span><span class="p">(</span><span class="n">amap_t</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">stats</span><span class="w"></span>
|
|
<a id="ln-24" name="ln-24" href="#ln-24"></a><span class="w"> </span><span class="kt">integer</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">in_sequence</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="mi">0</span><span class="w"></span>
|
|
<a id="ln-25" name="ln-25" href="#ln-25"></a><span class="w"> </span><span class="kt">logical</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">seq_is_x</span><span class="w"></span>
|
|
<a id="ln-26" name="ln-26" href="#ln-26"></a><span class="w"> </span><span class="kt">real</span><span class="p">(</span><span class="mi">8</span><span class="p">),</span><span class="w"> </span><span class="k">allocatable</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">x_seq</span><span class="p">(:),</span><span class="w"> </span><span class="n">y_seq</span><span class="p">(:)</span><span class="w"></span>
|
|
<a id="ln-27" name="ln-27" href="#ln-27"></a><span class="w"> </span><span class="kt">integer</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">n_seq</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="mi">0</span><span class="w"></span>
|
|
<a id="ln-28" name="ln-28" href="#ln-28"></a><span class="w"> </span>
|
|
<a id="ln-29" name="ln-29" href="#ln-29"></a><span class="w"> </span><span class="kt">logical</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">veMode</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="p">.</span><span class="n">false</span><span class="p">.</span><span class="w"></span>
|
|
<a id="ln-30" name="ln-30" href="#ln-30"></a><span class="w"> </span><span class="kt">logical</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">lang_en</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="p">.</span><span class="n">true</span><span class="p">.</span><span class="w"></span>
|
|
<a id="ln-31" name="ln-31" href="#ln-31"></a><span class="w"> </span><span class="kt">logical</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">tmp_cmode</span><span class="w"></span>
|
|
<a id="ln-32" name="ln-32" href="#ln-32"></a><span class="w"> </span><span class="kt">logical</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">ok</span><span class="w"></span>
|
|
<a id="ln-33" name="ln-33" href="#ln-33"></a><span class="w"> </span><span class="kt">logical</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">getNext</span><span class="p">,</span><span class="w"> </span><span class="n">numbers</span><span class="p">,</span><span class="w"> </span><span class="n">have_expression</span><span class="w"></span>
|
|
<a id="ln-34" name="ln-34" href="#ln-34"></a><span class="w"> </span><span class="kt">integer</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="nb">stat</span>
|
|
<a id="ln-35" name="ln-35" href="#ln-35"></a><span class="nb"> </span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">100</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">msg</span><span class="w"></span>
|
|
<a id="ln-36" name="ln-36" href="#ln-36"></a><span class="w"> </span><span class="kt">character</span><span class="p">(</span><span class="mi">5</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">lang</span><span class="w"></span>
|
|
<a id="ln-37" name="ln-37" href="#ln-37"></a>
|
|
<a id="ln-38" name="ln-38" href="#ln-38"></a><span class="w"> </span><span class="k">type</span><span class="p">(</span><span class="n">rpn_t</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">mem</span><span class="p">(</span><span class="mi">0</span><span class="p">:</span><span class="mi">9</span><span class="p">)</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">rpn_t</span><span class="p">()</span><span class="w"></span>
|
|
<a id="ln-39" name="ln-39" href="#ln-39"></a><span class="w"> </span>
|
|
<a id="ln-40" name="ln-40" href="#ln-40"></a><span class="w"> </span><span class="c">! Create a stack of size 4</span>
|
|
<a id="ln-41" name="ln-41" href="#ln-41"></a><span class="w"> </span><span class="k">type</span><span class="p">(</span><span class="n">stack_t</span><span class="p">(</span><span class="mi">5</span><span class="p">))</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">stack</span><span class="w"></span>
|
|
<a id="ln-42" name="ln-42" href="#ln-42"></a>
|
|
<a id="ln-43" name="ln-43" href="#ln-43"></a><span class="w"> </span><span class="k">call </span><span class="n">stack</span><span class="p">%</span><span class="n">set_legend</span><span class="p">([</span><span class="s1">'x:'</span><span class="p">,</span><span class="s1">'y:'</span><span class="p">,</span><span class="s1">'z:'</span><span class="p">,</span><span class="s1">'s'</span><span class="p">,</span><span class="s1">'t:'</span><span class="p">])</span><span class="w"></span>
|
|
<a id="ln-44" name="ln-44" href="#ln-44"></a><span class="w"> </span><span class="n">degrees_mode</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="p">.</span><span class="n">true</span><span class="p">.</span><span class="w"></span>
|
|
<a id="ln-45" name="ln-45" href="#ln-45"></a><span class="w"> </span><span class="n">complex_mode</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="p">.</span><span class="n">false</span><span class="p">.</span><span class="w"></span>
|
|
<a id="ln-46" name="ln-46" href="#ln-46"></a><span class="w"> </span><span class="n">eps</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="mf">1.0d-14</span><span class="w"></span>
|
|
<a id="ln-47" name="ln-47" href="#ln-47"></a><span class="w"> </span>
|
|
<a id="ln-48" name="ln-48" href="#ln-48"></a><span class="w"> </span><span class="c">! Constants</span>
|
|
<a id="ln-49" name="ln-49" href="#ln-49"></a><span class="w"> </span><span class="k">call </span><span class="n">constants</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="s1">'g'</span><span class="p">,</span><span class="n">ag</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-50" name="ln-50" href="#ln-50"></a><span class="w"> </span><span class="k">call </span><span class="n">constants</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="s1">'G'</span><span class="p">,</span><span class="n">g</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-51" name="ln-51" href="#ln-51"></a><span class="w"> </span><span class="k">call </span><span class="n">constants</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="s1">'e'</span><span class="p">,</span><span class="n">e</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-52" name="ln-52" href="#ln-52"></a><span class="w"> </span><span class="k">call </span><span class="n">constants</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="s1">'c'</span><span class="p">,</span><span class="n">c</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-53" name="ln-53" href="#ln-53"></a><span class="w"> </span><span class="k">call </span><span class="n">constants</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="s1">'pi'</span><span class="p">,</span><span class="n">pi</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-54" name="ln-54" href="#ln-54"></a><span class="w"> </span><span class="k">call </span><span class="n">constants</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="s1">'two_pi'</span><span class="p">,</span><span class="mi">2</span><span class="o">*</span><span class="n">pi</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-55" name="ln-55" href="#ln-55"></a><span class="w"> </span><span class="k">call </span><span class="n">constants</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="s1">'pi_over_2'</span><span class="p">,</span><span class="n">pi</span><span class="o">/</span><span class="mi">2</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-56" name="ln-56" href="#ln-56"></a>
|
|
<a id="ln-57" name="ln-57" href="#ln-57"></a><span class="w"> </span><span class="c">! Try to read the LANG environment variable</span>
|
|
<a id="ln-58" name="ln-58" href="#ln-58"></a><span class="w"> </span><span class="k">call </span><span class="nb">get_environment_variable</span><span class="p">(</span><span class="s1">'LANG'</span><span class="p">,</span><span class="n">lang</span><span class="p">,</span><span class="n">status</span><span class="o">=</span><span class="nb">stat</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-59" name="ln-59" href="#ln-59"></a><span class="w"> </span><span class="n">lang_en</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">stat</span><span class="w"> </span><span class="o">/=</span><span class="w"> </span><span class="mi">0</span><span class="w"></span>
|
|
<a id="ln-60" name="ln-60" href="#ln-60"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="w"> </span><span class="n">lang_en</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-61" name="ln-61" href="#ln-61"></a><span class="k"> </span><span class="n">lang_en</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">merge</span><span class="p">(.</span><span class="n">true</span><span class="p">.,.</span><span class="n">false</span><span class="p">.,</span><span class="n">lang</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="mi">3</span><span class="p">)</span><span class="w"> </span><span class="o">==</span><span class="w"> </span><span class="s1">'en_'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-62" name="ln-62" href="#ln-62"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-63" name="ln-63" href="#ln-63"></a><span class="k"> </span><span class="n">lang</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">merge</span><span class="p">(</span><span class="s1">'POINT'</span><span class="p">,</span><span class="s1">'COMMA'</span><span class="p">,</span><span class="n">lang_en</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-64" name="ln-64" href="#ln-64"></a>
|
|
<a id="ln-65" name="ln-65" href="#ln-65"></a><span class="w"> </span><span class="k">call </span><span class="n">init</span><span class="p">(</span><span class="n">lang</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-66" name="ln-66" href="#ln-66"></a>
|
|
<a id="ln-67" name="ln-67" href="#ln-67"></a><span class="w"> </span><span class="c">! Interrogate argument list</span>
|
|
<a id="ln-68" name="ln-68" href="#ln-68"></a><span class="w"> </span><span class="n">argc</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">command_argument_count</span><span class="p">()</span><span class="w"></span>
|
|
<a id="ln-69" name="ln-69" href="#ln-69"></a><span class="w"> </span><span class="n">have_expression</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="p">.</span><span class="n">false</span><span class="p">.</span><span class="w"></span>
|
|
<a id="ln-70" name="ln-70" href="#ln-70"></a><span class="w"> </span><span class="k">do </span><span class="n">i</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span><span class="n">argc</span><span class="w"></span>
|
|
<a id="ln-71" name="ln-71" href="#ln-71"></a><span class="w"> </span><span class="k">call </span><span class="nb">get_command_argument</span><span class="p">(</span><span class="n">i</span><span class="p">,</span><span class="w"> </span><span class="n">buff</span><span class="p">,</span><span class="w"> </span><span class="n">argl</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-72" name="ln-72" href="#ln-72"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">buff</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="n">argl</span><span class="p">)</span><span class="w"> </span><span class="o">==</span><span class="w"> </span><span class="s1">'-d'</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-73" name="ln-73" href="#ln-73"></a><span class="k"> </span><span class="n">verbosity</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="mi">1</span><span class="w"></span>
|
|
<a id="ln-74" name="ln-74" href="#ln-74"></a><span class="w"> </span><span class="k">cycle</span>
|
|
<a id="ln-75" name="ln-75" href="#ln-75"></a><span class="k"> </span>
|
|
<a id="ln-76" name="ln-76" href="#ln-76"></a><span class="k"> else if</span><span class="w"> </span><span class="p">(</span><span class="n">buff</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="n">argl</span><span class="p">)</span><span class="w"> </span><span class="o">==</span><span class="w"> </span><span class="s1">'-c'</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-77" name="ln-77" href="#ln-77"></a><span class="k"> </span><span class="n">complex_mode</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="p">.</span><span class="n">true</span><span class="p">.</span><span class="w"></span>
|
|
<a id="ln-78" name="ln-78" href="#ln-78"></a><span class="w"> </span><span class="k">cycle</span>
|
|
<a id="ln-79" name="ln-79" href="#ln-79"></a><span class="k"> </span>
|
|
<a id="ln-80" name="ln-80" href="#ln-80"></a><span class="k"> else if</span><span class="w"> </span><span class="p">(</span><span class="n">buff</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="n">argl</span><span class="p">)</span><span class="w"> </span><span class="o">==</span><span class="w"> </span><span class="s1">'-v'</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-81" name="ln-81" href="#ln-81"></a><span class="k"> </span><span class="n">veMode</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="p">.</span><span class="n">true</span><span class="p">.</span><span class="w"></span>
|
|
<a id="ln-82" name="ln-82" href="#ln-82"></a><span class="w"> </span><span class="k">cycle</span>
|
|
<a id="ln-83" name="ln-83" href="#ln-83"></a><span class="k"> </span>
|
|
<a id="ln-84" name="ln-84" href="#ln-84"></a><span class="k"> else if</span><span class="w"> </span><span class="p">(</span><span class="n">buff</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="n">argl</span><span class="p">)</span><span class="w"> </span><span class="o">==</span><span class="w"> </span><span class="s1">'-h'</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-85" name="ln-85" href="#ln-85"></a><span class="k"> call </span><span class="n">help</span><span class="w"></span>
|
|
<a id="ln-86" name="ln-86" href="#ln-86"></a><span class="w"> </span><span class="k">stop</span>
|
|
<a id="ln-87" name="ln-87" href="#ln-87"></a><span class="k"> </span>
|
|
<a id="ln-88" name="ln-88" href="#ln-88"></a><span class="k"> end if</span>
|
|
<a id="ln-89" name="ln-89" href="#ln-89"></a>
|
|
<a id="ln-90" name="ln-90" href="#ln-90"></a><span class="k"> </span><span class="n">have_expression</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="p">.</span><span class="n">true</span><span class="p">.</span><span class="w"></span>
|
|
<a id="ln-91" name="ln-91" href="#ln-91"></a><span class="w"> </span>
|
|
<a id="ln-92" name="ln-92" href="#ln-92"></a><span class="w"> </span><span class="c">! Break the string up into a linked-list of tokens</span>
|
|
<a id="ln-93" name="ln-93" href="#ln-93"></a><span class="w"> </span><span class="k">call </span><span class="n">tokenize</span><span class="p">(</span><span class="n">buff</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="n">argl</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-94" name="ln-94" href="#ln-94"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">verbosity</span><span class="w"> </span><span class="o">></span><span class="w"> </span><span class="mi">0</span><span class="p">)</span><span class="w"> </span><span class="k">call </span><span class="n">print_ll</span><span class="p">(</span><span class="n">tokens</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-95" name="ln-95" href="#ln-95"></a><span class="w"> </span>
|
|
<a id="ln-96" name="ln-96" href="#ln-96"></a><span class="w"> </span><span class="c">! Interpret each token as a command and appky it</span>
|
|
<a id="ln-97" name="ln-97" href="#ln-97"></a><span class="w"> </span><span class="n">ok</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">tokens</span><span class="p">%</span><span class="n">iterate</span><span class="p">(</span><span class="n">apply_command</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-98" name="ln-98" href="#ln-98"></a><span class="w"> </span>
|
|
<a id="ln-99" name="ln-99" href="#ln-99"></a><span class="w"> </span><span class="c">! Do not print the stack at the end of a sequence -it's confusing</span>
|
|
<a id="ln-100" name="ln-100" href="#ln-100"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">in_sequence</span><span class="w"> </span><span class="o">/=</span><span class="w"> </span><span class="mi">2</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-101" name="ln-101" href="#ln-101"></a><span class="k"> call </span><span class="n">stack</span><span class="p">%</span><span class="k">print</span><span class="p">(</span><span class="n">veMode</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-102" name="ln-102" href="#ln-102"></a><span class="w"> </span><span class="k">end if</span><span class="w"></span>
|
|
<a id="ln-103" name="ln-103" href="#ln-103"></a><span class="w"> </span>
|
|
<a id="ln-104" name="ln-104" href="#ln-104"></a><span class="w"> </span><span class="c">! Tidy</span>
|
|
<a id="ln-105" name="ln-105" href="#ln-105"></a><span class="w"> </span><span class="k">call </span><span class="n">clear_ll</span><span class="p">(</span><span class="n">tokens</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-106" name="ln-106" href="#ln-106"></a>
|
|
<a id="ln-107" name="ln-107" href="#ln-107"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="w"> </span><span class="n">ok</span><span class="p">)</span><span class="w"> </span><span class="k">stop</span>
|
|
<a id="ln-108" name="ln-108" href="#ln-108"></a><span class="k"> </span>
|
|
<a id="ln-109" name="ln-109" href="#ln-109"></a><span class="k"> end do</span>
|
|
<a id="ln-110" name="ln-110" href="#ln-110"></a><span class="k"> </span>
|
|
<a id="ln-111" name="ln-111" href="#ln-111"></a><span class="k"> if</span><span class="w"> </span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="w"> </span><span class="n">have_expression</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-112" name="ln-112" href="#ln-112"></a><span class="k"> call </span><span class="n">stack</span><span class="p">%</span><span class="k">print</span><span class="p">(</span><span class="n">veMode</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-113" name="ln-113" href="#ln-113"></a><span class="w"> </span><span class="k">end if</span><span class="w"></span>
|
|
<a id="ln-114" name="ln-114" href="#ln-114"></a><span class="w"> </span>
|
|
<a id="ln-115" name="ln-115" href="#ln-115"></a><span class="w"> </span><span class="c">! Loop until quit</span>
|
|
<a id="ln-116" name="ln-116" href="#ln-116"></a><span class="w"> </span><span class="k">all</span><span class="w"> </span><span class="p">:</span><span class="k">do</span>
|
|
<a id="ln-117" name="ln-117" href="#ln-117"></a><span class="k"> </span><span class="n">x</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="mf">0.0d0</span><span class="w"></span>
|
|
<a id="ln-118" name="ln-118" href="#ln-118"></a><span class="w"> </span><span class="n">buff</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="s1">''</span><span class="w"></span>
|
|
<a id="ln-119" name="ln-119" href="#ln-119"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(a)'</span><span class="p">,</span><span class="n">advance</span><span class="o">=</span><span class="s1">'no'</span><span class="p">)</span><span class="w"> </span><span class="s1">':: '</span><span class="w"></span>
|
|
<a id="ln-120" name="ln-120" href="#ln-120"></a><span class="w"> </span><span class="k">read</span><span class="p">(</span><span class="mi">5</span><span class="p">,</span><span class="n">fmt</span><span class="o">=</span><span class="s1">'(a)'</span><span class="p">,</span><span class="n">iostat</span><span class="o">=</span><span class="n">ios</span><span class="p">,</span><span class="n">iomsg</span><span class="o">=</span><span class="n">msg</span><span class="p">)</span><span class="w"> </span><span class="n">buff</span><span class="w"></span>
|
|
<a id="ln-121" name="ln-121" href="#ln-121"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">ios</span><span class="w"> </span><span class="o">/=</span><span class="w"> </span><span class="mi">0</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-122" name="ln-122" href="#ln-122"></a><span class="k"> write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(/a)'</span><span class="p">)</span><span class="w"> </span><span class="s1">'Command:['</span><span class="o">//</span><span class="n">buff</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="n">blen</span><span class="p">)</span><span class="o">//</span><span class="s1">']'</span><span class="o">//</span><span class="s1">'; '</span><span class="o">//</span><span class="n">msg</span><span class="w"></span>
|
|
<a id="ln-123" name="ln-123" href="#ln-123"></a><span class="w"> </span><span class="k">cycle all</span>
|
|
<a id="ln-124" name="ln-124" href="#ln-124"></a><span class="k"> end if</span>
|
|
<a id="ln-125" name="ln-125" href="#ln-125"></a><span class="k"> </span><span class="n">buff</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">trim</span><span class="p">(</span><span class="nb">adjustl</span><span class="p">(</span><span class="n">buff</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-126" name="ln-126" href="#ln-126"></a><span class="w"> </span><span class="n">blen</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">len_trim</span><span class="p">(</span><span class="n">buff</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-127" name="ln-127" href="#ln-127"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">blen</span><span class="w"> </span><span class="o">==</span><span class="w"> </span><span class="mi">0</span><span class="p">)</span><span class="w"> </span><span class="k">cycle all</span><span class="w"></span>
|
|
<a id="ln-128" name="ln-128" href="#ln-128"></a>
|
|
<a id="ln-129" name="ln-129" href="#ln-129"></a><span class="w"> </span><span class="c">! Tokenize input string</span>
|
|
<a id="ln-130" name="ln-130" href="#ln-130"></a><span class="w"> </span><span class="k">call </span><span class="n">tokenize</span><span class="p">(</span><span class="n">buff</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="n">blen</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-131" name="ln-131" href="#ln-131"></a><span class="w"> </span><span class="n">ok</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">tokens</span><span class="p">%</span><span class="n">iterate</span><span class="p">(</span><span class="n">apply_command</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-132" name="ln-132" href="#ln-132"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="w"> </span><span class="n">ok</span><span class="p">)</span><span class="w"> </span><span class="k">exit all</span>
|
|
<a id="ln-133" name="ln-133" href="#ln-133"></a><span class="k"> </span>
|
|
<a id="ln-134" name="ln-134" href="#ln-134"></a><span class="k"> if</span><span class="w"> </span><span class="p">(</span><span class="n">in_sequence</span><span class="w"> </span><span class="o">==</span><span class="w"> </span><span class="mi">1</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-135" name="ln-135" href="#ln-135"></a><span class="k"> write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(i0)'</span><span class="p">)</span><span class="w"> </span><span class="n">n_seq</span><span class="w"></span>
|
|
<a id="ln-136" name="ln-136" href="#ln-136"></a><span class="w"> </span><span class="k">else if</span><span class="w"> </span><span class="p">(</span><span class="n">in_sequence</span><span class="w"> </span><span class="o">==</span><span class="w"> </span><span class="mi">2</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-137" name="ln-137" href="#ln-137"></a><span class="k"> </span><span class="n">in_sequence</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="mi">0</span><span class="w"></span>
|
|
<a id="ln-138" name="ln-138" href="#ln-138"></a><span class="w"> </span><span class="k">else</span>
|
|
<a id="ln-139" name="ln-139" href="#ln-139"></a><span class="k"> call </span><span class="n">stack</span><span class="p">%</span><span class="k">print</span><span class="p">(</span><span class="n">veMode</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-140" name="ln-140" href="#ln-140"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-141" name="ln-141" href="#ln-141"></a><span class="k"> end do all</span>
|
|
<a id="ln-142" name="ln-142" href="#ln-142"></a>
|
|
<a id="ln-143" name="ln-143" href="#ln-143"></a><span class="k"> call </span><span class="n">clear_ll</span><span class="p">(</span><span class="n">tokens</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-144" name="ln-144" href="#ln-144"></a><span class="w"> </span><span class="k">stop</span>
|
|
<a id="ln-145" name="ln-145" href="#ln-145"></a>
|
|
<a id="ln-146" name="ln-146" href="#ln-146"></a><span class="k">contains</span>
|
|
<a id="ln-147" name="ln-147" href="#ln-147"></a><span class="k"> </span>
|
|
<a id="ln-148" name="ln-148" href="#ln-148"></a><span class="k"> subroutine </span><span class="n">tokenize</span><span class="p">(</span><span class="n">com</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-149" name="ln-149" href="#ln-149"></a><span class="w"> </span><span class="kt">character</span><span class="p">(</span><span class="o">*</span><span class="p">),</span><span class="w"> </span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">com</span><span class="w"></span>
|
|
<a id="ln-150" name="ln-150" href="#ln-150"></a><span class="w"> </span><span class="kt">integer</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">start</span><span class="p">,</span><span class="w"> </span><span class="k">end</span>
|
|
<a id="ln-151" name="ln-151" href="#ln-151"></a><span class="k"> </span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="w"> </span><span class="k">allocatable</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">command</span><span class="w"></span>
|
|
<a id="ln-152" name="ln-152" href="#ln-152"></a><span class="w"> </span>
|
|
<a id="ln-153" name="ln-153" href="#ln-153"></a><span class="w"> </span><span class="k">call </span><span class="n">clear_ll</span><span class="p">(</span><span class="n">tokens</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-154" name="ln-154" href="#ln-154"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="nb">len_trim</span><span class="p">(</span><span class="n">com</span><span class="p">)</span><span class="w"> </span><span class="o">==</span><span class="w"> </span><span class="mi">0</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-155" name="ln-155" href="#ln-155"></a><span class="k"> return</span>
|
|
<a id="ln-156" name="ln-156" href="#ln-156"></a><span class="k"> end if</span>
|
|
<a id="ln-157" name="ln-157" href="#ln-157"></a><span class="k"> </span><span class="n">start</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="mi">1</span><span class="w"></span>
|
|
<a id="ln-158" name="ln-158" href="#ln-158"></a><span class="w"> </span><span class="c">! Ensure there are no leading and trailing spaces</span>
|
|
<a id="ln-159" name="ln-159" href="#ln-159"></a><span class="w"> </span><span class="n">command</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">trim</span><span class="p">(</span><span class="nb">adjustl</span><span class="p">(</span><span class="n">com</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-160" name="ln-160" href="#ln-160"></a><span class="w"> </span><span class="k">end</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">index</span><span class="p">(</span><span class="n">command</span><span class="p">,</span><span class="s1">' '</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-161" name="ln-161" href="#ln-161"></a><span class="w"> </span><span class="k">end</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">merge</span><span class="p">(</span><span class="nb">len</span><span class="p">(</span><span class="n">command</span><span class="p">),</span><span class="k">end</span><span class="o">-</span><span class="mi">1</span><span class="p">,</span><span class="k">end</span><span class="o">==</span><span class="mi">0</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-162" name="ln-162" href="#ln-162"></a><span class="w"> </span><span class="k">do</span>
|
|
<a id="ln-163" name="ln-163" href="#ln-163"></a><span class="k"> call </span><span class="n">append</span><span class="p">(</span><span class="n">tokens</span><span class="p">,</span><span class="n">command</span><span class="p">(</span><span class="n">start</span><span class="p">:</span><span class="k">end</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-164" name="ln-164" href="#ln-164"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="k">end</span><span class="w"> </span><span class="o">==</span><span class="w"> </span><span class="nb">len</span><span class="p">(</span><span class="n">command</span><span class="p">))</span><span class="w"> </span><span class="k">exit</span>
|
|
<a id="ln-165" name="ln-165" href="#ln-165"></a><span class="k"> </span><span class="n">start</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="k">end</span><span class="w"> </span><span class="o">+</span><span class="w"> </span><span class="n">nsp</span><span class="p">(</span><span class="n">command</span><span class="p">(</span><span class="k">end</span><span class="o">+</span><span class="mi">1</span><span class="p">:))</span><span class="w"></span>
|
|
<a id="ln-166" name="ln-166" href="#ln-166"></a><span class="w"> </span><span class="k">end</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">index</span><span class="p">(</span><span class="n">command</span><span class="p">(</span><span class="n">start</span><span class="p">:),</span><span class="s1">' '</span><span class="p">)</span><span class="w"> </span><span class="o">-</span><span class="w"> </span><span class="mi">1</span><span class="w"></span>
|
|
<a id="ln-167" name="ln-167" href="#ln-167"></a><span class="w"> </span><span class="k">end</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">merge</span><span class="p">(</span><span class="nb">len</span><span class="p">(</span><span class="n">command</span><span class="p">),</span><span class="k">end</span><span class="o">+</span><span class="n">start</span><span class="o">-</span><span class="mi">1</span><span class="p">,</span><span class="k">end</span><span class="w"> </span><span class="o">==</span><span class="w"> </span><span class="o">-</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-168" name="ln-168" href="#ln-168"></a><span class="w"> </span><span class="k">end do</span>
|
|
<a id="ln-169" name="ln-169" href="#ln-169"></a><span class="k"> end subroutine </span><span class="n">tokenize</span><span class="w"></span>
|
|
<a id="ln-170" name="ln-170" href="#ln-170"></a>
|
|
<a id="ln-171" name="ln-171" href="#ln-171"></a><span class="w"> </span><span class="k">subroutine </span><span class="n">help</span><span class="w"></span>
|
|
<a id="ln-172" name="ln-172" href="#ln-172"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(/a)'</span><span class="p">)</span><span class="w"> </span><span class="s1">'Command Calculator'</span><span class="w"></span>
|
|
<a id="ln-173" name="ln-173" href="#ln-173"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(a/)'</span><span class="p">)</span><span class="w"> </span><span class="s1">'=================='</span><span class="w"></span>
|
|
<a id="ln-174" name="ln-174" href="#ln-174"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(a)'</span><span class="p">)</span><span class="w"> </span><span class="s1">'Introduction'</span><span class="w"></span>
|
|
<a id="ln-175" name="ln-175" href="#ln-175"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(a/)'</span><span class="p">)</span><span class="w"> </span><span class="s1">'------------'</span><span class="w"></span>
|
|
<a id="ln-176" name="ln-176" href="#ln-176"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(a)'</span><span class="p">)</span><span class="w"> </span><span class="s1">'This is a command-line calculator. It supports both real and complex modes, as well'</span><span class="w"></span>
|
|
<a id="ln-177" name="ln-177" href="#ln-177"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(a)'</span><span class="p">)</span><span class="w"> </span><span class="s1">'as degrees/radians selection and precision control. It can be run interactively or as an'</span><span class="w"></span>
|
|
<a id="ln-178" name="ln-178" href="#ln-178"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(a/)'</span><span class="p">)</span><span class="w"> </span><span class="s1">'expression parser. This help is deliberately terse to encourage exploration.'</span><span class="w"></span>
|
|
<a id="ln-179" name="ln-179" href="#ln-179"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(a/)'</span><span class="p">)</span><span class="w"> </span><span class="s1">'-------------------------------------------------------------------------------'</span><span class="w"></span>
|
|
<a id="ln-180" name="ln-180" href="#ln-180"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(a)'</span><span class="p">)</span><span class="w"> </span><span class="s1">'Operators: + - * / ^ ^/x ^x ^2 ^/2 ^3 ^/3 ^*2 ^*10 || ! %'</span><span class="w"></span>
|
|
<a id="ln-181" name="ln-181" href="#ln-181"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(a)'</span><span class="p">)</span><span class="w"> </span><span class="s1">'Constants: pi e g G c two_pi pi_over_2'</span><span class="w"></span>
|
|
<a id="ln-182" name="ln-182" href="#ln-182"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(a)'</span><span class="p">)</span><span class="w"> </span><span class="s1">'Functions: sin cos tan asin acos atan sinh cosh tanh log2 log lg len sq sqrt cb cbrt'</span><span class="w"></span>
|
|
<a id="ln-183" name="ln-183" href="#ln-183"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(a)'</span><span class="p">)</span><span class="w"> </span><span class="s1">' alog2 alog alog10 gamma ncr npr rem int nint'</span><span class="w"></span>
|
|
<a id="ln-184" name="ln-184" href="#ln-184"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(a)'</span><span class="p">)</span><span class="w"> </span><span class="s1">' Controls: fix[0-9] clx cl cla '</span><span class="w"></span>
|
|
<a id="ln-185" name="ln-185" href="#ln-185"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(a)'</span><span class="p">)</span><span class="w"> </span><span class="s1">' Modes: real complex verbose terse degrees radians'</span><span class="w"></span>
|
|
<a id="ln-186" name="ln-186" href="#ln-186"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(a)'</span><span class="p">)</span><span class="w"> </span><span class="s1">' Memories: n=0...9 st<n> sw<n> rc<n> cl<n> m<n>+ m<n>- m<n>* m<n>/ msh'</span><span class="w"></span>
|
|
<a id="ln-187" name="ln-187" href="#ln-187"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(a)'</span><span class="p">)</span><span class="w"> </span><span class="s1">' Complex: ri _ || to_pol to_cart'</span><span class="w"></span>
|
|
<a id="ln-188" name="ln-188" href="#ln-188"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(a)'</span><span class="p">)</span><span class="w"> </span><span class="s1">' Actions: 1/ -- R r ? > < split drop'</span><span class="w"></span>
|
|
<a id="ln-189" name="ln-189" href="#ln-189"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(a)'</span><span class="p">)</span><span class="w"> </span><span class="s1">' Stats: { x1 x2 ... } { x1,y1 x2,y2 ... }'</span><span class="w"></span>
|
|
<a id="ln-190" name="ln-190" href="#ln-190"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(a)'</span><span class="p">)</span><span class="w"> </span><span class="s1">' n ux sx mx lqx uqx uy sy my lqy uqy a b cov corr'</span><span class="w"></span>
|
|
<a id="ln-191" name="ln-191" href="#ln-191"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(a/)'</span><span class="p">)</span><span class="w"> </span><span class="s1">' Quits: q'</span><span class="w"></span>
|
|
<a id="ln-192" name="ln-192" href="#ln-192"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(a/)'</span><span class="p">)</span><span class="w"> </span><span class="s1">'-------------------------------------------------------------------------------'</span><span class="w"></span>
|
|
<a id="ln-193" name="ln-193" href="#ln-193"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(a)'</span><span class="p">)</span><span class="w"> </span><span class="s1">'Examples'</span><span class="w"></span>
|
|
<a id="ln-194" name="ln-194" href="#ln-194"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(a)'</span><span class="p">)</span><span class="w"> </span><span class="s1">'--------'</span><span class="w"></span>
|
|
<a id="ln-195" name="ln-195" href="#ln-195"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(4x,a)'</span><span class="p">)</span><span class="w"> </span><span class="s1">'hp "fix2 18 2 - 8 2 / * =" -> 64.00'</span><span class="w"></span>
|
|
<a id="ln-196" name="ln-196" href="#ln-196"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(4x,a)'</span><span class="p">)</span><span class="w"> </span><span class="s1">'hp "2 -- complex sqrt =" -> (0.00000,-1.414214)'</span><span class="w"></span>
|
|
<a id="ln-197" name="ln-197" href="#ln-197"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(4x,a/)'</span><span class="p">)</span><span class="w"> </span><span class="s1">'hp -c "radians (1,pi_over_2)p ^ * degrees =" -> (1.000000,180.000000) p'</span><span class="w"></span>
|
|
<a id="ln-198" name="ln-198" href="#ln-198"></a>
|
|
<a id="ln-199" name="ln-199" href="#ln-199"></a><span class="w"> </span><span class="k">end subroutine </span><span class="n">help</span><span class="w"></span>
|
|
<a id="ln-200" name="ln-200" href="#ln-200"></a>
|
|
<a id="ln-201" name="ln-201" href="#ln-201"></a><span class="w"> </span><span class="k">subroutine </span><span class="n">apply_command</span><span class="p">(</span><span class="n">command</span><span class="p">,</span><span class="w"> </span><span class="n">ok</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-202" name="ln-202" href="#ln-202"></a><span class="w"> </span><span class="k">use</span><span class="p">,</span><span class="w"> </span><span class="k">intrinsic</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">ieee_arithmetic</span><span class="w"></span>
|
|
<a id="ln-203" name="ln-203" href="#ln-203"></a><span class="w"> </span><span class="k">implicit none</span>
|
|
<a id="ln-204" name="ln-204" href="#ln-204"></a><span class="k"> </span><span class="kt">character</span><span class="p">(</span><span class="o">*</span><span class="p">),</span><span class="w"> </span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">command</span><span class="w"></span>
|
|
<a id="ln-205" name="ln-205" href="#ln-205"></a><span class="w"> </span><span class="kt">logical</span><span class="p">,</span><span class="w"> </span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">ok</span><span class="w"></span>
|
|
<a id="ln-206" name="ln-206" href="#ln-206"></a>
|
|
<a id="ln-207" name="ln-207" href="#ln-207"></a><span class="w"> </span><span class="kt">real</span><span class="p">(</span><span class="mi">8</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">r</span><span class="p">,</span><span class="w"> </span><span class="n">im</span><span class="p">,</span><span class="w"> </span><span class="n">ang</span><span class="w"></span>
|
|
<a id="ln-208" name="ln-208" href="#ln-208"></a><span class="w"> </span><span class="kt">complex</span><span class="p">(</span><span class="mi">8</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">u</span><span class="p">,</span><span class="w"> </span><span class="n">z</span><span class="w"></span>
|
|
<a id="ln-209" name="ln-209" href="#ln-209"></a><span class="w"> </span><span class="kt">real</span><span class="p">(</span><span class="mi">8</span><span class="p">),</span><span class="w"> </span><span class="k">allocatable</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">tmp_seq</span><span class="p">(:)</span><span class="w"></span>
|
|
<a id="ln-210" name="ln-210" href="#ln-210"></a><span class="w"> </span><span class="k">type</span><span class="p">(</span><span class="n">rpn_t</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">us</span><span class="p">,</span><span class="w"> </span><span class="n">zs</span><span class="w"></span>
|
|
<a id="ln-211" name="ln-211" href="#ln-211"></a><span class="w"> </span><span class="kt">logical</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">is_cart</span><span class="w"></span>
|
|
<a id="ln-212" name="ln-212" href="#ln-212"></a><span class="w"> </span><span class="kt">integer</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">m</span><span class="p">,</span><span class="w"> </span><span class="n">idx</span><span class="w"></span>
|
|
<a id="ln-213" name="ln-213" href="#ln-213"></a><span class="w"> </span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="mi">1</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">comma</span><span class="w"></span>
|
|
<a id="ln-214" name="ln-214" href="#ln-214"></a><span class="w"> </span><span class="kt">character</span><span class="p">(</span><span class="mi">5</span><span class="p">),</span><span class="w"> </span><span class="k">parameter</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">lang</span><span class="p">(</span><span class="mi">2</span><span class="p">)</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="p">[</span><span class="s1">'POINT'</span><span class="p">,</span><span class="s1">'COMMA'</span><span class="p">]</span><span class="w"></span>
|
|
<a id="ln-215" name="ln-215" href="#ln-215"></a><span class="w"> </span>
|
|
<a id="ln-216" name="ln-216" href="#ln-216"></a><span class="w"> </span><span class="n">ok</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="p">.</span><span class="n">true</span><span class="p">.</span><span class="w"></span>
|
|
<a id="ln-217" name="ln-217" href="#ln-217"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="nb">len_trim</span><span class="p">(</span><span class="n">command</span><span class="p">)</span><span class="w"> </span><span class="o">==</span><span class="w"> </span><span class="mi">0</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-218" name="ln-218" href="#ln-218"></a><span class="k"> return</span>
|
|
<a id="ln-219" name="ln-219" href="#ln-219"></a><span class="k"> end if</span>
|
|
<a id="ln-220" name="ln-220" href="#ln-220"></a><span class="k"> </span>
|
|
<a id="ln-221" name="ln-221" href="#ln-221"></a><span class="k"> if</span><span class="w"> </span><span class="p">(</span><span class="n">verbosity</span><span class="w"> </span><span class="o">></span><span class="w"> </span><span class="mi">0</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-222" name="ln-222" href="#ln-222"></a><span class="k"> write</span><span class="p">(</span><span class="o">*</span><span class="p">,</span><span class="s1">'(a)'</span><span class="p">)</span><span class="w"> </span><span class="s1">'Applying: '</span><span class="o">//</span><span class="n">command</span><span class="w"></span>
|
|
<a id="ln-223" name="ln-223" href="#ln-223"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-224" name="ln-224" href="#ln-224"></a><span class="k"> </span>
|
|
<a id="ln-225" name="ln-225" href="#ln-225"></a><span class="k"> if</span><span class="w"> </span><span class="p">(</span><span class="n">in_sequence</span><span class="w"> </span><span class="o">==</span><span class="w"> </span><span class="mi">1</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-226" name="ln-226" href="#ln-226"></a><span class="k"> if</span><span class="w"> </span><span class="p">(</span><span class="n">command</span><span class="w"> </span><span class="o">==</span><span class="w"> </span><span class="s1">'}'</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-227" name="ln-227" href="#ln-227"></a><span class="k"> </span><span class="n">in_sequence</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="mi">2</span><span class="w"></span>
|
|
<a id="ln-228" name="ln-228" href="#ln-228"></a><span class="w"> </span><span class="n">complex_mode</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">tmp_cmode</span><span class="w"></span>
|
|
<a id="ln-229" name="ln-229" href="#ln-229"></a><span class="w"> </span><span class="k">call </span><span class="n">calculate_stats</span><span class="w"></span>
|
|
<a id="ln-230" name="ln-230" href="#ln-230"></a><span class="w"> </span>
|
|
<a id="ln-231" name="ln-231" href="#ln-231"></a><span class="w"> </span><span class="k">else</span><span class="w"></span>
|
|
<a id="ln-232" name="ln-232" href="#ln-232"></a><span class="w"> </span><span class="c">! All elements must be the same so either all x or all x,y</span>
|
|
<a id="ln-233" name="ln-233" href="#ln-233"></a><span class="w"> </span><span class="n">idx</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">index</span><span class="p">(</span><span class="n">command</span><span class="p">,</span><span class="s1">','</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-234" name="ln-234" href="#ln-234"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">n_seq</span><span class="w"> </span><span class="o">==</span><span class="w"> </span><span class="mi">0</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-235" name="ln-235" href="#ln-235"></a><span class="k"> </span><span class="n">seq_is_x</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="p">(</span><span class="n">idx</span><span class="w"> </span><span class="o">==</span><span class="w"> </span><span class="mi">0</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-236" name="ln-236" href="#ln-236"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-237" name="ln-237" href="#ln-237"></a><span class="k"> if</span><span class="w"> </span><span class="p">(</span><span class="n">seq_is_x</span><span class="w"> </span><span class="p">.</span><span class="n">neqv</span><span class="p">.</span><span class="w"> </span><span class="p">(</span><span class="n">idx</span><span class="w"> </span><span class="o">==</span><span class="w"> </span><span class="mi">0</span><span class="p">))</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-238" name="ln-238" href="#ln-238"></a><span class="k"> goto</span><span class="w"> </span><span class="mi">901</span><span class="w"></span>
|
|
<a id="ln-239" name="ln-239" href="#ln-239"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-240" name="ln-240" href="#ln-240"></a><span class="k"> if</span><span class="w"> </span><span class="p">(</span><span class="n">seq_is_x</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-241" name="ln-241" href="#ln-241"></a><span class="k"> read</span><span class="p">(</span><span class="n">command</span><span class="p">,</span><span class="o">*</span><span class="p">,</span><span class="n">err</span><span class="o">=</span><span class="mi">901</span><span class="p">)</span><span class="w"> </span><span class="n">r</span><span class="w"></span>
|
|
<a id="ln-242" name="ln-242" href="#ln-242"></a><span class="w"> </span><span class="n">im</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="mi">0</span><span class="w"></span>
|
|
<a id="ln-243" name="ln-243" href="#ln-243"></a><span class="w"> </span><span class="k">else</span>
|
|
<a id="ln-244" name="ln-244" href="#ln-244"></a><span class="k"> read</span><span class="p">(</span><span class="n">command</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="n">idx</span><span class="o">-</span><span class="mi">1</span><span class="p">),</span><span class="o">*</span><span class="p">,</span><span class="n">err</span><span class="o">=</span><span class="mi">901</span><span class="p">)</span><span class="w"> </span><span class="n">r</span><span class="w"></span>
|
|
<a id="ln-245" name="ln-245" href="#ln-245"></a><span class="w"> </span><span class="k">read</span><span class="p">(</span><span class="n">command</span><span class="p">(</span><span class="n">idx</span><span class="o">+</span><span class="mi">1</span><span class="p">:</span><span class="nb">len</span><span class="p">(</span><span class="n">command</span><span class="p">)),</span><span class="o">*</span><span class="p">,</span><span class="n">err</span><span class="o">=</span><span class="mi">901</span><span class="p">)</span><span class="w"> </span><span class="n">im</span><span class="w"></span>
|
|
<a id="ln-246" name="ln-246" href="#ln-246"></a><span class="w"> </span><span class="k">end if</span><span class="w"></span>
|
|
<a id="ln-247" name="ln-247" href="#ln-247"></a><span class="w"> </span><span class="c">! Initial allocation</span>
|
|
<a id="ln-248" name="ln-248" href="#ln-248"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">n_seq</span><span class="w"> </span><span class="o">==</span><span class="w"> </span><span class="mi">0</span><span class="w"> </span><span class="p">.</span><span class="nb">and</span><span class="p">.</span><span class="w"> </span><span class="p">.</span><span class="nb">not</span><span class="p">.</span><span class="w"> </span><span class="nb">allocated</span><span class="p">(</span><span class="n">x_seq</span><span class="p">))</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-249" name="ln-249" href="#ln-249"></a><span class="k"> allocate</span><span class="p">(</span><span class="n">x_seq</span><span class="p">(</span><span class="mi">10</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-250" name="ln-250" href="#ln-250"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="w"> </span><span class="n">seq_is_x</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-251" name="ln-251" href="#ln-251"></a><span class="k"> allocate</span><span class="p">(</span><span class="n">y_seq</span><span class="p">(</span><span class="mi">10</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-252" name="ln-252" href="#ln-252"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-253" name="ln-253" href="#ln-253"></a><span class="k"> end if</span>
|
|
<a id="ln-254" name="ln-254" href="#ln-254"></a><span class="k"> </span>
|
|
<a id="ln-255" name="ln-255" href="#ln-255"></a><span class="k"> if</span><span class="w"> </span><span class="p">(</span><span class="n">n_seq</span><span class="w"> </span><span class="o"><</span><span class="w"> </span><span class="n">size</span><span class="p">(</span><span class="n">x_seq</span><span class="p">))</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-256" name="ln-256" href="#ln-256"></a><span class="k"> </span><span class="n">n_seq</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">n_seq</span><span class="w"> </span><span class="o">+</span><span class="w"> </span><span class="mi">1</span><span class="w"></span>
|
|
<a id="ln-257" name="ln-257" href="#ln-257"></a><span class="w"> </span><span class="k">else</span><span class="w"></span>
|
|
<a id="ln-258" name="ln-258" href="#ln-258"></a><span class="w"> </span><span class="c">! Expand array</span>
|
|
<a id="ln-259" name="ln-259" href="#ln-259"></a><span class="w"> </span><span class="k">allocate</span><span class="p">(</span><span class="n">tmp_seq</span><span class="p">(</span><span class="n">n_seq</span><span class="w"> </span><span class="o">+</span><span class="w"> </span><span class="mi">10</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-260" name="ln-260" href="#ln-260"></a><span class="w"> </span><span class="n">tmp_seq</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="n">n_seq</span><span class="p">)</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">x_seq</span><span class="w"></span>
|
|
<a id="ln-261" name="ln-261" href="#ln-261"></a><span class="w"> </span><span class="k">call </span><span class="nb">move_alloc</span><span class="p">(</span><span class="n">tmp_seq</span><span class="p">,</span><span class="w"> </span><span class="n">x_seq</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-262" name="ln-262" href="#ln-262"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="w"> </span><span class="n">seq_is_x</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-263" name="ln-263" href="#ln-263"></a><span class="k"> allocate</span><span class="p">(</span><span class="n">tmp_seq</span><span class="p">(</span><span class="n">n_seq</span><span class="w"> </span><span class="o">+</span><span class="w"> </span><span class="mi">10</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-264" name="ln-264" href="#ln-264"></a><span class="w"> </span><span class="n">tmp_seq</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="n">n_seq</span><span class="p">)</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">y_seq</span><span class="w"></span>
|
|
<a id="ln-265" name="ln-265" href="#ln-265"></a><span class="w"> </span><span class="k">call </span><span class="nb">move_alloc</span><span class="p">(</span><span class="n">tmp_seq</span><span class="p">,</span><span class="w"> </span><span class="n">y_seq</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-266" name="ln-266" href="#ln-266"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-267" name="ln-267" href="#ln-267"></a><span class="k"> end if</span>
|
|
<a id="ln-268" name="ln-268" href="#ln-268"></a><span class="k"> </span><span class="n">x_seq</span><span class="p">(</span><span class="n">n_seq</span><span class="p">)</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">r</span><span class="w"></span>
|
|
<a id="ln-269" name="ln-269" href="#ln-269"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="w"> </span><span class="n">seq_is_x</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-270" name="ln-270" href="#ln-270"></a><span class="k"> </span><span class="n">y_seq</span><span class="p">(</span><span class="n">n_seq</span><span class="p">)</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">im</span><span class="w"></span>
|
|
<a id="ln-271" name="ln-271" href="#ln-271"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-272" name="ln-272" href="#ln-272"></a><span class="k"> if</span><span class="w"> </span><span class="p">(</span><span class="n">verbosity</span><span class="w"> </span><span class="o">></span><span class="w"> </span><span class="mi">0</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-273" name="ln-273" href="#ln-273"></a><span class="k"> print</span><span class="w"> </span><span class="o">*</span><span class="p">,</span><span class="n">x_seq</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="n">n_seq</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-274" name="ln-274" href="#ln-274"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-275" name="ln-275" href="#ln-275"></a><span class="k"> end if</span>
|
|
<a id="ln-276" name="ln-276" href="#ln-276"></a><span class="k"> return</span>
|
|
<a id="ln-277" name="ln-277" href="#ln-277"></a><span class="k"> end if</span>
|
|
<a id="ln-278" name="ln-278" href="#ln-278"></a><span class="k"> </span>
|
|
<a id="ln-279" name="ln-279" href="#ln-279"></a><span class="k"> select case</span><span class="p">(</span><span class="n">command</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-280" name="ln-280" href="#ln-280"></a><span class="w"> </span>
|
|
<a id="ln-281" name="ln-281" href="#ln-281"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'q'</span><span class="p">,</span><span class="s1">'quit'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-282" name="ln-282" href="#ln-282"></a><span class="w"> </span><span class="n">ok</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="p">.</span><span class="n">false</span><span class="p">.</span><span class="w"></span>
|
|
<a id="ln-283" name="ln-283" href="#ln-283"></a><span class="w"> </span><span class="k">return</span>
|
|
<a id="ln-284" name="ln-284" href="#ln-284"></a><span class="k"> </span>
|
|
<a id="ln-285" name="ln-285" href="#ln-285"></a><span class="k"> case</span><span class="p">(</span><span class="s1">'='</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-286" name="ln-286" href="#ln-286"></a><span class="w"> </span><span class="n">ok</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="p">.</span><span class="n">false</span><span class="p">.</span><span class="w"></span>
|
|
<a id="ln-287" name="ln-287" href="#ln-287"></a><span class="w"> </span><span class="k">return</span>
|
|
<a id="ln-288" name="ln-288" href="#ln-288"></a><span class="k"> </span>
|
|
<a id="ln-289" name="ln-289" href="#ln-289"></a><span class="k"> case</span><span class="p">(</span><span class="s1">'{'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-290" name="ln-290" href="#ln-290"></a><span class="w"> </span><span class="c">! Start sequence</span>
|
|
<a id="ln-291" name="ln-291" href="#ln-291"></a><span class="w"> </span><span class="n">in_sequence</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="mi">1</span><span class="w"></span>
|
|
<a id="ln-292" name="ln-292" href="#ln-292"></a><span class="w"> </span><span class="n">n_seq</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="mi">0</span><span class="w"></span>
|
|
<a id="ln-293" name="ln-293" href="#ln-293"></a><span class="w"> </span><span class="n">tmp_cmode</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">complex_mode</span><span class="w"></span>
|
|
<a id="ln-294" name="ln-294" href="#ln-294"></a><span class="w"> </span><span class="n">complex_mode</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="p">.</span><span class="n">false</span><span class="p">.</span><span class="w"></span>
|
|
<a id="ln-295" name="ln-295" href="#ln-295"></a><span class="w"> </span><span class="k">call </span><span class="n">stats</span><span class="p">%</span><span class="n">clear</span><span class="p">()</span><span class="w"></span>
|
|
<a id="ln-296" name="ln-296" href="#ln-296"></a><span class="w"> </span>
|
|
<a id="ln-297" name="ln-297" href="#ln-297"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'--'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-298" name="ln-298" href="#ln-298"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">chs_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-299" name="ln-299" href="#ln-299"></a><span class="w"> </span>
|
|
<a id="ln-300" name="ln-300" href="#ln-300"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'^'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-301" name="ln-301" href="#ln-301"></a><span class="w"> </span><span class="k">call </span><span class="n">stack</span><span class="p">%</span><span class="n">push</span><span class="p">(</span><span class="n">stack</span><span class="p">%</span><span class="n">peek</span><span class="p">(</span><span class="mi">1</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-302" name="ln-302" href="#ln-302"></a><span class="w"> </span>
|
|
<a id="ln-303" name="ln-303" href="#ln-303"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'+'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-304" name="ln-304" href="#ln-304"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_binary</span><span class="p">(</span><span class="n">add_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-305" name="ln-305" href="#ln-305"></a><span class="w"> </span>
|
|
<a id="ln-306" name="ln-306" href="#ln-306"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'-'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-307" name="ln-307" href="#ln-307"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_binary</span><span class="p">(</span><span class="n">subtract_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-308" name="ln-308" href="#ln-308"></a><span class="w"> </span>
|
|
<a id="ln-309" name="ln-309" href="#ln-309"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'*'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-310" name="ln-310" href="#ln-310"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_binary</span><span class="p">(</span><span class="n">multiply_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-311" name="ln-311" href="#ln-311"></a><span class="w"> </span>
|
|
<a id="ln-312" name="ln-312" href="#ln-312"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'/'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-313" name="ln-313" href="#ln-313"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_binary</span><span class="p">(</span><span class="n">divide_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-314" name="ln-314" href="#ln-314"></a><span class="w"> </span>
|
|
<a id="ln-315" name="ln-315" href="#ln-315"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'^x'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-316" name="ln-316" href="#ln-316"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_binary</span><span class="p">(</span><span class="n">power_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-317" name="ln-317" href="#ln-317"></a><span class="w"> </span>
|
|
<a id="ln-318" name="ln-318" href="#ln-318"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'^/x'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-319" name="ln-319" href="#ln-319"></a><span class="w"> </span><span class="c">! Only raising to a real power is supported</span>
|
|
<a id="ln-320" name="ln-320" href="#ln-320"></a><span class="w"> </span><span class="n">zs</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">stack</span><span class="p">%</span><span class="n">peek</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-321" name="ln-321" href="#ln-321"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">zs</span><span class="p">%</span><span class="n">is_real</span><span class="p">())</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-322" name="ln-322" href="#ln-322"></a><span class="k"> call </span><span class="n">invoke_binary</span><span class="p">(</span><span class="n">root_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-323" name="ln-323" href="#ln-323"></a><span class="w"> </span><span class="k">else</span>
|
|
<a id="ln-324" name="ln-324" href="#ln-324"></a><span class="k"> goto</span><span class="w"> </span><span class="mi">901</span><span class="w"></span>
|
|
<a id="ln-325" name="ln-325" href="#ln-325"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-326" name="ln-326" href="#ln-326"></a><span class="k"> </span>
|
|
<a id="ln-327" name="ln-327" href="#ln-327"></a><span class="k"> case</span><span class="p">(</span><span class="s1">'>'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-328" name="ln-328" href="#ln-328"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">next_root_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-329" name="ln-329" href="#ln-329"></a><span class="w"> </span>
|
|
<a id="ln-330" name="ln-330" href="#ln-330"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'<'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-331" name="ln-331" href="#ln-331"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">previous_root_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-332" name="ln-332" href="#ln-332"></a><span class="w"> </span>
|
|
<a id="ln-333" name="ln-333" href="#ln-333"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'%'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-334" name="ln-334" href="#ln-334"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_binary</span><span class="p">(</span><span class="n">percent_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-335" name="ln-335" href="#ln-335"></a><span class="w"> </span>
|
|
<a id="ln-336" name="ln-336" href="#ln-336"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'xy'</span><span class="p">,</span><span class="s1">'XY'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-337" name="ln-337" href="#ln-337"></a><span class="w"> </span><span class="k">call </span><span class="n">stack</span><span class="p">%</span><span class="n">swap</span><span class="w"></span>
|
|
<a id="ln-338" name="ln-338" href="#ln-338"></a><span class="w"> </span>
|
|
<a id="ln-339" name="ln-339" href="#ln-339"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'R'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-340" name="ln-340" href="#ln-340"></a><span class="w"> </span><span class="k">call </span><span class="n">stack</span><span class="p">%</span><span class="n">rotate_down</span><span class="w"></span>
|
|
<a id="ln-341" name="ln-341" href="#ln-341"></a><span class="w"> </span>
|
|
<a id="ln-342" name="ln-342" href="#ln-342"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'r'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-343" name="ln-343" href="#ln-343"></a><span class="w"> </span><span class="k">call </span><span class="n">stack</span><span class="p">%</span><span class="n">rotate_up</span><span class="w"></span>
|
|
<a id="ln-344" name="ln-344" href="#ln-344"></a><span class="w"> </span>
|
|
<a id="ln-345" name="ln-345" href="#ln-345"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'CLA'</span><span class="p">,</span><span class="s1">'cla'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-346" name="ln-346" href="#ln-346"></a><span class="w"> </span><span class="k">call </span><span class="n">stack</span><span class="p">%</span><span class="n">clear</span><span class="w"></span>
|
|
<a id="ln-347" name="ln-347" href="#ln-347"></a><span class="w"> </span><span class="n">mem</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">rpn_t</span><span class="p">()</span><span class="w"></span>
|
|
<a id="ln-348" name="ln-348" href="#ln-348"></a><span class="w"> </span><span class="k">call </span><span class="n">stats</span><span class="p">%</span><span class="n">clear</span><span class="w"></span>
|
|
<a id="ln-349" name="ln-349" href="#ln-349"></a><span class="w"> </span>
|
|
<a id="ln-350" name="ln-350" href="#ln-350"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'CL'</span><span class="p">,</span><span class="s1">'cl'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-351" name="ln-351" href="#ln-351"></a><span class="w"> </span><span class="k">call </span><span class="n">stack</span><span class="p">%</span><span class="n">clear</span><span class="w"></span>
|
|
<a id="ln-352" name="ln-352" href="#ln-352"></a>
|
|
<a id="ln-353" name="ln-353" href="#ln-353"></a><span class="w"> </span>
|
|
<a id="ln-354" name="ln-354" href="#ln-354"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'CLX'</span><span class="p">,</span><span class="s1">'clx'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-355" name="ln-355" href="#ln-355"></a><span class="w"> </span><span class="k">call </span><span class="n">stack</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="n">rpn_t</span><span class="p">())</span><span class="w"></span>
|
|
<a id="ln-356" name="ln-356" href="#ln-356"></a><span class="w"> </span>
|
|
<a id="ln-357" name="ln-357" href="#ln-357"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'_'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-358" name="ln-358" href="#ln-358"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">complex_mode</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-359" name="ln-359" href="#ln-359"></a><span class="k"> call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">conj_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-360" name="ln-360" href="#ln-360"></a><span class="w"> </span><span class="k">endif</span>
|
|
<a id="ln-361" name="ln-361" href="#ln-361"></a>
|
|
<a id="ln-362" name="ln-362" href="#ln-362"></a><span class="k"> case</span><span class="p">(</span><span class="s1">'len'</span><span class="p">,</span><span class="s1">'||'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-363" name="ln-363" href="#ln-363"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">complex_mode</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-364" name="ln-364" href="#ln-364"></a><span class="k"> call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">len_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-365" name="ln-365" href="#ln-365"></a><span class="w"> </span><span class="c">! Length is always reported as (x,0) and marked is_cartesian</span>
|
|
<a id="ln-366" name="ln-366" href="#ln-366"></a><span class="w"> </span><span class="n">zs</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">stack</span><span class="p">%</span><span class="n">peek</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-367" name="ln-367" href="#ln-367"></a><span class="w"> </span><span class="k">call </span><span class="n">zs</span><span class="p">%</span><span class="n">set_value</span><span class="p">(</span><span class="n">is_cartesian</span><span class="o">=</span><span class="p">.</span><span class="n">true</span><span class="p">.)</span><span class="w"></span>
|
|
<a id="ln-368" name="ln-368" href="#ln-368"></a><span class="w"> </span><span class="k">call </span><span class="n">stack</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="n">zs</span><span class="p">,</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-369" name="ln-369" href="#ln-369"></a><span class="w"> </span><span class="k">else</span>
|
|
<a id="ln-370" name="ln-370" href="#ln-370"></a><span class="k"> </span><span class="n">zs</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">stack</span><span class="p">%</span><span class="n">peek</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-371" name="ln-371" href="#ln-371"></a><span class="w"> </span><span class="n">z</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">zs</span><span class="p">%</span><span class="n">get_value</span><span class="p">()</span><span class="w"></span>
|
|
<a id="ln-372" name="ln-372" href="#ln-372"></a><span class="w"> </span><span class="n">us</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">stack</span><span class="p">%</span><span class="n">peek</span><span class="p">(</span><span class="mi">2</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-373" name="ln-373" href="#ln-373"></a><span class="w"> </span><span class="n">u</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">us</span><span class="p">%</span><span class="n">get_value</span><span class="p">()</span><span class="w"></span>
|
|
<a id="ln-374" name="ln-374" href="#ln-374"></a><span class="w"> </span><span class="k">call </span><span class="n">zs</span><span class="p">%</span><span class="n">set_value</span><span class="p">(</span><span class="nb">cmplx</span><span class="p">(</span><span class="nb">hypot</span><span class="p">(</span><span class="n">z</span><span class="p">%</span><span class="n">re</span><span class="p">,</span><span class="n">u</span><span class="p">%</span><span class="n">re</span><span class="p">),</span><span class="mi">0</span><span class="p">,</span><span class="mi">8</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-375" name="ln-375" href="#ln-375"></a><span class="w"> </span><span class="k">call </span><span class="n">stack</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="n">zs</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-376" name="ln-376" href="#ln-376"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-377" name="ln-377" href="#ln-377"></a><span class="k"> </span>
|
|
<a id="ln-378" name="ln-378" href="#ln-378"></a><span class="k"> case</span><span class="p">(</span><span class="s1">'split'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-379" name="ln-379" href="#ln-379"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="w"> </span><span class="n">complex_mode</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-380" name="ln-380" href="#ln-380"></a><span class="k"> </span><span class="n">zs</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">stack</span><span class="p">%</span><span class="n">pop</span><span class="p">()</span><span class="w"></span>
|
|
<a id="ln-381" name="ln-381" href="#ln-381"></a><span class="w"> </span><span class="n">x</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">zs</span><span class="p">%</span><span class="n">get_value</span><span class="p">()</span><span class="w"></span>
|
|
<a id="ln-382" name="ln-382" href="#ln-382"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">x</span><span class="w"> </span><span class="o">></span><span class="w"> </span><span class="mi">0</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-383" name="ln-383" href="#ln-383"></a><span class="k"> </span><span class="n">r</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">floor</span><span class="p">(</span><span class="n">x</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-384" name="ln-384" href="#ln-384"></a><span class="w"> </span><span class="k">else</span>
|
|
<a id="ln-385" name="ln-385" href="#ln-385"></a><span class="k"> </span><span class="n">r</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">ceiling</span><span class="p">(</span><span class="n">x</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-386" name="ln-386" href="#ln-386"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-387" name="ln-387" href="#ln-387"></a><span class="k"> </span><span class="n">im</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">x</span><span class="w"> </span><span class="o">-</span><span class="w"> </span><span class="n">r</span><span class="w"></span>
|
|
<a id="ln-388" name="ln-388" href="#ln-388"></a><span class="w"> </span><span class="k">call </span><span class="n">stack</span><span class="p">%</span><span class="n">push</span><span class="p">(</span><span class="n">im</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-389" name="ln-389" href="#ln-389"></a><span class="w"> </span><span class="k">call </span><span class="n">stack</span><span class="p">%</span><span class="n">push</span><span class="p">(</span><span class="n">r</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-390" name="ln-390" href="#ln-390"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-391" name="ln-391" href="#ln-391"></a><span class="k"> </span>
|
|
<a id="ln-392" name="ln-392" href="#ln-392"></a><span class="k"> case</span><span class="p">(</span><span class="s1">'int'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-393" name="ln-393" href="#ln-393"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="w"> </span><span class="n">complex_mode</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-394" name="ln-394" href="#ln-394"></a><span class="k"> </span><span class="n">zs</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">stack</span><span class="p">%</span><span class="n">peek</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-395" name="ln-395" href="#ln-395"></a><span class="w"> </span><span class="n">x</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">zs</span><span class="p">%</span><span class="n">get_value</span><span class="p">()</span><span class="w"></span>
|
|
<a id="ln-396" name="ln-396" href="#ln-396"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">x</span><span class="w"> </span><span class="o">></span><span class="w"> </span><span class="mi">0</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-397" name="ln-397" href="#ln-397"></a><span class="k"> </span><span class="n">r</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">floor</span><span class="p">(</span><span class="n">x</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-398" name="ln-398" href="#ln-398"></a><span class="w"> </span><span class="k">else</span>
|
|
<a id="ln-399" name="ln-399" href="#ln-399"></a><span class="k"> </span><span class="n">r</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">ceiling</span><span class="p">(</span><span class="n">x</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-400" name="ln-400" href="#ln-400"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-401" name="ln-401" href="#ln-401"></a><span class="k"> call </span><span class="n">zs</span><span class="p">%</span><span class="n">set_value</span><span class="p">(</span><span class="nb">cmplx</span><span class="p">(</span><span class="n">r</span><span class="p">,</span><span class="mi">0</span><span class="p">,</span><span class="mi">8</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-402" name="ln-402" href="#ln-402"></a><span class="w"> </span><span class="k">call </span><span class="n">stack</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="n">zs</span><span class="p">,</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-403" name="ln-403" href="#ln-403"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-404" name="ln-404" href="#ln-404"></a><span class="k"> </span>
|
|
<a id="ln-405" name="ln-405" href="#ln-405"></a><span class="k"> case</span><span class="p">(</span><span class="s1">'nint'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-406" name="ln-406" href="#ln-406"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="w"> </span><span class="n">complex_mode</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-407" name="ln-407" href="#ln-407"></a><span class="k"> </span><span class="n">zs</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">stack</span><span class="p">%</span><span class="n">peek</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-408" name="ln-408" href="#ln-408"></a><span class="w"> </span><span class="n">x</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">zs</span><span class="p">%</span><span class="n">get_value</span><span class="p">()</span><span class="w"></span>
|
|
<a id="ln-409" name="ln-409" href="#ln-409"></a><span class="w"> </span><span class="n">r</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">nint</span><span class="p">(</span><span class="n">x</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-410" name="ln-410" href="#ln-410"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="nb">mod</span><span class="p">(</span><span class="n">r</span><span class="p">,</span><span class="mf">2.0d0</span><span class="p">)</span><span class="w"> </span><span class="o">==</span><span class="w"> </span><span class="mi">1</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-411" name="ln-411" href="#ln-411"></a><span class="k"> </span><span class="n">r</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">r</span><span class="w"> </span><span class="o">-</span><span class="w"> </span><span class="mi">1</span><span class="w"></span>
|
|
<a id="ln-412" name="ln-412" href="#ln-412"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-413" name="ln-413" href="#ln-413"></a><span class="k"> call </span><span class="n">zs</span><span class="p">%</span><span class="n">set_value</span><span class="p">(</span><span class="nb">cmplx</span><span class="p">(</span><span class="n">r</span><span class="p">,</span><span class="mi">0</span><span class="p">,</span><span class="mi">8</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-414" name="ln-414" href="#ln-414"></a><span class="w"> </span><span class="k">call </span><span class="n">stack</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="n">zs</span><span class="p">,</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-415" name="ln-415" href="#ln-415"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-416" name="ln-416" href="#ln-416"></a><span class="k"> </span>
|
|
<a id="ln-417" name="ln-417" href="#ln-417"></a><span class="k"> case</span><span class="p">(</span><span class="s1">'rem'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-418" name="ln-418" href="#ln-418"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="w"> </span><span class="n">complex_mode</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-419" name="ln-419" href="#ln-419"></a><span class="k"> </span><span class="n">zs</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">stack</span><span class="p">%</span><span class="n">peek</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-420" name="ln-420" href="#ln-420"></a><span class="w"> </span><span class="n">x</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">zs</span><span class="p">%</span><span class="n">get_value</span><span class="p">()</span><span class="w"></span>
|
|
<a id="ln-421" name="ln-421" href="#ln-421"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">x</span><span class="w"> </span><span class="o">></span><span class="w"> </span><span class="mi">0</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-422" name="ln-422" href="#ln-422"></a><span class="k"> </span><span class="n">r</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">floor</span><span class="p">(</span><span class="n">x</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-423" name="ln-423" href="#ln-423"></a><span class="w"> </span><span class="k">else</span>
|
|
<a id="ln-424" name="ln-424" href="#ln-424"></a><span class="k"> </span><span class="n">r</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">ceiling</span><span class="p">(</span><span class="n">x</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-425" name="ln-425" href="#ln-425"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-426" name="ln-426" href="#ln-426"></a><span class="k"> </span><span class="n">im</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">x</span><span class="w"> </span><span class="o">-</span><span class="w"> </span><span class="n">r</span><span class="w"></span>
|
|
<a id="ln-427" name="ln-427" href="#ln-427"></a><span class="w"> </span><span class="k">call </span><span class="n">zs</span><span class="p">%</span><span class="n">set_value</span><span class="p">(</span><span class="nb">cmplx</span><span class="p">(</span><span class="n">im</span><span class="p">,</span><span class="mi">0</span><span class="p">,</span><span class="mi">8</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-428" name="ln-428" href="#ln-428"></a><span class="w"> </span><span class="k">call </span><span class="n">stack</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="n">zs</span><span class="p">,</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-429" name="ln-429" href="#ln-429"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-430" name="ln-430" href="#ln-430"></a><span class="k"> </span>
|
|
<a id="ln-431" name="ln-431" href="#ln-431"></a><span class="k"> case</span><span class="p">(</span><span class="s1">'drop'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-432" name="ln-432" href="#ln-432"></a><span class="w"> </span><span class="n">zs</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">stack</span><span class="p">%</span><span class="n">pop</span><span class="p">()</span><span class="w"></span>
|
|
<a id="ln-433" name="ln-433" href="#ln-433"></a><span class="w"> </span>
|
|
<a id="ln-434" name="ln-434" href="#ln-434"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'ri'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-435" name="ln-435" href="#ln-435"></a><span class="w"> </span><span class="c">! Swap real and imaginary parts</span>
|
|
<a id="ln-436" name="ln-436" href="#ln-436"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">complex_mode</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-437" name="ln-437" href="#ln-437"></a><span class="k"> call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">swap_real_imaginary_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-438" name="ln-438" href="#ln-438"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-439" name="ln-439" href="#ln-439"></a>
|
|
<a id="ln-440" name="ln-440" href="#ln-440"></a><span class="k"> case</span><span class="p">(</span><span class="s1">'to_pol'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-441" name="ln-441" href="#ln-441"></a><span class="w"> </span><span class="c">! Convert x + iy to r + i theta</span>
|
|
<a id="ln-442" name="ln-442" href="#ln-442"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">complex_mode</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-443" name="ln-443" href="#ln-443"></a><span class="k"> </span><span class="n">zs</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">stack</span><span class="p">%</span><span class="n">peek</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-444" name="ln-444" href="#ln-444"></a><span class="w"> </span><span class="k">call </span><span class="n">stack</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="n">to_polar</span><span class="p">(</span><span class="n">zs</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-445" name="ln-445" href="#ln-445"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-446" name="ln-446" href="#ln-446"></a>
|
|
<a id="ln-447" name="ln-447" href="#ln-447"></a><span class="k"> case</span><span class="p">(</span><span class="s1">'to_cart'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-448" name="ln-448" href="#ln-448"></a><span class="w"> </span><span class="c">! Convert (r,theta) to (x,y)</span>
|
|
<a id="ln-449" name="ln-449" href="#ln-449"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">complex_mode</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-450" name="ln-450" href="#ln-450"></a><span class="k"> </span><span class="n">zs</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">stack</span><span class="p">%</span><span class="n">peek</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-451" name="ln-451" href="#ln-451"></a><span class="w"> </span><span class="k">call </span><span class="n">stack</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="n">to_cartesian</span><span class="p">(</span><span class="n">zs</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-452" name="ln-452" href="#ln-452"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-453" name="ln-453" href="#ln-453"></a><span class="k"> </span>
|
|
<a id="ln-454" name="ln-454" href="#ln-454"></a><span class="k"> case</span><span class="p">(</span><span class="s1">'1/'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-455" name="ln-455" href="#ln-455"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">reciprocal_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-456" name="ln-456" href="#ln-456"></a><span class="w"> </span>
|
|
<a id="ln-457" name="ln-457" href="#ln-457"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'^2'</span><span class="p">,</span><span class="s1">'sq'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-458" name="ln-458" href="#ln-458"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">power_2_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-459" name="ln-459" href="#ln-459"></a><span class="w"> </span>
|
|
<a id="ln-460" name="ln-460" href="#ln-460"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'^/2'</span><span class="p">,</span><span class="s1">'sqrt'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-461" name="ln-461" href="#ln-461"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">sqrt_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-462" name="ln-462" href="#ln-462"></a><span class="w"> </span>
|
|
<a id="ln-463" name="ln-463" href="#ln-463"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'^3'</span><span class="p">,</span><span class="s1">'cb'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-464" name="ln-464" href="#ln-464"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">power_3_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-465" name="ln-465" href="#ln-465"></a><span class="w"> </span>
|
|
<a id="ln-466" name="ln-466" href="#ln-466"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'^/3'</span><span class="p">,</span><span class="s1">'cbrt'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-467" name="ln-467" href="#ln-467"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">cbrt_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-468" name="ln-468" href="#ln-468"></a><span class="w"> </span>
|
|
<a id="ln-469" name="ln-469" href="#ln-469"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'^*2'</span><span class="p">,</span><span class="s1">'alog2'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-470" name="ln-470" href="#ln-470"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">exp_2_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-471" name="ln-471" href="#ln-471"></a><span class="w"> </span>
|
|
<a id="ln-472" name="ln-472" href="#ln-472"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'^*10'</span><span class="p">,</span><span class="s1">'alog10'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-473" name="ln-473" href="#ln-473"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">exp_10_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-474" name="ln-474" href="#ln-474"></a>
|
|
<a id="ln-475" name="ln-475" href="#ln-475"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'exp'</span><span class="p">,</span><span class="s1">'alog'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-476" name="ln-476" href="#ln-476"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">exp_e_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-477" name="ln-477" href="#ln-477"></a>
|
|
<a id="ln-478" name="ln-478" href="#ln-478"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'ln'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-479" name="ln-479" href="#ln-479"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">ln_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-480" name="ln-480" href="#ln-480"></a>
|
|
<a id="ln-481" name="ln-481" href="#ln-481"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'log2'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-482" name="ln-482" href="#ln-482"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">log2_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-483" name="ln-483" href="#ln-483"></a>
|
|
<a id="ln-484" name="ln-484" href="#ln-484"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'lg'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-485" name="ln-485" href="#ln-485"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">lg_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-486" name="ln-486" href="#ln-486"></a>
|
|
<a id="ln-487" name="ln-487" href="#ln-487"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'sinh'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-488" name="ln-488" href="#ln-488"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">hsine_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-489" name="ln-489" href="#ln-489"></a>
|
|
<a id="ln-490" name="ln-490" href="#ln-490"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'cosh'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-491" name="ln-491" href="#ln-491"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">hcosine_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-492" name="ln-492" href="#ln-492"></a>
|
|
<a id="ln-493" name="ln-493" href="#ln-493"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'tanh'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-494" name="ln-494" href="#ln-494"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">htangent_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-495" name="ln-495" href="#ln-495"></a>
|
|
<a id="ln-496" name="ln-496" href="#ln-496"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'sin'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-497" name="ln-497" href="#ln-497"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">sine_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-498" name="ln-498" href="#ln-498"></a>
|
|
<a id="ln-499" name="ln-499" href="#ln-499"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'cos'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-500" name="ln-500" href="#ln-500"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">cosine_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-501" name="ln-501" href="#ln-501"></a>
|
|
<a id="ln-502" name="ln-502" href="#ln-502"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'tan'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-503" name="ln-503" href="#ln-503"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">tangent_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-504" name="ln-504" href="#ln-504"></a>
|
|
<a id="ln-505" name="ln-505" href="#ln-505"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'asin'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-506" name="ln-506" href="#ln-506"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">asine_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-507" name="ln-507" href="#ln-507"></a>
|
|
<a id="ln-508" name="ln-508" href="#ln-508"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'asinh'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-509" name="ln-509" href="#ln-509"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">ahsine_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-510" name="ln-510" href="#ln-510"></a>
|
|
<a id="ln-511" name="ln-511" href="#ln-511"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'acos'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-512" name="ln-512" href="#ln-512"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">acosine_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-513" name="ln-513" href="#ln-513"></a>
|
|
<a id="ln-514" name="ln-514" href="#ln-514"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'acosh'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-515" name="ln-515" href="#ln-515"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">ahcosine_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-516" name="ln-516" href="#ln-516"></a>
|
|
<a id="ln-517" name="ln-517" href="#ln-517"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'atan'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-518" name="ln-518" href="#ln-518"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">atangent_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-519" name="ln-519" href="#ln-519"></a>
|
|
<a id="ln-520" name="ln-520" href="#ln-520"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'atanh'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-521" name="ln-521" href="#ln-521"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">ahtangent_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-522" name="ln-522" href="#ln-522"></a>
|
|
<a id="ln-523" name="ln-523" href="#ln-523"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'atan2'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-524" name="ln-524" href="#ln-524"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_binary</span><span class="p">(</span><span class="n">atangent2_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-525" name="ln-525" href="#ln-525"></a>
|
|
<a id="ln-526" name="ln-526" href="#ln-526"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'gamma'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-527" name="ln-527" href="#ln-527"></a><span class="w"> </span><span class="k">call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">gamma_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-528" name="ln-528" href="#ln-528"></a>
|
|
<a id="ln-529" name="ln-529" href="#ln-529"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'!'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-530" name="ln-530" href="#ln-530"></a><span class="w"> </span><span class="n">zs</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">stack</span><span class="p">%</span><span class="n">peek</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-531" name="ln-531" href="#ln-531"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">zs</span><span class="p">%</span><span class="n">is_positive_real</span><span class="p">())</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-532" name="ln-532" href="#ln-532"></a><span class="k"> call </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">fact_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-533" name="ln-533" href="#ln-533"></a><span class="w"> </span><span class="k">else</span>
|
|
<a id="ln-534" name="ln-534" href="#ln-534"></a><span class="k"> goto</span><span class="w"> </span><span class="mi">901</span><span class="w"></span>
|
|
<a id="ln-535" name="ln-535" href="#ln-535"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-536" name="ln-536" href="#ln-536"></a>
|
|
<a id="ln-537" name="ln-537" href="#ln-537"></a><span class="k"> case</span><span class="p">(</span><span class="s1">'ncr'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-538" name="ln-538" href="#ln-538"></a><span class="w"> </span><span class="n">zs</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">stack</span><span class="p">%</span><span class="n">peek</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-539" name="ln-539" href="#ln-539"></a><span class="w"> </span><span class="n">us</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">stack</span><span class="p">%</span><span class="n">peek</span><span class="p">(</span><span class="mi">2</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-540" name="ln-540" href="#ln-540"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">zs</span><span class="p">%</span><span class="n">is_positive_real</span><span class="p">()</span><span class="w"> </span><span class="p">.</span><span class="nb">and</span><span class="p">.</span><span class="w"> </span><span class="n">us</span><span class="p">%</span><span class="n">is_positive_real</span><span class="p">())</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-541" name="ln-541" href="#ln-541"></a><span class="k"> call </span><span class="n">invoke_binary</span><span class="p">(</span><span class="n">ncr_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-542" name="ln-542" href="#ln-542"></a><span class="w"> </span><span class="k">else</span>
|
|
<a id="ln-543" name="ln-543" href="#ln-543"></a><span class="k"> goto</span><span class="w"> </span><span class="mi">901</span><span class="w"></span>
|
|
<a id="ln-544" name="ln-544" href="#ln-544"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-545" name="ln-545" href="#ln-545"></a>
|
|
<a id="ln-546" name="ln-546" href="#ln-546"></a><span class="k"> case</span><span class="p">(</span><span class="s1">'npr'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-547" name="ln-547" href="#ln-547"></a><span class="w"> </span><span class="n">zs</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">stack</span><span class="p">%</span><span class="n">peek</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-548" name="ln-548" href="#ln-548"></a><span class="w"> </span><span class="n">us</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">stack</span><span class="p">%</span><span class="n">peek</span><span class="p">(</span><span class="mi">2</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-549" name="ln-549" href="#ln-549"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">zs</span><span class="p">%</span><span class="n">is_positive_real</span><span class="p">()</span><span class="w"> </span><span class="p">.</span><span class="nb">and</span><span class="p">.</span><span class="w"> </span><span class="n">us</span><span class="p">%</span><span class="n">is_positive_real</span><span class="p">())</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-550" name="ln-550" href="#ln-550"></a><span class="k"> call </span><span class="n">invoke_binary</span><span class="p">(</span><span class="n">npr_fr</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-551" name="ln-551" href="#ln-551"></a><span class="w"> </span><span class="k">else</span>
|
|
<a id="ln-552" name="ln-552" href="#ln-552"></a><span class="k"> goto</span><span class="w"> </span><span class="mi">901</span><span class="w"></span>
|
|
<a id="ln-553" name="ln-553" href="#ln-553"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-554" name="ln-554" href="#ln-554"></a><span class="k"> </span>
|
|
<a id="ln-555" name="ln-555" href="#ln-555"></a><span class="k"> case</span><span class="p">(</span><span class="s1">'m0+'</span><span class="p">,</span><span class="s1">'m1+'</span><span class="p">,</span><span class="s1">'m2+'</span><span class="p">,</span><span class="s1">'m3+'</span><span class="p">,</span><span class="s1">'m4+'</span><span class="p">,</span><span class="s1">'m5+'</span><span class="p">,</span><span class="s1">'m6+'</span><span class="p">,</span><span class="s1">'m7+'</span><span class="p">,</span><span class="s1">'m8+'</span><span class="p">,</span><span class="s1">'m9+'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-556" name="ln-556" href="#ln-556"></a><span class="w"> </span><span class="k">read</span><span class="p">(</span><span class="n">command</span><span class="p">(</span><span class="mi">2</span><span class="p">:</span><span class="mi">2</span><span class="p">),</span><span class="s1">'(i1)'</span><span class="p">,</span><span class="n">err</span><span class="o">=</span><span class="mi">901</span><span class="p">)</span><span class="w"> </span><span class="n">m</span><span class="w"></span>
|
|
<a id="ln-557" name="ln-557" href="#ln-557"></a><span class="w"> </span><span class="n">mem</span><span class="p">(</span><span class="n">m</span><span class="p">)</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">mem</span><span class="p">(</span><span class="n">m</span><span class="p">)</span><span class="w"> </span><span class="o">+</span><span class="w"> </span><span class="n">stack</span><span class="p">%</span><span class="n">peek</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-558" name="ln-558" href="#ln-558"></a>
|
|
<a id="ln-559" name="ln-559" href="#ln-559"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'m0-'</span><span class="p">,</span><span class="s1">'m1-'</span><span class="p">,</span><span class="s1">'m2-'</span><span class="p">,</span><span class="s1">'m3-'</span><span class="p">,</span><span class="s1">'m4-'</span><span class="p">,</span><span class="s1">'m5-'</span><span class="p">,</span><span class="s1">'m6-'</span><span class="p">,</span><span class="s1">'m7-'</span><span class="p">,</span><span class="s1">'m8-'</span><span class="p">,</span><span class="s1">'m9-'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-560" name="ln-560" href="#ln-560"></a><span class="w"> </span><span class="k">read</span><span class="p">(</span><span class="n">command</span><span class="p">(</span><span class="mi">2</span><span class="p">:</span><span class="mi">2</span><span class="p">),</span><span class="s1">'(i1)'</span><span class="p">,</span><span class="n">err</span><span class="o">=</span><span class="mi">901</span><span class="p">)</span><span class="w"> </span><span class="n">m</span><span class="w"></span>
|
|
<a id="ln-561" name="ln-561" href="#ln-561"></a><span class="w"> </span><span class="n">mem</span><span class="p">(</span><span class="n">m</span><span class="p">)</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">mem</span><span class="p">(</span><span class="n">m</span><span class="p">)</span><span class="w"> </span><span class="o">-</span><span class="w"> </span><span class="n">stack</span><span class="p">%</span><span class="n">peek</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-562" name="ln-562" href="#ln-562"></a>
|
|
<a id="ln-563" name="ln-563" href="#ln-563"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'m0*'</span><span class="p">,</span><span class="s1">'m1*'</span><span class="p">,</span><span class="s1">'m2*'</span><span class="p">,</span><span class="s1">'m3*'</span><span class="p">,</span><span class="s1">'m4*'</span><span class="p">,</span><span class="s1">'m5*'</span><span class="p">,</span><span class="s1">'m6*'</span><span class="p">,</span><span class="s1">'m7*'</span><span class="p">,</span><span class="s1">'m8*'</span><span class="p">,</span><span class="s1">'m9*'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-564" name="ln-564" href="#ln-564"></a><span class="w"> </span><span class="k">read</span><span class="p">(</span><span class="n">command</span><span class="p">(</span><span class="mi">2</span><span class="p">:</span><span class="mi">2</span><span class="p">),</span><span class="s1">'(i1)'</span><span class="p">,</span><span class="n">err</span><span class="o">=</span><span class="mi">901</span><span class="p">)</span><span class="w"> </span><span class="n">m</span><span class="w"></span>
|
|
<a id="ln-565" name="ln-565" href="#ln-565"></a><span class="w"> </span><span class="n">mem</span><span class="p">(</span><span class="n">m</span><span class="p">)</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">mem</span><span class="p">(</span><span class="n">m</span><span class="p">)</span><span class="w"> </span><span class="o">*</span><span class="w"> </span><span class="n">stack</span><span class="p">%</span><span class="n">peek</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-566" name="ln-566" href="#ln-566"></a>
|
|
<a id="ln-567" name="ln-567" href="#ln-567"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'m0/'</span><span class="p">,</span><span class="s1">'m1/'</span><span class="p">,</span><span class="s1">'m2/'</span><span class="p">,</span><span class="s1">'m3/'</span><span class="p">,</span><span class="s1">'m4/'</span><span class="p">,</span><span class="s1">'m5/'</span><span class="p">,</span><span class="s1">'m6/'</span><span class="p">,</span><span class="s1">'m7/'</span><span class="p">,</span><span class="s1">'m8/'</span><span class="p">,</span><span class="s1">'m9/'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-568" name="ln-568" href="#ln-568"></a><span class="w"> </span><span class="k">read</span><span class="p">(</span><span class="n">command</span><span class="p">(</span><span class="mi">2</span><span class="p">:</span><span class="mi">2</span><span class="p">),</span><span class="s1">'(i1)'</span><span class="p">,</span><span class="n">err</span><span class="o">=</span><span class="mi">901</span><span class="p">)</span><span class="w"> </span><span class="n">m</span><span class="w"></span>
|
|
<a id="ln-569" name="ln-569" href="#ln-569"></a><span class="w"> </span><span class="n">mem</span><span class="p">(</span><span class="n">m</span><span class="p">)</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">mem</span><span class="p">(</span><span class="n">m</span><span class="p">)</span><span class="w"> </span><span class="o">/</span><span class="w"> </span><span class="n">stack</span><span class="p">%</span><span class="n">peek</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-570" name="ln-570" href="#ln-570"></a>
|
|
<a id="ln-571" name="ln-571" href="#ln-571"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'st0'</span><span class="p">,</span><span class="s1">'st1'</span><span class="p">,</span><span class="s1">'st2'</span><span class="p">,</span><span class="s1">'st3'</span><span class="p">,</span><span class="s1">'st4'</span><span class="p">,</span><span class="s1">'st5'</span><span class="p">,</span><span class="s1">'st6'</span><span class="p">,</span><span class="s1">'st7'</span><span class="p">,</span><span class="s1">'st8'</span><span class="p">,</span><span class="s1">'st9'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-572" name="ln-572" href="#ln-572"></a><span class="w"> </span><span class="k">read</span><span class="p">(</span><span class="n">command</span><span class="p">(</span><span class="mi">3</span><span class="p">:</span><span class="mi">3</span><span class="p">),</span><span class="s1">'(i1)'</span><span class="p">,</span><span class="n">err</span><span class="o">=</span><span class="mi">901</span><span class="p">)</span><span class="w"> </span><span class="n">m</span><span class="w"></span>
|
|
<a id="ln-573" name="ln-573" href="#ln-573"></a><span class="w"> </span><span class="n">mem</span><span class="p">(</span><span class="n">m</span><span class="p">)</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">stack</span><span class="p">%</span><span class="n">peek</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-574" name="ln-574" href="#ln-574"></a>
|
|
<a id="ln-575" name="ln-575" href="#ln-575"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'sw0'</span><span class="p">,</span><span class="s1">'sw1'</span><span class="p">,</span><span class="s1">'sw2'</span><span class="p">,</span><span class="s1">'sw3'</span><span class="p">,</span><span class="s1">'sw4'</span><span class="p">,</span><span class="s1">'sw5'</span><span class="p">,</span><span class="s1">'sw6'</span><span class="p">,</span><span class="s1">'sw7'</span><span class="p">,</span><span class="s1">'sw8'</span><span class="p">,</span><span class="s1">'sw9'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-576" name="ln-576" href="#ln-576"></a><span class="w"> </span><span class="k">read</span><span class="p">(</span><span class="n">command</span><span class="p">(</span><span class="mi">3</span><span class="p">:</span><span class="mi">3</span><span class="p">),</span><span class="s1">'(i1)'</span><span class="p">,</span><span class="n">err</span><span class="o">=</span><span class="mi">901</span><span class="p">)</span><span class="w"> </span><span class="n">m</span><span class="w"></span>
|
|
<a id="ln-577" name="ln-577" href="#ln-577"></a><span class="w"> </span><span class="n">zs</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">stack</span><span class="p">%</span><span class="n">peek</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-578" name="ln-578" href="#ln-578"></a><span class="w"> </span><span class="k">call </span><span class="n">stack</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="n">mem</span><span class="p">(</span><span class="n">m</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-579" name="ln-579" href="#ln-579"></a><span class="w"> </span><span class="n">mem</span><span class="p">(</span><span class="n">m</span><span class="p">)</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">zs</span><span class="w"></span>
|
|
<a id="ln-580" name="ln-580" href="#ln-580"></a>
|
|
<a id="ln-581" name="ln-581" href="#ln-581"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'rc0'</span><span class="p">,</span><span class="s1">'rc1'</span><span class="p">,</span><span class="s1">'rc2'</span><span class="p">,</span><span class="s1">'rc3'</span><span class="p">,</span><span class="s1">'rc4'</span><span class="p">,</span><span class="s1">'rc5'</span><span class="p">,</span><span class="s1">'rc6'</span><span class="p">,</span><span class="s1">'rc7'</span><span class="p">,</span><span class="s1">'rc8'</span><span class="p">,</span><span class="s1">'rc9'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-582" name="ln-582" href="#ln-582"></a><span class="w"> </span><span class="k">read</span><span class="p">(</span><span class="n">command</span><span class="p">(</span><span class="mi">3</span><span class="p">:</span><span class="mi">3</span><span class="p">),</span><span class="s1">'(i1)'</span><span class="p">,</span><span class="n">err</span><span class="o">=</span><span class="mi">901</span><span class="p">)</span><span class="w"> </span><span class="n">m</span><span class="w"></span>
|
|
<a id="ln-583" name="ln-583" href="#ln-583"></a><span class="w"> </span><span class="k">call </span><span class="n">stack</span><span class="p">%</span><span class="n">push</span><span class="p">(</span><span class="n">mem</span><span class="p">(</span><span class="n">m</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-584" name="ln-584" href="#ln-584"></a>
|
|
<a id="ln-585" name="ln-585" href="#ln-585"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'cl0'</span><span class="p">,</span><span class="s1">'cl1'</span><span class="p">,</span><span class="s1">'cl2'</span><span class="p">,</span><span class="s1">'cl3'</span><span class="p">,</span><span class="s1">'cl4'</span><span class="p">,</span><span class="s1">'cl5'</span><span class="p">,</span><span class="s1">'cl6'</span><span class="p">,</span><span class="s1">'cl7'</span><span class="p">,</span><span class="s1">'cl8'</span><span class="p">,</span><span class="s1">'cl9'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-586" name="ln-586" href="#ln-586"></a><span class="w"> </span><span class="k">read</span><span class="p">(</span><span class="n">command</span><span class="p">(</span><span class="mi">3</span><span class="p">:</span><span class="mi">3</span><span class="p">),</span><span class="s1">'(i1)'</span><span class="p">,</span><span class="n">err</span><span class="o">=</span><span class="mi">901</span><span class="p">)</span><span class="w"> </span><span class="n">m</span><span class="w"></span>
|
|
<a id="ln-587" name="ln-587" href="#ln-587"></a><span class="w"> </span><span class="n">mem</span><span class="p">(</span><span class="n">m</span><span class="p">)</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">rpn_t</span><span class="p">()</span><span class="w"></span>
|
|
<a id="ln-588" name="ln-588" href="#ln-588"></a>
|
|
<a id="ln-589" name="ln-589" href="#ln-589"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'msh'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-590" name="ln-590" href="#ln-590"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(i3,a,dt)'</span><span class="p">)</span><span class="w"> </span><span class="p">(</span><span class="n">i</span><span class="p">,</span><span class="s1">': '</span><span class="p">,</span><span class="n">mem</span><span class="p">(</span><span class="n">i</span><span class="p">),</span><span class="n">i</span><span class="o">=</span><span class="mi">0</span><span class="p">,</span><span class="n">size</span><span class="p">(</span><span class="n">mem</span><span class="p">)</span><span class="o">-</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-591" name="ln-591" href="#ln-591"></a><span class="w"> </span>
|
|
<a id="ln-592" name="ln-592" href="#ln-592"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'fix0'</span><span class="p">,</span><span class="s1">'fix1'</span><span class="p">,</span><span class="s1">'fix2'</span><span class="p">,</span><span class="s1">'fix3'</span><span class="p">,</span><span class="s1">'fix4'</span><span class="p">,</span><span class="s1">'fix5'</span><span class="p">,</span><span class="s1">'fix6'</span><span class="p">,</span><span class="s1">'fix7'</span><span class="p">,</span><span class="s1">'fix8'</span><span class="p">,</span><span class="s1">'fix9'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-593" name="ln-593" href="#ln-593"></a><span class="w"> </span><span class="k">read</span><span class="p">(</span><span class="n">command</span><span class="p">(</span><span class="mi">4</span><span class="p">:</span><span class="mi">4</span><span class="p">),</span><span class="s1">'(i1)'</span><span class="p">)</span><span class="w"> </span><span class="n">m</span><span class="w"></span>
|
|
<a id="ln-594" name="ln-594" href="#ln-594"></a><span class="w"> </span><span class="k">call </span><span class="n">set_places</span><span class="p">(</span><span class="n">m</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-595" name="ln-595" href="#ln-595"></a><span class="w"> </span>
|
|
<a id="ln-596" name="ln-596" href="#ln-596"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'DEG'</span><span class="p">,</span><span class="s1">'deg'</span><span class="p">,</span><span class="s1">'DEGREES'</span><span class="p">,</span><span class="s1">'degrees'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-597" name="ln-597" href="#ln-597"></a><span class="w"> </span><span class="k">call </span><span class="n">toggle_degrees_mode</span><span class="p">(.</span><span class="n">true</span><span class="p">.)</span><span class="w"></span>
|
|
<a id="ln-598" name="ln-598" href="#ln-598"></a>
|
|
<a id="ln-599" name="ln-599" href="#ln-599"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'RAD'</span><span class="p">,</span><span class="s1">'rad'</span><span class="p">,</span><span class="s1">'RADIANS'</span><span class="p">,</span><span class="s1">'radians'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-600" name="ln-600" href="#ln-600"></a><span class="w"> </span><span class="k">call </span><span class="n">toggle_degrees_mode</span><span class="p">(.</span><span class="n">false</span><span class="p">.)</span><span class="w"></span>
|
|
<a id="ln-601" name="ln-601" href="#ln-601"></a>
|
|
<a id="ln-602" name="ln-602" href="#ln-602"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'mC'</span><span class="p">,</span><span class="s1">'COMPLEX'</span><span class="p">,</span><span class="s1">'complex'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-603" name="ln-603" href="#ln-603"></a><span class="w"> </span><span class="n">complex_mode</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="p">.</span><span class="n">true</span><span class="p">.</span><span class="w"></span>
|
|
<a id="ln-604" name="ln-604" href="#ln-604"></a>
|
|
<a id="ln-605" name="ln-605" href="#ln-605"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'mR'</span><span class="p">,</span><span class="s1">'REAL'</span><span class="p">,</span><span class="s1">'real'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-606" name="ln-606" href="#ln-606"></a><span class="w"> </span><span class="n">complex_mode</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="p">.</span><span class="n">false</span><span class="p">.</span><span class="w"></span>
|
|
<a id="ln-607" name="ln-607" href="#ln-607"></a>
|
|
<a id="ln-608" name="ln-608" href="#ln-608"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'mV'</span><span class="p">,</span><span class="s1">'VERBOSE'</span><span class="p">,</span><span class="s1">'verbose'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-609" name="ln-609" href="#ln-609"></a><span class="w"> </span><span class="n">veMode</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="p">.</span><span class="n">true</span><span class="p">.</span><span class="w"></span>
|
|
<a id="ln-610" name="ln-610" href="#ln-610"></a>
|
|
<a id="ln-611" name="ln-611" href="#ln-611"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'mT'</span><span class="p">,</span><span class="s1">'TERSE'</span><span class="p">,</span><span class="s1">'terse'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-612" name="ln-612" href="#ln-612"></a><span class="w"> </span><span class="n">veMode</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="p">.</span><span class="n">false</span><span class="p">.</span><span class="w"></span>
|
|
<a id="ln-613" name="ln-613" href="#ln-613"></a>
|
|
<a id="ln-614" name="ln-614" href="#ln-614"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'?'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-615" name="ln-615" href="#ln-615"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="n">advance</span><span class="o">=</span><span class="s1">'no'</span><span class="p">,</span><span class="n">fmt</span><span class="o">=</span><span class="s1">'(a)'</span><span class="p">)</span><span class="w"> </span><span class="s1">'Status: '</span><span class="w"></span>
|
|
<a id="ln-616" name="ln-616" href="#ln-616"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="n">advance</span><span class="o">=</span><span class="s1">'no'</span><span class="p">,</span><span class="n">fmt</span><span class="o">=</span><span class="s1">'(2a)'</span><span class="p">)</span><span class="w"> </span><span class="nb">merge</span><span class="p">(</span><span class="s1">'degrees'</span><span class="p">,</span><span class="s1">'radians'</span><span class="p">,</span><span class="n">degrees_mode</span><span class="p">),</span><span class="s1">' ; '</span><span class="w"></span>
|
|
<a id="ln-617" name="ln-617" href="#ln-617"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="n">advance</span><span class="o">=</span><span class="s1">'no'</span><span class="p">,</span><span class="n">fmt</span><span class="o">=</span><span class="s1">'(a,i0)'</span><span class="p">)</span><span class="w"> </span><span class="s1">'dp = '</span><span class="p">,</span><span class="n">get_places</span><span class="p">()</span><span class="w"></span>
|
|
<a id="ln-618" name="ln-618" href="#ln-618"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">complex_mode</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-619" name="ln-619" href="#ln-619"></a><span class="k"> write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="n">advance</span><span class="o">=</span><span class="s1">'no'</span><span class="p">,</span><span class="n">fmt</span><span class="o">=</span><span class="s1">'(a)'</span><span class="p">)</span><span class="w"> </span><span class="s1">' ; mode = complex'</span><span class="w"></span>
|
|
<a id="ln-620" name="ln-620" href="#ln-620"></a><span class="w"> </span><span class="k">else</span>
|
|
<a id="ln-621" name="ln-621" href="#ln-621"></a><span class="k"> write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="n">advance</span><span class="o">=</span><span class="s1">'no'</span><span class="p">,</span><span class="n">fmt</span><span class="o">=</span><span class="s1">'(a)'</span><span class="p">)</span><span class="w"> </span><span class="s1">' ; mode = real'</span><span class="w"></span>
|
|
<a id="ln-622" name="ln-622" href="#ln-622"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-623" name="ln-623" href="#ln-623"></a><span class="k"> write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="n">advance</span><span class="o">=</span><span class="s1">'no'</span><span class="p">,</span><span class="n">fmt</span><span class="o">=</span><span class="s1">'(a,i0)'</span><span class="p">)</span><span class="w"> </span><span class="s1">' ; stack size = '</span><span class="p">,</span><span class="n">stack</span><span class="p">%</span><span class="n">get_size</span><span class="p">()</span><span class="w"></span>
|
|
<a id="ln-624" name="ln-624" href="#ln-624"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(a/)'</span><span class="p">)</span><span class="w"> </span><span class="s1">''</span><span class="w"></span>
|
|
<a id="ln-625" name="ln-625" href="#ln-625"></a>
|
|
<a id="ln-626" name="ln-626" href="#ln-626"></a><span class="w"> </span><span class="k">case</span><span class="p">(</span><span class="s1">'help'</span><span class="p">,</span><span class="s1">'h'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-627" name="ln-627" href="#ln-627"></a><span class="w"> </span><span class="k">call </span><span class="n">help</span><span class="w"></span>
|
|
<a id="ln-628" name="ln-628" href="#ln-628"></a>
|
|
<a id="ln-629" name="ln-629" href="#ln-629"></a><span class="w"> </span><span class="k">case </span><span class="n">default</span><span class="w"></span>
|
|
<a id="ln-630" name="ln-630" href="#ln-630"></a><span class="w"> </span><span class="c">! Process constants first</span>
|
|
<a id="ln-631" name="ln-631" href="#ln-631"></a><span class="w"> </span><span class="k">block</span>
|
|
<a id="ln-632" name="ln-632" href="#ln-632"></a><span class="k"> </span><span class="kt">integer</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">lc</span><span class="p">,</span><span class="w"> </span><span class="n">is_integer</span><span class="p">,</span><span class="n">split_idx</span><span class="p">,</span><span class="n">end_idx</span><span class="w"></span>
|
|
<a id="ln-633" name="ln-633" href="#ln-633"></a><span class="w"> </span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="w"> </span><span class="k">allocatable</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">re_comp</span><span class="p">,</span><span class="w"> </span><span class="n">im_comp</span><span class="w"></span>
|
|
<a id="ln-634" name="ln-634" href="#ln-634"></a><span class="w"> </span><span class="n">lc</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">len_trim</span><span class="p">(</span><span class="n">command</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-635" name="ln-635" href="#ln-635"></a><span class="w"> </span><span class="n">is_integer</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="p">(</span><span class="nb">index</span><span class="p">(</span><span class="n">command</span><span class="p">,</span><span class="s1">'.'</span><span class="p">)</span><span class="w"> </span><span class="o">==</span><span class="w"> </span><span class="mi">0</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-636" name="ln-636" href="#ln-636"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">complex_mode</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-637" name="ln-637" href="#ln-637"></a><span class="k"> if</span><span class="w"> </span><span class="p">(</span><span class="n">command</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="mi">1</span><span class="p">)</span><span class="w"> </span><span class="o">==</span><span class="w"> </span><span class="s1">'('</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-638" name="ln-638" href="#ln-638"></a><span class="k"> </span><span class="n">split_idx</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">index</span><span class="p">(</span><span class="n">command</span><span class="p">,</span><span class="s1">','</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-639" name="ln-639" href="#ln-639"></a><span class="w"> </span><span class="n">end_idx</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">index</span><span class="p">(</span><span class="n">command</span><span class="p">,</span><span class="s1">')'</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-640" name="ln-640" href="#ln-640"></a><span class="w"> </span><span class="n">re_comp</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">command</span><span class="p">(</span><span class="mi">2</span><span class="p">:</span><span class="n">split_idx</span><span class="o">-</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-641" name="ln-641" href="#ln-641"></a><span class="w"> </span><span class="n">im_comp</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">command</span><span class="p">(</span><span class="n">split_idx</span><span class="o">+</span><span class="mi">1</span><span class="p">:</span><span class="n">end_idx</span><span class="o">-</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-642" name="ln-642" href="#ln-642"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">constants</span><span class="p">%</span><span class="k">contains</span><span class="p">(</span><span class="n">re_comp</span><span class="p">))</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-643" name="ln-643" href="#ln-643"></a><span class="k"> </span><span class="n">z</span><span class="p">%</span><span class="n">re</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">constants</span><span class="p">%</span><span class="n">get_value</span><span class="p">(</span><span class="n">re_comp</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-644" name="ln-644" href="#ln-644"></a><span class="w"> </span><span class="k">else</span>
|
|
<a id="ln-645" name="ln-645" href="#ln-645"></a><span class="k"> read</span><span class="p">(</span><span class="n">re_comp</span><span class="p">,</span><span class="o">*</span><span class="p">,</span><span class="n">err</span><span class="o">=</span><span class="mi">901</span><span class="p">,</span><span class="k">end</span><span class="o">=</span><span class="mi">901</span><span class="p">)</span><span class="w"> </span><span class="n">z</span><span class="p">%</span><span class="n">re</span><span class="w"></span>
|
|
<a id="ln-646" name="ln-646" href="#ln-646"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-647" name="ln-647" href="#ln-647"></a><span class="k"> if</span><span class="w"> </span><span class="p">(</span><span class="n">constants</span><span class="p">%</span><span class="k">contains</span><span class="p">(</span><span class="n">im_comp</span><span class="p">))</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-648" name="ln-648" href="#ln-648"></a><span class="k"> </span><span class="n">z</span><span class="p">%</span><span class="n">im</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">constants</span><span class="p">%</span><span class="n">get_value</span><span class="p">(</span><span class="n">im_comp</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-649" name="ln-649" href="#ln-649"></a><span class="w"> </span><span class="k">else</span>
|
|
<a id="ln-650" name="ln-650" href="#ln-650"></a><span class="k"> read</span><span class="p">(</span><span class="n">im_comp</span><span class="p">,</span><span class="o">*</span><span class="p">,</span><span class="n">err</span><span class="o">=</span><span class="mi">901</span><span class="p">,</span><span class="k">end</span><span class="o">=</span><span class="mi">901</span><span class="p">)</span><span class="w"> </span><span class="n">z</span><span class="p">%</span><span class="n">im</span><span class="w"></span>
|
|
<a id="ln-651" name="ln-651" href="#ln-651"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-652" name="ln-652" href="#ln-652"></a><span class="k"> if</span><span class="w"> </span><span class="p">(</span><span class="n">command</span><span class="p">(</span><span class="n">lc</span><span class="p">:</span><span class="n">lc</span><span class="p">)</span><span class="w"> </span><span class="o">==</span><span class="w"> </span><span class="s1">'p'</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-653" name="ln-653" href="#ln-653"></a><span class="k"> call </span><span class="n">stack</span><span class="p">%</span><span class="n">push</span><span class="p">(</span><span class="n">z</span><span class="p">,.</span><span class="n">false</span><span class="p">.)</span><span class="w"></span>
|
|
<a id="ln-654" name="ln-654" href="#ln-654"></a><span class="w"> </span><span class="k">else</span>
|
|
<a id="ln-655" name="ln-655" href="#ln-655"></a><span class="k"> call </span><span class="n">stack</span><span class="p">%</span><span class="n">push</span><span class="p">(</span><span class="n">z</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-656" name="ln-656" href="#ln-656"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-657" name="ln-657" href="#ln-657"></a><span class="k"> else</span>
|
|
<a id="ln-658" name="ln-658" href="#ln-658"></a><span class="k"> if</span><span class="w"> </span><span class="p">(</span><span class="n">constants</span><span class="p">%</span><span class="k">contains</span><span class="p">(</span><span class="n">command</span><span class="p">))</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-659" name="ln-659" href="#ln-659"></a><span class="k"> </span><span class="n">x</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">constants</span><span class="p">%</span><span class="n">get_value</span><span class="p">(</span><span class="n">command</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-660" name="ln-660" href="#ln-660"></a><span class="w"> </span><span class="k">else</span>
|
|
<a id="ln-661" name="ln-661" href="#ln-661"></a><span class="k"> read</span><span class="p">(</span><span class="n">command</span><span class="p">,</span><span class="o">*</span><span class="p">,</span><span class="n">err</span><span class="o">=</span><span class="mi">901</span><span class="p">,</span><span class="k">end</span><span class="o">=</span><span class="mi">901</span><span class="p">)</span><span class="w"> </span><span class="n">x</span><span class="w"></span>
|
|
<a id="ln-662" name="ln-662" href="#ln-662"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-663" name="ln-663" href="#ln-663"></a><span class="k"> call </span><span class="n">stack</span><span class="p">%</span><span class="n">push</span><span class="p">(</span><span class="nb">cmplx</span><span class="p">(</span><span class="n">x</span><span class="p">,</span><span class="mf">0.0d0</span><span class="p">,</span><span class="mi">8</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-664" name="ln-664" href="#ln-664"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-665" name="ln-665" href="#ln-665"></a><span class="k"> </span>
|
|
<a id="ln-666" name="ln-666" href="#ln-666"></a><span class="k"> else</span>
|
|
<a id="ln-667" name="ln-667" href="#ln-667"></a><span class="k"> if</span><span class="w"> </span><span class="p">(</span><span class="n">constants</span><span class="p">%</span><span class="k">contains</span><span class="p">(</span><span class="n">command</span><span class="p">))</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-668" name="ln-668" href="#ln-668"></a><span class="k"> </span><span class="n">x</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">constants</span><span class="p">%</span><span class="n">get_value</span><span class="p">(</span><span class="n">command</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-669" name="ln-669" href="#ln-669"></a><span class="w"> </span><span class="k">else if</span><span class="w"> </span><span class="p">(</span><span class="n">stats</span><span class="p">%</span><span class="k">contains</span><span class="p">(</span><span class="n">command</span><span class="p">))</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-670" name="ln-670" href="#ln-670"></a><span class="k"> </span><span class="n">x</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">stats</span><span class="p">%</span><span class="n">get_value</span><span class="p">(</span><span class="n">command</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-671" name="ln-671" href="#ln-671"></a><span class="w"> </span><span class="k">else</span>
|
|
<a id="ln-672" name="ln-672" href="#ln-672"></a><span class="k"> read</span><span class="p">(</span><span class="n">command</span><span class="p">,</span><span class="o">*</span><span class="p">,</span><span class="n">err</span><span class="o">=</span><span class="mi">901</span><span class="p">,</span><span class="k">end</span><span class="o">=</span><span class="mi">901</span><span class="p">)</span><span class="w"> </span><span class="n">x</span><span class="w"></span>
|
|
<a id="ln-673" name="ln-673" href="#ln-673"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-674" name="ln-674" href="#ln-674"></a><span class="k"> call </span><span class="n">stack</span><span class="p">%</span><span class="n">push</span><span class="p">(</span><span class="nb">cmplx</span><span class="p">(</span><span class="n">x</span><span class="p">,</span><span class="mf">0.0d0</span><span class="p">,</span><span class="mi">8</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-675" name="ln-675" href="#ln-675"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-676" name="ln-676" href="#ln-676"></a><span class="k"> end block</span>
|
|
<a id="ln-677" name="ln-677" href="#ln-677"></a><span class="k"> end select</span>
|
|
<a id="ln-678" name="ln-678" href="#ln-678"></a><span class="k"> return</span>
|
|
<a id="ln-679" name="ln-679" href="#ln-679"></a>
|
|
<a id="ln-680" name="ln-680" href="#ln-680"></a><span class="mi">901</span><span class="w"> </span><span class="k">continue</span>
|
|
<a id="ln-681" name="ln-681" href="#ln-681"></a><span class="k"> write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(a)'</span><span class="p">)</span><span class="w"> </span><span class="n">command</span><span class="o">//</span><span class="s1">' ???'</span><span class="w"></span>
|
|
<a id="ln-682" name="ln-682" href="#ln-682"></a><span class="w"> </span><span class="k">return</span>
|
|
<a id="ln-683" name="ln-683" href="#ln-683"></a><span class="k"> </span>
|
|
<a id="ln-684" name="ln-684" href="#ln-684"></a><span class="k"> end subroutine </span><span class="n">apply_command</span><span class="w"></span>
|
|
<a id="ln-685" name="ln-685" href="#ln-685"></a>
|
|
<a id="ln-686" name="ln-686" href="#ln-686"></a><span class="w"> </span><span class="k">subroutine </span><span class="n">calculate_stats</span><span class="w"></span>
|
|
<a id="ln-687" name="ln-687" href="#ln-687"></a><span class="w"> </span><span class="kt">real</span><span class="p">(</span><span class="mi">8</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">a</span><span class="p">,</span><span class="w"> </span><span class="n">b</span><span class="p">,</span><span class="w"> </span><span class="n">c</span><span class="p">,</span><span class="w"> </span><span class="n">sxy</span><span class="w"></span>
|
|
<a id="ln-688" name="ln-688" href="#ln-688"></a><span class="w"> </span><span class="kt">real</span><span class="p">(</span><span class="mi">8</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">s</span><span class="p">(</span><span class="mi">5</span><span class="p">,</span><span class="mi">2</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-689" name="ln-689" href="#ln-689"></a>
|
|
<a id="ln-690" name="ln-690" href="#ln-690"></a><span class="w"> </span><span class="k">call </span><span class="n">summary_stats</span><span class="p">(</span><span class="n">x_seq</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="n">n_seq</span><span class="p">),</span><span class="n">s</span><span class="p">(</span><span class="mi">1</span><span class="p">,</span><span class="mi">1</span><span class="p">),</span><span class="n">s</span><span class="p">(</span><span class="mi">2</span><span class="p">,</span><span class="mi">1</span><span class="p">),</span><span class="n">s</span><span class="p">(</span><span class="mi">3</span><span class="p">,</span><span class="mi">1</span><span class="p">),</span><span class="n">s</span><span class="p">(</span><span class="mi">4</span><span class="p">,</span><span class="mi">1</span><span class="p">),</span><span class="n">s</span><span class="p">(</span><span class="mi">5</span><span class="p">,</span><span class="mi">1</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-691" name="ln-691" href="#ln-691"></a><span class="w"> </span><span class="k">call </span><span class="n">stats</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="s1">'n'</span><span class="p">,</span><span class="kt">real</span><span class="p">(</span><span class="n">n_seq</span><span class="p">,</span><span class="mi">8</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-692" name="ln-692" href="#ln-692"></a><span class="w"> </span><span class="k">call </span><span class="n">stats</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="s1">'ux'</span><span class="p">,</span><span class="n">s</span><span class="p">(</span><span class="mi">1</span><span class="p">,</span><span class="mi">1</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-693" name="ln-693" href="#ln-693"></a><span class="w"> </span><span class="k">call </span><span class="n">stats</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="s1">'mx'</span><span class="p">,</span><span class="n">s</span><span class="p">(</span><span class="mi">2</span><span class="p">,</span><span class="mi">1</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-694" name="ln-694" href="#ln-694"></a><span class="w"> </span><span class="k">call </span><span class="n">stats</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="s1">'sx'</span><span class="p">,</span><span class="n">s</span><span class="p">(</span><span class="mi">3</span><span class="p">,</span><span class="mi">1</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-695" name="ln-695" href="#ln-695"></a><span class="w"> </span><span class="k">call </span><span class="n">stats</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="s1">'lqx'</span><span class="p">,</span><span class="n">s</span><span class="p">(</span><span class="mi">4</span><span class="p">,</span><span class="mi">1</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-696" name="ln-696" href="#ln-696"></a><span class="w"> </span><span class="k">call </span><span class="n">stats</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="s1">'uqx'</span><span class="p">,</span><span class="n">s</span><span class="p">(</span><span class="mi">5</span><span class="p">,</span><span class="mi">1</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-697" name="ln-697" href="#ln-697"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">seq_is_x</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-698" name="ln-698" href="#ln-698"></a><span class="k"> write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="mi">10</span><span class="p">)</span><span class="w"> </span><span class="s1">' count n -> '</span><span class="p">,</span><span class="n">n_seq</span><span class="w"></span>
|
|
<a id="ln-699" name="ln-699" href="#ln-699"></a><span class="w"> </span><span class="k">call </span><span class="n">print_value</span><span class="p">(</span><span class="s1">' mean ux -> '</span><span class="p">,</span><span class="n">s</span><span class="p">(</span><span class="mi">1</span><span class="p">,</span><span class="mi">1</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-700" name="ln-700" href="#ln-700"></a><span class="w"> </span><span class="k">call </span><span class="n">print_value</span><span class="p">(</span><span class="s1">' stddev sx -> '</span><span class="p">,</span><span class="n">s</span><span class="p">(</span><span class="mi">3</span><span class="p">,</span><span class="mi">1</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-701" name="ln-701" href="#ln-701"></a><span class="w"> </span><span class="k">call </span><span class="n">print_value</span><span class="p">(</span><span class="s1">' median mx -> '</span><span class="p">,</span><span class="n">s</span><span class="p">(</span><span class="mi">2</span><span class="p">,</span><span class="mi">1</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-702" name="ln-702" href="#ln-702"></a><span class="w"> </span><span class="k">call </span><span class="n">print_value</span><span class="p">(</span><span class="s1">'lower_q lqx -> '</span><span class="p">,</span><span class="n">s</span><span class="p">(</span><span class="mi">4</span><span class="p">,</span><span class="mi">1</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-703" name="ln-703" href="#ln-703"></a><span class="w"> </span><span class="k">call </span><span class="n">print_value</span><span class="p">(</span><span class="s1">'upper_q uqx -> '</span><span class="p">,</span><span class="n">s</span><span class="p">(</span><span class="mi">5</span><span class="p">,</span><span class="mi">1</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-704" name="ln-704" href="#ln-704"></a><span class="w"> </span><span class="k">else</span>
|
|
<a id="ln-705" name="ln-705" href="#ln-705"></a><span class="k"> call </span><span class="n">summary_stats</span><span class="p">(</span><span class="n">y_seq</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="n">n_seq</span><span class="p">),</span><span class="n">s</span><span class="p">(</span><span class="mi">1</span><span class="p">,</span><span class="mi">2</span><span class="p">),</span><span class="n">s</span><span class="p">(</span><span class="mi">2</span><span class="p">,</span><span class="mi">2</span><span class="p">),</span><span class="n">s</span><span class="p">(</span><span class="mi">3</span><span class="p">,</span><span class="mi">2</span><span class="p">),</span><span class="n">s</span><span class="p">(</span><span class="mi">4</span><span class="p">,</span><span class="mi">2</span><span class="p">),</span><span class="n">s</span><span class="p">(</span><span class="mi">5</span><span class="p">,</span><span class="mi">2</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-706" name="ln-706" href="#ln-706"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="mi">10</span><span class="p">)</span><span class="w"> </span><span class="s1">' count n -> '</span><span class="p">,</span><span class="n">n_seq</span><span class="w"></span>
|
|
<a id="ln-707" name="ln-707" href="#ln-707"></a><span class="w"> </span><span class="k">call </span><span class="n">print_value</span><span class="p">(</span><span class="s1">' means ux , uy -> '</span><span class="p">,</span><span class="n">s</span><span class="p">(</span><span class="mi">1</span><span class="p">,</span><span class="mi">1</span><span class="p">),</span><span class="n">s</span><span class="p">(</span><span class="mi">1</span><span class="p">,</span><span class="mi">2</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-708" name="ln-708" href="#ln-708"></a><span class="w"> </span><span class="k">call </span><span class="n">print_value</span><span class="p">(</span><span class="s1">' stddevs sx , xy -> '</span><span class="p">,</span><span class="n">s</span><span class="p">(</span><span class="mi">3</span><span class="p">,</span><span class="mi">1</span><span class="p">),</span><span class="n">s</span><span class="p">(</span><span class="mi">3</span><span class="p">,</span><span class="mi">2</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-709" name="ln-709" href="#ln-709"></a><span class="w"> </span><span class="k">call </span><span class="n">print_value</span><span class="p">(</span><span class="s1">' medians mx , my -> '</span><span class="p">,</span><span class="n">s</span><span class="p">(</span><span class="mi">2</span><span class="p">,</span><span class="mi">1</span><span class="p">),</span><span class="n">s</span><span class="p">(</span><span class="mi">2</span><span class="p">,</span><span class="mi">2</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-710" name="ln-710" href="#ln-710"></a><span class="w"> </span><span class="k">call </span><span class="n">print_value</span><span class="p">(</span><span class="s1">'lower_qs lqx , lqy -> '</span><span class="p">,</span><span class="n">s</span><span class="p">(</span><span class="mi">4</span><span class="p">,</span><span class="mi">1</span><span class="p">),</span><span class="n">s</span><span class="p">(</span><span class="mi">4</span><span class="p">,</span><span class="mi">2</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-711" name="ln-711" href="#ln-711"></a><span class="w"> </span><span class="k">call </span><span class="n">print_value</span><span class="p">(</span><span class="s1">'upper_qs uqx , uqy -> '</span><span class="p">,</span><span class="n">s</span><span class="p">(</span><span class="mi">5</span><span class="p">,</span><span class="mi">1</span><span class="p">),</span><span class="n">s</span><span class="p">(</span><span class="mi">5</span><span class="p">,</span><span class="mi">2</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-712" name="ln-712" href="#ln-712"></a><span class="w"> </span><span class="k">call </span><span class="n">stats</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="s1">'uy'</span><span class="p">,</span><span class="n">s</span><span class="p">(</span><span class="mi">1</span><span class="p">,</span><span class="mi">2</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-713" name="ln-713" href="#ln-713"></a><span class="w"> </span><span class="k">call </span><span class="n">stats</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="s1">'my'</span><span class="p">,</span><span class="n">s</span><span class="p">(</span><span class="mi">2</span><span class="p">,</span><span class="mi">2</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-714" name="ln-714" href="#ln-714"></a><span class="w"> </span><span class="k">call </span><span class="n">stats</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="s1">'sy'</span><span class="p">,</span><span class="n">s</span><span class="p">(</span><span class="mi">3</span><span class="p">,</span><span class="mi">2</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-715" name="ln-715" href="#ln-715"></a><span class="w"> </span><span class="k">call </span><span class="n">stats</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="s1">'lqy'</span><span class="p">,</span><span class="n">s</span><span class="p">(</span><span class="mi">4</span><span class="p">,</span><span class="mi">2</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-716" name="ln-716" href="#ln-716"></a><span class="w"> </span><span class="k">call </span><span class="n">stats</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="s1">'uqy'</span><span class="p">,</span><span class="n">s</span><span class="p">(</span><span class="mi">5</span><span class="p">,</span><span class="mi">2</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-717" name="ln-717" href="#ln-717"></a>
|
|
<a id="ln-718" name="ln-718" href="#ln-718"></a><span class="w"> </span><span class="k">call </span><span class="n">calculate_regression</span><span class="p">(</span><span class="n">s</span><span class="p">(</span><span class="mi">1</span><span class="p">,</span><span class="mi">1</span><span class="p">),</span><span class="n">s</span><span class="p">(</span><span class="mi">1</span><span class="p">,</span><span class="mi">2</span><span class="p">),</span><span class="n">a</span><span class="p">,</span><span class="n">b</span><span class="p">,</span><span class="n">c</span><span class="p">,</span><span class="n">sxy</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-719" name="ln-719" href="#ln-719"></a><span class="w"> </span><span class="k">call </span><span class="n">stats</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="s1">'a'</span><span class="p">,</span><span class="n">a</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-720" name="ln-720" href="#ln-720"></a><span class="w"> </span><span class="k">call </span><span class="n">stats</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="s1">'b'</span><span class="p">,</span><span class="n">b</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-721" name="ln-721" href="#ln-721"></a><span class="w"> </span><span class="k">call </span><span class="n">stats</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="s1">'corr'</span><span class="p">,</span><span class="n">c</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-722" name="ln-722" href="#ln-722"></a><span class="w"> </span><span class="k">call </span><span class="n">stats</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="s1">'cov'</span><span class="p">,</span><span class="n">sxy</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-723" name="ln-723" href="#ln-723"></a><span class="w"> </span><span class="k">write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(/a)'</span><span class="p">)</span><span class="w"> </span><span class="s1">'Regression: y = ax + b'</span><span class="w"></span>
|
|
<a id="ln-724" name="ln-724" href="#ln-724"></a><span class="w"> </span><span class="k">call </span><span class="n">print_value</span><span class="p">(</span><span class="s1">' gradient a ->'</span><span class="p">,</span><span class="n">a</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-725" name="ln-725" href="#ln-725"></a><span class="w"> </span><span class="k">call </span><span class="n">print_value</span><span class="p">(</span><span class="s1">' intercept b -> '</span><span class="p">,</span><span class="n">b</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-726" name="ln-726" href="#ln-726"></a><span class="w"> </span><span class="k">call </span><span class="n">print_value</span><span class="p">(</span><span class="s1">' covariance cov -> '</span><span class="p">,</span><span class="n">sxy</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-727" name="ln-727" href="#ln-727"></a><span class="w"> </span><span class="k">call </span><span class="n">print_value</span><span class="p">(</span><span class="s1">'correlation corr -> '</span><span class="p">,</span><span class="n">c</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-728" name="ln-728" href="#ln-728"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-729" name="ln-729" href="#ln-729"></a><span class="k"> </span><span class="mi">10</span><span class="w"> </span><span class="k">format</span><span class="p">(</span><span class="n">a</span><span class="p">,</span><span class="n">i0</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-730" name="ln-730" href="#ln-730"></a><span class="w"> </span>
|
|
<a id="ln-731" name="ln-731" href="#ln-731"></a><span class="w"> </span><span class="k">end subroutine </span><span class="n">calculate_stats</span><span class="w"></span>
|
|
<a id="ln-732" name="ln-732" href="#ln-732"></a><span class="w"> </span>
|
|
<a id="ln-733" name="ln-733" href="#ln-733"></a><span class="w"> </span><span class="k">subroutine </span><span class="n">calculate_regression</span><span class="p">(</span><span class="n">mean_x</span><span class="p">,</span><span class="w"> </span><span class="n">mean_y</span><span class="p">,</span><span class="w"> </span><span class="n">a</span><span class="p">,</span><span class="w"> </span><span class="n">b</span><span class="p">,</span><span class="w"> </span><span class="n">c</span><span class="p">,</span><span class="w"> </span><span class="n">sxy</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-734" name="ln-734" href="#ln-734"></a><span class="w"> </span><span class="kt">real</span><span class="p">(</span><span class="mi">8</span><span class="p">),</span><span class="w"> </span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">mean_x</span><span class="p">,</span><span class="w"> </span><span class="n">mean_y</span><span class="w"></span>
|
|
<a id="ln-735" name="ln-735" href="#ln-735"></a><span class="w"> </span><span class="kt">real</span><span class="p">(</span><span class="mi">8</span><span class="p">),</span><span class="w"> </span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">a</span><span class="p">,</span><span class="w"> </span><span class="n">b</span><span class="p">,</span><span class="w"> </span><span class="n">c</span><span class="p">,</span><span class="w"> </span><span class="n">sxy</span><span class="w"></span>
|
|
<a id="ln-736" name="ln-736" href="#ln-736"></a><span class="w"> </span><span class="kt">integer</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">i</span><span class="w"></span>
|
|
<a id="ln-737" name="ln-737" href="#ln-737"></a><span class="w"> </span><span class="kt">real</span><span class="p">(</span><span class="mi">8</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">sxx</span><span class="p">,</span><span class="w"> </span><span class="n">syy</span><span class="w"></span>
|
|
<a id="ln-738" name="ln-738" href="#ln-738"></a><span class="w"> </span><span class="n">sxy</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">sum</span><span class="p">(</span><span class="n">x_seq</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="n">n_seq</span><span class="p">)</span><span class="o">*</span><span class="n">y_seq</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="n">n_seq</span><span class="p">))</span><span class="o">/</span><span class="n">n_seq</span><span class="w"> </span><span class="o">-</span><span class="w"> </span><span class="n">mean_x</span><span class="o">*</span><span class="n">mean_y</span><span class="w"></span>
|
|
<a id="ln-739" name="ln-739" href="#ln-739"></a><span class="w"> </span><span class="n">sxx</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">sum</span><span class="p">(</span><span class="n">x_seq</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="n">n_seq</span><span class="p">)</span><span class="o">*</span><span class="n">x_seq</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="n">n_seq</span><span class="p">))</span><span class="o">/</span><span class="n">n_seq</span><span class="w"> </span><span class="o">-</span><span class="w"> </span><span class="n">mean_x</span><span class="o">**</span><span class="mi">2</span><span class="w"></span>
|
|
<a id="ln-740" name="ln-740" href="#ln-740"></a><span class="w"> </span><span class="n">syy</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">sum</span><span class="p">(</span><span class="n">y_seq</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="n">n_seq</span><span class="p">)</span><span class="o">*</span><span class="n">y_seq</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="n">n_seq</span><span class="p">))</span><span class="o">/</span><span class="n">n_seq</span><span class="w"> </span><span class="o">-</span><span class="w"> </span><span class="n">mean_y</span><span class="o">**</span><span class="mi">2</span><span class="w"></span>
|
|
<a id="ln-741" name="ln-741" href="#ln-741"></a><span class="w"> </span><span class="n">a</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">sxy</span><span class="o">/</span><span class="n">sxx</span><span class="w"></span>
|
|
<a id="ln-742" name="ln-742" href="#ln-742"></a><span class="w"> </span><span class="n">b</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">mean_y</span><span class="w"> </span><span class="o">-</span><span class="w"> </span><span class="n">a</span><span class="o">*</span><span class="n">mean_x</span><span class="w"></span>
|
|
<a id="ln-743" name="ln-743" href="#ln-743"></a><span class="w"> </span><span class="n">c</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">sxy</span><span class="o">/</span><span class="nb">sqrt</span><span class="p">(</span><span class="n">sxx</span><span class="o">*</span><span class="n">syy</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-744" name="ln-744" href="#ln-744"></a><span class="w"> </span><span class="k">end subroutine </span><span class="n">calculate_regression</span><span class="w"></span>
|
|
<a id="ln-745" name="ln-745" href="#ln-745"></a><span class="w"> </span>
|
|
<a id="ln-746" name="ln-746" href="#ln-746"></a><span class="w"> </span><span class="k">subroutine </span><span class="n">print_value</span><span class="p">(</span><span class="n">name</span><span class="p">,</span><span class="w"> </span><span class="n">x</span><span class="p">,</span><span class="w"> </span><span class="n">y</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-747" name="ln-747" href="#ln-747"></a><span class="w"> </span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=*</span><span class="p">),</span><span class="w"> </span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">name</span><span class="w"></span>
|
|
<a id="ln-748" name="ln-748" href="#ln-748"></a><span class="w"> </span><span class="kt">real</span><span class="p">(</span><span class="mi">8</span><span class="p">),</span><span class="w"> </span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">x</span><span class="w"></span>
|
|
<a id="ln-749" name="ln-749" href="#ln-749"></a><span class="w"> </span><span class="kt">real</span><span class="p">(</span><span class="mi">8</span><span class="p">),</span><span class="w"> </span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">),</span><span class="w"> </span><span class="k">optional</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">y</span><span class="w"></span>
|
|
<a id="ln-750" name="ln-750" href="#ln-750"></a><span class="w"> </span><span class="kt">character</span><span class="p">(</span><span class="nb">len</span><span class="o">=</span><span class="p">:),</span><span class="w"> </span><span class="k">allocatable</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">fmt_x</span><span class="p">,</span><span class="w"> </span><span class="n">fmt_y</span><span class="w"></span>
|
|
<a id="ln-751" name="ln-751" href="#ln-751"></a><span class="w"> </span><span class="k">call </span><span class="n">to_string</span><span class="p">(</span><span class="n">x</span><span class="p">,</span><span class="w"> </span><span class="n">fmt_x</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-752" name="ln-752" href="#ln-752"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">y</span><span class="p">))</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-753" name="ln-753" href="#ln-753"></a><span class="k"> call </span><span class="n">to_string</span><span class="p">(</span><span class="n">y</span><span class="p">,</span><span class="w"> </span><span class="n">fmt_y</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-754" name="ln-754" href="#ln-754"></a><span class="w"> </span><span class="n">fmt_x</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">fmt_x</span><span class="o">//</span><span class="s1">' , '</span><span class="o">//</span><span class="n">fmt_y</span><span class="w"></span>
|
|
<a id="ln-755" name="ln-755" href="#ln-755"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-756" name="ln-756" href="#ln-756"></a><span class="k"> write</span><span class="p">(</span><span class="mi">6</span><span class="p">,</span><span class="s1">'(a)'</span><span class="p">)</span><span class="w"> </span><span class="n">name</span><span class="o">//</span><span class="n">fmt_x</span><span class="w"></span>
|
|
<a id="ln-757" name="ln-757" href="#ln-757"></a><span class="w"> </span><span class="k">end subroutine </span><span class="n">print_value</span><span class="w"></span>
|
|
<a id="ln-758" name="ln-758" href="#ln-758"></a>
|
|
<a id="ln-759" name="ln-759" href="#ln-759"></a><span class="w"> </span><span class="k">subroutine </span><span class="n">summary_stats</span><span class="p">(</span><span class="n">a</span><span class="p">,</span><span class="w"> </span><span class="n">mean</span><span class="p">,</span><span class="w"> </span><span class="n">median</span><span class="p">,</span><span class="w"> </span><span class="n">stddev</span><span class="p">,</span><span class="w"> </span><span class="n">lower_q</span><span class="p">,</span><span class="w"> </span><span class="n">upper_q</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-760" name="ln-760" href="#ln-760"></a><span class="w"> </span><span class="kt">real</span><span class="p">(</span><span class="mi">8</span><span class="p">),</span><span class="w"> </span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">a</span><span class="p">(:)</span><span class="w"></span>
|
|
<a id="ln-761" name="ln-761" href="#ln-761"></a><span class="w"> </span><span class="kt">real</span><span class="p">(</span><span class="mi">8</span><span class="p">),</span><span class="w"> </span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">mean</span><span class="p">,</span><span class="w"> </span><span class="n">median</span><span class="p">,</span><span class="w"> </span><span class="n">stddev</span><span class="p">,</span><span class="w"> </span><span class="n">lower_q</span><span class="p">,</span><span class="w"> </span><span class="n">upper_q</span><span class="w"></span>
|
|
<a id="ln-762" name="ln-762" href="#ln-762"></a><span class="w"> </span><span class="kt">real</span><span class="p">(</span><span class="mi">8</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">b</span><span class="p">(</span><span class="n">size</span><span class="p">(</span><span class="n">a</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-763" name="ln-763" href="#ln-763"></a><span class="w"> </span><span class="kt">real</span><span class="p">(</span><span class="mi">8</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">s</span><span class="p">,</span><span class="w"> </span><span class="n">s2</span><span class="w"></span>
|
|
<a id="ln-764" name="ln-764" href="#ln-764"></a><span class="w"> </span><span class="kt">integer</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">m</span><span class="p">,</span><span class="w"> </span><span class="n">n</span><span class="w"></span>
|
|
<a id="ln-765" name="ln-765" href="#ln-765"></a><span class="w"> </span><span class="n">n</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">size</span><span class="p">(</span><span class="n">a</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-766" name="ln-766" href="#ln-766"></a><span class="w"> </span><span class="n">b</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">a</span><span class="w"></span>
|
|
<a id="ln-767" name="ln-767" href="#ln-767"></a><span class="w"> </span><span class="n">s</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">sum</span><span class="p">(</span><span class="n">b</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-768" name="ln-768" href="#ln-768"></a><span class="w"> </span><span class="n">s2</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">sum</span><span class="p">(</span><span class="n">b</span><span class="o">**</span><span class="mi">2</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-769" name="ln-769" href="#ln-769"></a><span class="w"> </span><span class="n">mean</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">s</span><span class="o">/</span><span class="n">n</span><span class="w"></span>
|
|
<a id="ln-770" name="ln-770" href="#ln-770"></a><span class="w"> </span><span class="n">stddev</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">sqrt</span><span class="p">(</span><span class="n">s2</span><span class="o">/</span><span class="n">n</span><span class="w"> </span><span class="o">-</span><span class="w"> </span><span class="p">(</span><span class="n">s</span><span class="o">/</span><span class="n">n</span><span class="p">)</span><span class="o">**</span><span class="mi">2</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-771" name="ln-771" href="#ln-771"></a><span class="w"> </span><span class="k">call </span><span class="n">sort</span><span class="p">(</span><span class="n">b</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-772" name="ln-772" href="#ln-772"></a><span class="w"> </span><span class="n">median</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">calc_median</span><span class="p">(</span><span class="n">b</span><span class="p">,</span><span class="w"> </span><span class="n">m</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-773" name="ln-773" href="#ln-773"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">n</span><span class="w"> </span><span class="o"><</span><span class="w"> </span><span class="mi">3</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-774" name="ln-774" href="#ln-774"></a><span class="k"> </span><span class="n">lower_q</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">median</span><span class="w"></span>
|
|
<a id="ln-775" name="ln-775" href="#ln-775"></a><span class="w"> </span><span class="n">upper_q</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">median</span><span class="w"></span>
|
|
<a id="ln-776" name="ln-776" href="#ln-776"></a><span class="w"> </span><span class="k">else</span>
|
|
<a id="ln-777" name="ln-777" href="#ln-777"></a><span class="k"> </span><span class="n">lower_q</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">calc_median</span><span class="p">(</span><span class="n">b</span><span class="p">(</span><span class="mi">1</span><span class="p">:</span><span class="n">m</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-778" name="ln-778" href="#ln-778"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="nb">mod</span><span class="p">(</span><span class="n">n</span><span class="p">,</span><span class="mi">2</span><span class="p">)</span><span class="w"> </span><span class="o">==</span><span class="w"> </span><span class="mi">0</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-779" name="ln-779" href="#ln-779"></a><span class="k"> </span><span class="n">upper_q</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">calc_median</span><span class="p">(</span><span class="n">b</span><span class="p">(</span><span class="n">m</span><span class="o">+</span><span class="mi">1</span><span class="p">:</span><span class="n">n</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-780" name="ln-780" href="#ln-780"></a><span class="w"> </span><span class="k">else</span>
|
|
<a id="ln-781" name="ln-781" href="#ln-781"></a><span class="k"> </span><span class="n">upper_q</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">calc_median</span><span class="p">(</span><span class="n">b</span><span class="p">(</span><span class="n">m</span><span class="p">:</span><span class="n">n</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-782" name="ln-782" href="#ln-782"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-783" name="ln-783" href="#ln-783"></a><span class="k"> end if</span>
|
|
<a id="ln-784" name="ln-784" href="#ln-784"></a><span class="k"> end subroutine </span><span class="n">summary_stats</span><span class="w"></span>
|
|
<a id="ln-785" name="ln-785" href="#ln-785"></a><span class="w"> </span>
|
|
<a id="ln-786" name="ln-786" href="#ln-786"></a><span class="w"> </span><span class="k">function </span><span class="n">calc_median</span><span class="p">(</span><span class="n">a</span><span class="p">,</span><span class="w"> </span><span class="n">mid</span><span class="p">)</span><span class="w"> </span><span class="k">result</span><span class="p">(</span><span class="n">r</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-787" name="ln-787" href="#ln-787"></a><span class="w"> </span><span class="kt">real</span><span class="p">(</span><span class="mi">8</span><span class="p">),</span><span class="w"> </span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">a</span><span class="p">(:)</span><span class="w"></span>
|
|
<a id="ln-788" name="ln-788" href="#ln-788"></a><span class="w"> </span><span class="kt">integer</span><span class="p">,</span><span class="w"> </span><span class="k">intent</span><span class="p">(</span><span class="n">out</span><span class="p">),</span><span class="w"> </span><span class="k">optional</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">mid</span><span class="w"></span>
|
|
<a id="ln-789" name="ln-789" href="#ln-789"></a><span class="w"> </span><span class="kt">real</span><span class="p">(</span><span class="mi">8</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">r</span><span class="w"></span>
|
|
<a id="ln-790" name="ln-790" href="#ln-790"></a><span class="w"> </span><span class="kt">integer</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">m</span><span class="p">,</span><span class="w"> </span><span class="n">n</span><span class="w"></span>
|
|
<a id="ln-791" name="ln-791" href="#ln-791"></a><span class="w"> </span><span class="n">n</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">size</span><span class="p">(</span><span class="n">a</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-792" name="ln-792" href="#ln-792"></a><span class="w"> </span><span class="n">m</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">n</span><span class="o">/</span><span class="mi">2</span><span class="w"></span>
|
|
<a id="ln-793" name="ln-793" href="#ln-793"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="nb">mod</span><span class="p">(</span><span class="n">n</span><span class="p">,</span><span class="mi">2</span><span class="p">)</span><span class="w"> </span><span class="o">==</span><span class="w"> </span><span class="mi">0</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-794" name="ln-794" href="#ln-794"></a><span class="k"> </span><span class="n">r</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="p">(</span><span class="n">a</span><span class="p">(</span><span class="n">m</span><span class="p">)</span><span class="w"> </span><span class="o">+</span><span class="w"> </span><span class="n">a</span><span class="p">(</span><span class="n">m</span><span class="o">+</span><span class="mi">1</span><span class="p">))</span><span class="o">/</span><span class="mf">2.0d0</span><span class="w"></span>
|
|
<a id="ln-795" name="ln-795" href="#ln-795"></a><span class="w"> </span><span class="k">else</span>
|
|
<a id="ln-796" name="ln-796" href="#ln-796"></a><span class="k"> </span><span class="n">m</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">m</span><span class="w"> </span><span class="o">+</span><span class="w"> </span><span class="mi">1</span><span class="w"></span>
|
|
<a id="ln-797" name="ln-797" href="#ln-797"></a><span class="w"> </span><span class="n">r</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">a</span><span class="p">(</span><span class="n">m</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-798" name="ln-798" href="#ln-798"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-799" name="ln-799" href="#ln-799"></a><span class="k"> if</span><span class="w"> </span><span class="p">(</span><span class="nb">present</span><span class="p">(</span><span class="n">mid</span><span class="p">))</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-800" name="ln-800" href="#ln-800"></a><span class="k"> </span><span class="n">mid</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">m</span><span class="w"></span>
|
|
<a id="ln-801" name="ln-801" href="#ln-801"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-802" name="ln-802" href="#ln-802"></a><span class="k"> end function </span><span class="n">calc_median</span><span class="w"></span>
|
|
<a id="ln-803" name="ln-803" href="#ln-803"></a><span class="w"> </span>
|
|
<a id="ln-804" name="ln-804" href="#ln-804"></a><span class="w"> </span><span class="c">! 'a' won't be very big so a simple n**2 algorithm will do</span>
|
|
<a id="ln-805" name="ln-805" href="#ln-805"></a><span class="w"> </span><span class="k">subroutine </span><span class="n">sort</span><span class="p">(</span><span class="n">a</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-806" name="ln-806" href="#ln-806"></a><span class="w"> </span><span class="kt">real</span><span class="p">(</span><span class="mi">8</span><span class="p">),</span><span class="w"> </span><span class="k">intent</span><span class="p">(</span><span class="n">inout</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">a</span><span class="p">(:)</span><span class="w"></span>
|
|
<a id="ln-807" name="ln-807" href="#ln-807"></a><span class="w"> </span><span class="kt">real</span><span class="p">(</span><span class="mi">8</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">b</span><span class="p">(</span><span class="n">size</span><span class="p">(</span><span class="n">a</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-808" name="ln-808" href="#ln-808"></a><span class="w"> </span><span class="kt">integer</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">i</span><span class="p">,</span><span class="w"> </span><span class="n">j</span><span class="p">(</span><span class="n">size</span><span class="p">(</span><span class="n">a</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-809" name="ln-809" href="#ln-809"></a><span class="w"> </span><span class="kt">logical</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">mask</span><span class="p">(</span><span class="n">size</span><span class="p">(</span><span class="n">a</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-810" name="ln-810" href="#ln-810"></a><span class="w"> </span><span class="n">mask</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="p">.</span><span class="n">true</span><span class="p">.</span><span class="w"></span>
|
|
<a id="ln-811" name="ln-811" href="#ln-811"></a><span class="w"> </span><span class="n">b</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">a</span><span class="w"></span>
|
|
<a id="ln-812" name="ln-812" href="#ln-812"></a><span class="w"> </span><span class="k">do </span><span class="n">i</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span><span class="n">size</span><span class="p">(</span><span class="n">a</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-813" name="ln-813" href="#ln-813"></a><span class="w"> </span><span class="n">j</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="nb">minloc</span><span class="p">(</span><span class="n">b</span><span class="p">,</span><span class="w"> </span><span class="n">mask</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-814" name="ln-814" href="#ln-814"></a><span class="w"> </span><span class="k">associate</span><span class="w"> </span><span class="p">(</span><span class="n">j1</span><span class="w"> </span><span class="o">=></span><span class="w"> </span><span class="n">j</span><span class="p">(</span><span class="mi">1</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-815" name="ln-815" href="#ln-815"></a><span class="w"> </span><span class="n">a</span><span class="p">(</span><span class="n">i</span><span class="p">)</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">b</span><span class="p">(</span><span class="n">j1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-816" name="ln-816" href="#ln-816"></a><span class="w"> </span><span class="n">mask</span><span class="p">(</span><span class="n">j1</span><span class="p">)</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="p">.</span><span class="n">false</span><span class="p">.</span><span class="w"></span>
|
|
<a id="ln-817" name="ln-817" href="#ln-817"></a><span class="w"> </span><span class="k">end associate</span>
|
|
<a id="ln-818" name="ln-818" href="#ln-818"></a><span class="k"> end do</span>
|
|
<a id="ln-819" name="ln-819" href="#ln-819"></a><span class="k"> end subroutine</span>
|
|
<a id="ln-820" name="ln-820" href="#ln-820"></a><span class="k"> </span>
|
|
<a id="ln-821" name="ln-821" href="#ln-821"></a><span class="k"> subroutine </span><span class="n">toggle_degrees_mode</span><span class="p">(</span><span class="n">new_mode</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-822" name="ln-822" href="#ln-822"></a><span class="w"> </span><span class="kt">logical</span><span class="p">,</span><span class="w"> </span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">new_mode</span><span class="w"></span>
|
|
<a id="ln-823" name="ln-823" href="#ln-823"></a><span class="w"> </span><span class="kt">integer</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">i</span><span class="w"></span>
|
|
<a id="ln-824" name="ln-824" href="#ln-824"></a><span class="w"> </span><span class="k">type</span><span class="p">(</span><span class="n">rpn_t</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">rz</span><span class="w"></span>
|
|
<a id="ln-825" name="ln-825" href="#ln-825"></a><span class="w"> </span>
|
|
<a id="ln-826" name="ln-826" href="#ln-826"></a><span class="w"> </span><span class="c">! Only do something if the modes are different</span>
|
|
<a id="ln-827" name="ln-827" href="#ln-827"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">new_mode</span><span class="w"> </span><span class="p">.</span><span class="n">eqv</span><span class="p">.</span><span class="w"> </span><span class="n">degrees_mode</span><span class="p">)</span><span class="w"> </span><span class="k">return</span>
|
|
<a id="ln-828" name="ln-828" href="#ln-828"></a><span class="k"> </span>
|
|
<a id="ln-829" name="ln-829" href="#ln-829"></a><span class="k"> </span><span class="n">degrees_mode</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="p">.</span><span class="nb">not</span><span class="p">.</span><span class="w"> </span><span class="n">degrees_mode</span><span class="w"></span>
|
|
<a id="ln-830" name="ln-830" href="#ln-830"></a><span class="w"> </span>
|
|
<a id="ln-831" name="ln-831" href="#ln-831"></a><span class="w"> </span><span class="c">! Convert all polar complex numbers</span>
|
|
<a id="ln-832" name="ln-832" href="#ln-832"></a><span class="w"> </span><span class="c">! 1) In the stack</span>
|
|
<a id="ln-833" name="ln-833" href="#ln-833"></a><span class="w"> </span><span class="k">do </span><span class="n">i</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span><span class="n">stack</span><span class="p">%</span><span class="n">ssize</span><span class="w"></span>
|
|
<a id="ln-834" name="ln-834" href="#ln-834"></a><span class="w"> </span><span class="n">rz</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">stack</span><span class="p">%</span><span class="n">peek</span><span class="p">(</span><span class="n">i</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-835" name="ln-835" href="#ln-835"></a><span class="w"> </span><span class="k">call </span><span class="n">update_angle_unit</span><span class="p">(</span><span class="n">rz</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-836" name="ln-836" href="#ln-836"></a><span class="w"> </span><span class="k">call </span><span class="n">stack</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="n">rz</span><span class="p">,</span><span class="n">i</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-837" name="ln-837" href="#ln-837"></a><span class="w"> </span><span class="k">end do</span><span class="w"></span>
|
|
<a id="ln-838" name="ln-838" href="#ln-838"></a><span class="w"> </span>
|
|
<a id="ln-839" name="ln-839" href="#ln-839"></a><span class="w"> </span><span class="c">! 2) in memory</span>
|
|
<a id="ln-840" name="ln-840" href="#ln-840"></a><span class="w"> </span><span class="k">do </span><span class="n">i</span><span class="o">=</span><span class="nb">lbound</span><span class="p">(</span><span class="n">mem</span><span class="p">,</span><span class="mi">1</span><span class="p">),</span><span class="nb">ubound</span><span class="p">(</span><span class="n">mem</span><span class="p">,</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-841" name="ln-841" href="#ln-841"></a><span class="w"> </span><span class="k">call </span><span class="n">update_angle_unit</span><span class="p">(</span><span class="n">mem</span><span class="p">(</span><span class="n">i</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-842" name="ln-842" href="#ln-842"></a><span class="w"> </span><span class="k">end do</span><span class="w"></span>
|
|
<a id="ln-843" name="ln-843" href="#ln-843"></a><span class="w"> </span>
|
|
<a id="ln-844" name="ln-844" href="#ln-844"></a><span class="w"> </span><span class="c">! 3) in multiple roots</span>
|
|
<a id="ln-845" name="ln-845" href="#ln-845"></a><span class="w"> </span><span class="k">do </span><span class="n">i</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span><span class="n">nroots</span><span class="w"></span>
|
|
<a id="ln-846" name="ln-846" href="#ln-846"></a><span class="w"> </span><span class="k">call </span><span class="n">update_angle_unit</span><span class="p">(</span><span class="n">roots</span><span class="p">(</span><span class="n">i</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-847" name="ln-847" href="#ln-847"></a><span class="w"> </span><span class="k">end do</span>
|
|
<a id="ln-848" name="ln-848" href="#ln-848"></a><span class="k"> </span>
|
|
<a id="ln-849" name="ln-849" href="#ln-849"></a><span class="k"> end subroutine </span><span class="n">toggle_degrees_mode</span><span class="w"></span>
|
|
<a id="ln-850" name="ln-850" href="#ln-850"></a><span class="w"> </span>
|
|
<a id="ln-851" name="ln-851" href="#ln-851"></a><span class="w"> </span><span class="k">subroutine </span><span class="n">update_angle_unit</span><span class="p">(</span><span class="n">rz</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-852" name="ln-852" href="#ln-852"></a><span class="w"> </span><span class="k">type</span><span class="p">(</span><span class="n">rpn_t</span><span class="p">),</span><span class="w"> </span><span class="k">intent</span><span class="p">(</span><span class="n">inout</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">rz</span><span class="w"></span>
|
|
<a id="ln-853" name="ln-853" href="#ln-853"></a><span class="w"> </span><span class="kt">complex</span><span class="p">(</span><span class="mi">8</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">zs</span><span class="w"></span>
|
|
<a id="ln-854" name="ln-854" href="#ln-854"></a><span class="w"> </span><span class="kt">logical</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">is_cart</span><span class="w"></span>
|
|
<a id="ln-855" name="ln-855" href="#ln-855"></a><span class="w"> </span><span class="n">zs</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">rz</span><span class="p">%</span><span class="n">get_value</span><span class="p">(</span><span class="n">is_cart</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-856" name="ln-856" href="#ln-856"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">is_cart</span><span class="p">)</span><span class="w"> </span><span class="k">return</span>
|
|
<a id="ln-857" name="ln-857" href="#ln-857"></a><span class="k"> </span><span class="n">zs</span><span class="p">%</span><span class="n">im</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">zs</span><span class="p">%</span><span class="n">im</span><span class="o">*</span><span class="nb">merge</span><span class="p">(</span><span class="n">to_deg</span><span class="p">,</span><span class="w"> </span><span class="n">to_rad</span><span class="p">,</span><span class="w"> </span><span class="n">degrees_mode</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-858" name="ln-858" href="#ln-858"></a><span class="w"> </span><span class="k">call </span><span class="n">rz</span><span class="p">%</span><span class="n">set_value</span><span class="p">(</span><span class="n">zs</span><span class="p">,</span><span class="n">is_cart</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-859" name="ln-859" href="#ln-859"></a><span class="w"> </span><span class="k">end subroutine </span><span class="n">update_angle_unit</span><span class="w"></span>
|
|
<a id="ln-860" name="ln-860" href="#ln-860"></a><span class="w"> </span>
|
|
<a id="ln-861" name="ln-861" href="#ln-861"></a><span class="w"> </span><span class="k">subroutine </span><span class="n">invoke_binary</span><span class="p">(</span><span class="n">action</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-862" name="ln-862" href="#ln-862"></a><span class="w"> </span><span class="k">procedure</span><span class="p">(</span><span class="n">binary_f</span><span class="p">),</span><span class="w"> </span><span class="k">pointer</span><span class="p">,</span><span class="w"> </span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">action</span><span class="w"></span>
|
|
<a id="ln-863" name="ln-863" href="#ln-863"></a><span class="w"> </span><span class="k">type</span><span class="p">(</span><span class="n">rpn_t</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">us</span><span class="p">,</span><span class="w"> </span><span class="n">zs</span><span class="w"></span>
|
|
<a id="ln-864" name="ln-864" href="#ln-864"></a><span class="w"> </span><span class="kt">logical</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">is_cart</span><span class="w"></span>
|
|
<a id="ln-865" name="ln-865" href="#ln-865"></a>
|
|
<a id="ln-866" name="ln-866" href="#ln-866"></a><span class="w"> </span><span class="n">zs</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">stack</span><span class="p">%</span><span class="n">pop</span><span class="p">()</span><span class="w"></span>
|
|
<a id="ln-867" name="ln-867" href="#ln-867"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">complex_mode</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-868" name="ln-868" href="#ln-868"></a><span class="k"> </span><span class="n">is_cart</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">zs</span><span class="p">%</span><span class="n">is_cartesian</span><span class="p">()</span><span class="w"></span>
|
|
<a id="ln-869" name="ln-869" href="#ln-869"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="w"> </span><span class="n">is_cart</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-870" name="ln-870" href="#ln-870"></a><span class="k"> </span><span class="n">zs</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">to_cartesian</span><span class="p">(</span><span class="n">zs</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-871" name="ln-871" href="#ln-871"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-872" name="ln-872" href="#ln-872"></a><span class="k"> </span><span class="n">us</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">stack</span><span class="p">%</span><span class="n">peek</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-873" name="ln-873" href="#ln-873"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="w"> </span><span class="n">us</span><span class="p">%</span><span class="n">is_cartesian</span><span class="p">())</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-874" name="ln-874" href="#ln-874"></a><span class="k"> </span><span class="n">us</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">to_polar</span><span class="p">(</span><span class="n">us</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-875" name="ln-875" href="#ln-875"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-876" name="ln-876" href="#ln-876"></a><span class="k"> </span><span class="n">us</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">action</span><span class="p">(</span><span class="n">us</span><span class="p">,</span><span class="n">zs</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-877" name="ln-877" href="#ln-877"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="w"> </span><span class="n">is_cart</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-878" name="ln-878" href="#ln-878"></a><span class="k"> </span><span class="n">us</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">to_polar</span><span class="p">(</span><span class="n">us</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-879" name="ln-879" href="#ln-879"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-880" name="ln-880" href="#ln-880"></a><span class="k"> call </span><span class="n">stack</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="n">us</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-881" name="ln-881" href="#ln-881"></a><span class="w"> </span><span class="k">else</span>
|
|
<a id="ln-882" name="ln-882" href="#ln-882"></a><span class="k"> </span><span class="n">us</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">stack</span><span class="p">%</span><span class="n">peek</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-883" name="ln-883" href="#ln-883"></a><span class="w"> </span><span class="k">call </span><span class="n">stack</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="n">action</span><span class="p">(</span><span class="n">us</span><span class="p">,</span><span class="n">zs</span><span class="p">))</span><span class="w"></span>
|
|
<a id="ln-884" name="ln-884" href="#ln-884"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-885" name="ln-885" href="#ln-885"></a><span class="k"> end subroutine </span><span class="n">invoke_binary</span><span class="w"></span>
|
|
<a id="ln-886" name="ln-886" href="#ln-886"></a><span class="w"> </span>
|
|
<a id="ln-887" name="ln-887" href="#ln-887"></a><span class="w"> </span><span class="k">subroutine </span><span class="n">invoke_unary</span><span class="p">(</span><span class="n">action</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-888" name="ln-888" href="#ln-888"></a><span class="w"> </span><span class="k">procedure</span><span class="p">(</span><span class="n">unary_f</span><span class="p">),</span><span class="w"> </span><span class="k">pointer</span><span class="p">,</span><span class="w"> </span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">action</span><span class="w"></span>
|
|
<a id="ln-889" name="ln-889" href="#ln-889"></a><span class="w"> </span><span class="kt">logical</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">is_cart</span><span class="w"></span>
|
|
<a id="ln-890" name="ln-890" href="#ln-890"></a><span class="w"> </span><span class="k">type</span><span class="p">(</span><span class="n">rpn_t</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">z</span><span class="w"></span>
|
|
<a id="ln-891" name="ln-891" href="#ln-891"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">complex_mode</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-892" name="ln-892" href="#ln-892"></a><span class="k"> </span><span class="n">z</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">stack</span><span class="p">%</span><span class="n">peek</span><span class="p">(</span><span class="mi">1</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-893" name="ln-893" href="#ln-893"></a><span class="w"> </span><span class="n">is_cart</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">z</span><span class="p">%</span><span class="n">is_cartesian</span><span class="p">()</span><span class="w"></span>
|
|
<a id="ln-894" name="ln-894" href="#ln-894"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="w"> </span><span class="n">is_cart</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-895" name="ln-895" href="#ln-895"></a><span class="k"> </span><span class="n">z</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">to_cartesian</span><span class="p">(</span><span class="n">z</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-896" name="ln-896" href="#ln-896"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-897" name="ln-897" href="#ln-897"></a><span class="k"> </span><span class="n">z</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">action</span><span class="p">(</span><span class="n">z</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-898" name="ln-898" href="#ln-898"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(.</span><span class="nb">not</span><span class="p">.</span><span class="w"> </span><span class="n">is_cart</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-899" name="ln-899" href="#ln-899"></a><span class="k"> </span><span class="n">z</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">to_polar</span><span class="p">(</span><span class="n">z</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-900" name="ln-900" href="#ln-900"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-901" name="ln-901" href="#ln-901"></a><span class="k"> call </span><span class="n">stack</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="n">z</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-902" name="ln-902" href="#ln-902"></a><span class="w"> </span><span class="k">else</span>
|
|
<a id="ln-903" name="ln-903" href="#ln-903"></a><span class="k"> call </span><span class="n">stack</span><span class="p">%</span><span class="n">set</span><span class="p">(</span><span class="n">action</span><span class="p">(</span><span class="n">stack</span><span class="p">%</span><span class="n">peek</span><span class="p">(</span><span class="mi">1</span><span class="p">)))</span><span class="w"></span>
|
|
<a id="ln-904" name="ln-904" href="#ln-904"></a><span class="w"> </span><span class="k">end if</span>
|
|
<a id="ln-905" name="ln-905" href="#ln-905"></a><span class="k"> end subroutine </span><span class="n">invoke_unary</span><span class="w"></span>
|
|
<a id="ln-906" name="ln-906" href="#ln-906"></a>
|
|
<a id="ln-907" name="ln-907" href="#ln-907"></a><span class="w"> </span><span class="kt">integer </span><span class="k">function </span><span class="n">nsp</span><span class="p">(</span><span class="n">command</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-908" name="ln-908" href="#ln-908"></a><span class="w"> </span><span class="k">implicit none</span>
|
|
<a id="ln-909" name="ln-909" href="#ln-909"></a><span class="k"> </span><span class="kt">character</span><span class="p">(</span><span class="o">*</span><span class="p">),</span><span class="w"> </span><span class="k">intent</span><span class="p">(</span><span class="n">in</span><span class="p">)</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">command</span><span class="w"></span>
|
|
<a id="ln-910" name="ln-910" href="#ln-910"></a><span class="w"> </span><span class="kt">integer</span><span class="w"> </span><span class="kd">::</span><span class="w"> </span><span class="n">i</span><span class="w"></span>
|
|
<a id="ln-911" name="ln-911" href="#ln-911"></a><span class="w"> </span><span class="k">do </span><span class="n">i</span><span class="o">=</span><span class="mi">1</span><span class="p">,</span><span class="nb">len</span><span class="p">(</span><span class="n">command</span><span class="p">)</span><span class="w"></span>
|
|
<a id="ln-912" name="ln-912" href="#ln-912"></a><span class="w"> </span><span class="k">if</span><span class="w"> </span><span class="p">(</span><span class="n">command</span><span class="p">(</span><span class="n">i</span><span class="p">:</span><span class="n">i</span><span class="p">)</span><span class="w"> </span><span class="o">/=</span><span class="w"> </span><span class="s1">' '</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<a id="ln-913" name="ln-913" href="#ln-913"></a><span class="k"> </span><span class="n">nsp</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="n">i</span><span class="w"></span>
|
|
<a id="ln-914" name="ln-914" href="#ln-914"></a><span class="w"> </span><span class="k">return</span>
|
|
<a id="ln-915" name="ln-915" href="#ln-915"></a><span class="k"> end if</span>
|
|
<a id="ln-916" name="ln-916" href="#ln-916"></a><span class="k"> end do</span>
|
|
<a id="ln-917" name="ln-917" href="#ln-917"></a><span class="k"> </span><span class="n">nsp</span><span class="w"> </span><span class="o">=</span><span class="w"> </span><span class="mi">0</span><span class="w"></span>
|
|
<a id="ln-918" name="ln-918" href="#ln-918"></a><span class="w"> </span><span class="k">end function </span><span class="n">nsp</span><span class="w"></span>
|
|
<a id="ln-919" name="ln-919" href="#ln-919"></a>
|
|
<a id="ln-920" name="ln-920" href="#ln-920"></a><span class="k">end program </span><span class="n">hp15c</span><span class="w"></span>
|
|
</pre></div>
|
|
|
|
</section>
|
|
</div>
|
|
</div>
|
|
|
|
<hr>
|
|
</div> <!-- /container -->
|
|
<footer>
|
|
<div class="container">
|
|
<div class="row">
|
|
<div class="col-xs-6 col-md-6"><p>hp was developed by sgeard<br>© 2023
|
|
</p>
|
|
</div>
|
|
<div class="col-xs-6 col-md-6">
|
|
<p class="text-right">
|
|
Documentation generated by
|
|
<a href="https://github.com/Fortran-FOSS-Programmers/ford">FORD</a>
|
|
</p>
|
|
</div>
|
|
</div>
|
|
<br>
|
|
</div> <!-- /container -->
|
|
</footer>
|
|
|
|
<!-- Bootstrap core JavaScript
|
|
================================================== -->
|
|
<!-- Placed at the end of the document so the pages load faster -->
|
|
<!--
|
|
<script src="https://ajax.googleapis.com/ajax/libs/jquery/1.11.1/jquery.min.js"></script>
|
|
-->
|
|
<script src="../js/bootstrap.min.js"></script>
|
|
<!-- IE10 viewport hack for Surface/desktop Windows 8 bug -->
|
|
<script src="../js/ie10-viewport-bug-workaround.js"></script>
|
|
|
|
<!-- MathJax JavaScript
|
|
================================================== -->
|
|
<!-- Placed at the end of the document so the pages load faster -->
|
|
<script type="text/x-mathjax-config">
|
|
MathJax.Hub.Config({
|
|
TeX: { extensions: ['AMSmath.js','AMSsymbols.js','noErrors.js','noUndefined.js'], equationNumbers: { autoNumber: 'AMS' } },
|
|
jax: ['input/TeX','input/MathML','output/HTML-CSS'],
|
|
extensions: ['tex2jax.js','mml2jax.js','MathMenu.js','MathZoom.js']
|
|
});
|
|
</script>
|
|
<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.1/MathJax.js?config=TeX-AMS-MML_HTMLorMML"></script>
|
|
|
|
<script src="../tipuesearch/tipuesearch_content.js"></script>
|
|
<script src="../tipuesearch/tipuesearch_set.js"></script>
|
|
<script src="../tipuesearch/tipuesearch.js"></script>
|
|
|
|
</body>
|
|
</html> |