2625 lines
No EOL
243 KiB
HTML
2625 lines
No EOL
243 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>hp15c – 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>hp15c <small>Program</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="98.0% of total for programs.">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><a href='../sourcefile/main.f90.html'>main.f90</a></li>
|
|
<li class="active">hp15c</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="#vars-0">Variables</a>
|
|
</h3>
|
|
</div>
|
|
<div id="vars-0" class="panel-collapse collapse">
|
|
<div class="list-group">
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-ag">ag</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-argc">argc</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-argl">argl</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-blen">blen</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-buff">buff</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-c~3">c</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-constants">constants</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-e">e</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-g">g</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-getnext">getNext</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-have_expression">have_expression</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-i~6">i</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-in_sequence">in_sequence</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-ios">ios</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-lang~3">lang</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-lang_en">lang_en</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-mem">mem</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-msg">msg</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-n_seq">n_seq</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-numbers">numbers</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-ok~3">ok</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-seq_is_x">seq_is_x</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-stack">stack</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-stat">stat</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-stats">stats</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-tmp_cmode">tmp_cmode</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-token~2">token</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-tokens">tokens</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-vemode">veMode</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-verbosity">verbosity</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-x~6">x</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-x_seq">x_seq</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-y_seq">y_seq</a>
|
|
</div>
|
|
</div>
|
|
</div>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<div class="panel panel-primary">
|
|
<div class="panel-heading text-left">
|
|
<h3 class="panel-title">
|
|
<a data-toggle="collapse" href="#funcs-0">Functions</a>
|
|
</h3>
|
|
</div>
|
|
<div id="funcs-0" class="panel-collapse collapse">
|
|
<div class="list-group">
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-calc_median">calc_median</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-nsp">nsp</a>
|
|
</div>
|
|
</div>
|
|
</div>
|
|
|
|
<div class="panel panel-primary">
|
|
<div class="panel-heading text-left">
|
|
<h3 class="panel-title">
|
|
<a data-toggle="collapse" href="#subs-0">Subroutines</a>
|
|
</h3>
|
|
</div>
|
|
<div id="subs-0" class="panel-collapse collapse">
|
|
<div class="list-group">
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-apply_command">apply_command</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-calculate_regression">calculate_regression</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-calculate_stats">calculate_stats</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-help">help</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-invoke_binary">invoke_binary</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-invoke_unary">invoke_unary</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-print_value">print_value</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-sort">sort</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-summary_stats">summary_stats</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-toggle_degrees_mode">toggle_degrees_mode</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-tokenize">tokenize</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-update_angle_unit">update_angle_unit</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="../program/hp15c.html#src">hp15c</a>
|
|
</div>
|
|
</div>
|
|
|
|
|
|
</div>
|
|
|
|
</div>
|
|
|
|
<div class="col-md-9" id='text'>
|
|
<div class="panel panel-default">
|
|
<div class="panel-heading">
|
|
<h3 class="panel-title">Uses</h3>
|
|
</div>
|
|
<ul class="list-group">
|
|
<li class="list-group-item">
|
|
<ul class="list-inline">
|
|
<li><a href='../module/linked_list.html'>linked_list</a></li>
|
|
<li><a href='../module/amap.html'>amap</a></li>
|
|
<li><a href='../module/rpn_stack.html'>rpn_stack</a></li>
|
|
</ul>
|
|
</li>
|
|
</ul>
|
|
</div>
|
|
|
|
|
|
|
|
<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="#vars-1">Variables</a>
|
|
</h3>
|
|
</div>
|
|
<div id="vars-1" class="panel-collapse collapse">
|
|
<div class="list-group">
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-ag">ag</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-argc">argc</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-argl">argl</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-blen">blen</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-buff">buff</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-c~3">c</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-constants">constants</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-e">e</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-g">g</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-getnext">getNext</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-have_expression">have_expression</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-i~6">i</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-in_sequence">in_sequence</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-ios">ios</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-lang~3">lang</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-lang_en">lang_en</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-mem">mem</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-msg">msg</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-n_seq">n_seq</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-numbers">numbers</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-ok~3">ok</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-seq_is_x">seq_is_x</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-stack">stack</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-stat">stat</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-stats">stats</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-tmp_cmode">tmp_cmode</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-token~2">token</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-tokens">tokens</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-vemode">veMode</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-verbosity">verbosity</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-x~6">x</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-x_seq">x_seq</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#variable-y_seq">y_seq</a>
|
|
</div>
|
|
</div>
|
|
</div>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<div class="panel panel-primary">
|
|
<div class="panel-heading text-left">
|
|
<h3 class="panel-title">
|
|
<a data-toggle="collapse" href="#funcs-1">Functions</a>
|
|
</h3>
|
|
</div>
|
|
<div id="funcs-1" class="panel-collapse collapse">
|
|
<div class="list-group">
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-calc_median">calc_median</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-nsp">nsp</a>
|
|
</div>
|
|
</div>
|
|
</div>
|
|
|
|
<div class="panel panel-primary">
|
|
<div class="panel-heading text-left">
|
|
<h3 class="panel-title">
|
|
<a data-toggle="collapse" href="#subs-1">Subroutines</a>
|
|
</h3>
|
|
</div>
|
|
<div id="subs-1" class="panel-collapse collapse">
|
|
<div class="list-group">
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-apply_command">apply_command</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-calculate_regression">calculate_regression</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-calculate_stats">calculate_stats</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-help">help</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-invoke_binary">invoke_binary</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-invoke_unary">invoke_unary</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-print_value">print_value</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-sort">sort</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-summary_stats">summary_stats</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-toggle_degrees_mode">toggle_degrees_mode</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-tokenize">tokenize</a>
|
|
<a class="list-group-item" href="../program/hp15c.html#proc-update_angle_unit">update_angle_unit</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="../program/hp15c.html#src">hp15c</a>
|
|
</div>
|
|
</div>
|
|
|
|
|
|
</section>
|
|
<br class="visible-xs visible-sm hidden-md">
|
|
|
|
|
|
<section>
|
|
<h2>Variables</h2>
|
|
<table class="table table-striped varlist">
|
|
<thead>
|
|
<tr>
|
|
<th>Type</th>
|
|
<th>Attributes</th>
|
|
<th></th>
|
|
<th>Name</th>
|
|
<th></th><th>Initial</th> <th></th>
|
|
</thead>
|
|
<tbody>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-ag"></span>
|
|
real(kind=8),
|
|
</td>
|
|
<td>
|
|
parameter
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>ag</strong></td>
|
|
<td> =</td>
|
|
<td>9.80665d0</td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-argc"></span>
|
|
integer
|
|
</td>
|
|
<td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>argc</strong></td>
|
|
<td></td>
|
|
<td></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-argl"></span>
|
|
integer
|
|
</td>
|
|
<td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>argl</strong></td>
|
|
<td></td>
|
|
<td></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-blen"></span>
|
|
integer
|
|
</td>
|
|
<td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>blen</strong></td>
|
|
<td></td>
|
|
<td></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-buff"></span>
|
|
character(len=100)
|
|
</td>
|
|
<td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>buff</strong></td>
|
|
<td></td>
|
|
<td></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-c~3"></span>
|
|
real(kind=8),
|
|
</td>
|
|
<td>
|
|
parameter
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>c</strong></td>
|
|
<td> =</td>
|
|
<td>2.99792458d8</td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-constants"></span>
|
|
type(<a href='../type/amap_t.html'>amap_t</a>)
|
|
</td>
|
|
<td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>constants</strong></td>
|
|
<td></td>
|
|
<td></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-e"></span>
|
|
real(kind=8),
|
|
</td>
|
|
<td>
|
|
parameter
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>e</strong></td>
|
|
<td> =</td>
|
|
<td>exp(1.0d0)</td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-g"></span>
|
|
real(kind=8),
|
|
</td>
|
|
<td>
|
|
parameter
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>g</strong></td>
|
|
<td> =</td>
|
|
<td>6.67430d-11</td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-getnext"></span>
|
|
logical
|
|
</td>
|
|
<td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>getNext</strong></td>
|
|
<td></td>
|
|
<td></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-have_expression"></span>
|
|
logical
|
|
</td>
|
|
<td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>have_expression</strong></td>
|
|
<td></td>
|
|
<td></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-i~6"></span>
|
|
integer
|
|
</td>
|
|
<td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>i</strong></td>
|
|
<td></td>
|
|
<td></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-in_sequence"></span>
|
|
integer
|
|
</td>
|
|
<td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>in_sequence</strong></td>
|
|
<td> =</td>
|
|
<td>0</td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-ios"></span>
|
|
integer
|
|
</td>
|
|
<td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>ios</strong></td>
|
|
<td></td>
|
|
<td></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-lang~3"></span>
|
|
character(len=5)
|
|
</td>
|
|
<td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>lang</strong></td>
|
|
<td></td>
|
|
<td></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-lang_en"></span>
|
|
logical
|
|
</td>
|
|
<td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>lang_en</strong></td>
|
|
<td> =</td>
|
|
<td>.true.</td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-mem"></span>
|
|
type(<a href='../type/rpn_t.html'>rpn_t</a>)
|
|
</td>
|
|
<td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>mem</strong>(0:9)</td>
|
|
<td> =</td>
|
|
<td>rpn_t()</td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-msg"></span>
|
|
character(len=100)
|
|
</td>
|
|
<td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>msg</strong></td>
|
|
<td></td>
|
|
<td></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-n_seq"></span>
|
|
integer
|
|
</td>
|
|
<td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>n_seq</strong></td>
|
|
<td> =</td>
|
|
<td>0</td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-numbers"></span>
|
|
logical
|
|
</td>
|
|
<td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>numbers</strong></td>
|
|
<td></td>
|
|
<td></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-ok~3"></span>
|
|
logical
|
|
</td>
|
|
<td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>ok</strong></td>
|
|
<td></td>
|
|
<td></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-seq_is_x"></span>
|
|
logical
|
|
</td>
|
|
<td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>seq_is_x</strong></td>
|
|
<td></td>
|
|
<td></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-stack"></span>
|
|
type(<a href='../type/stack_t.html'>stack_t</a>(5))
|
|
</td>
|
|
<td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>stack</strong></td>
|
|
<td></td>
|
|
<td></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-stat"></span>
|
|
integer
|
|
</td>
|
|
<td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>stat</strong></td>
|
|
<td></td>
|
|
<td></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-stats"></span>
|
|
type(<a href='../type/amap_t.html'>amap_t</a>)
|
|
</td>
|
|
<td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>stats</strong></td>
|
|
<td></td>
|
|
<td></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-tmp_cmode"></span>
|
|
logical
|
|
</td>
|
|
<td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>tmp_cmode</strong></td>
|
|
<td></td>
|
|
<td></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-token~2"></span>
|
|
type(<a href='../type/llist_node.html'>llist_node</a>),
|
|
</td>
|
|
<td>
|
|
pointer
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>token</strong></td>
|
|
<td></td>
|
|
<td></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-tokens"></span>
|
|
type(<a href='../type/llist.html'>llist</a>)
|
|
</td>
|
|
<td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>tokens</strong></td>
|
|
<td></td>
|
|
<td></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-vemode"></span>
|
|
logical
|
|
</td>
|
|
<td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>veMode</strong></td>
|
|
<td> =</td>
|
|
<td>.false.</td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-verbosity"></span>
|
|
integer
|
|
</td>
|
|
<td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>verbosity</strong></td>
|
|
<td> =</td>
|
|
<td>0</td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-x~6"></span>
|
|
real(kind=8)
|
|
</td>
|
|
<td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>x</strong></td>
|
|
<td></td>
|
|
<td></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-x_seq"></span>
|
|
real(kind=8),
|
|
</td>
|
|
<td>
|
|
allocatable
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>x_seq</strong>(:)</td>
|
|
<td></td>
|
|
<td></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" id="variable-y_seq"></span>
|
|
real(kind=8),
|
|
</td>
|
|
<td>
|
|
allocatable
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>y_seq</strong>(:)</td>
|
|
<td></td>
|
|
<td></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
</tbody>
|
|
</table>
|
|
|
|
</section>
|
|
<br>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<section>
|
|
<h2>Functions</h2>
|
|
<div class="panel panel-default">
|
|
<div class="panel-heading codesum"><span class="anchor" id="proc-calc_median"></span><h3> function <a href='../proc/calc_median.html'>calc_median</a>(a, mid) result(r)
|
|
</h3></div>
|
|
<div class="panel-body">
|
|
|
|
|
|
|
|
<h4>Arguments</h4>
|
|
<table class="table table-striped varlist">
|
|
<thead>
|
|
<tr>
|
|
<th>Type</th>
|
|
<th>Intent</th><th>Optional</th> <th>Attributes</th>
|
|
<th></th>
|
|
<th>Name</th>
|
|
<th></th>
|
|
</thead>
|
|
<tbody>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" ></span>
|
|
real(kind=8),
|
|
</td>
|
|
<td>intent(in)</td>
|
|
<td></td> <td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>a</strong>(:)</td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" ></span>
|
|
integer,
|
|
</td>
|
|
<td>intent(out),</td>
|
|
<td>optional</td> <td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>mid</strong></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
</tbody>
|
|
</table>
|
|
|
|
<h4>
|
|
Return Value
|
|
<small>real(kind=8)</small>
|
|
</h4>
|
|
|
|
|
|
</div>
|
|
</div>
|
|
|
|
<div class="panel panel-default">
|
|
<div class="panel-heading codesum"><span class="anchor" id="proc-nsp"></span><h3> function <a href='../proc/nsp.html'>nsp</a>(command)
|
|
</h3></div>
|
|
<div class="panel-body">
|
|
|
|
|
|
|
|
<h4>Arguments</h4>
|
|
<table class="table table-striped varlist">
|
|
<thead>
|
|
<tr>
|
|
<th>Type</th>
|
|
<th>Intent</th><th>Optional</th> <th>Attributes</th>
|
|
<th></th>
|
|
<th>Name</th>
|
|
<th></th>
|
|
</thead>
|
|
<tbody>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" ></span>
|
|
character,
|
|
</td>
|
|
<td>intent(in)</td>
|
|
<td></td> <td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>command</strong></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
</tbody>
|
|
</table>
|
|
|
|
<h4>
|
|
Return Value
|
|
<small>integer</small>
|
|
</h4>
|
|
|
|
|
|
</div>
|
|
</div>
|
|
|
|
</section>
|
|
<br>
|
|
|
|
|
|
<section>
|
|
<h2>Subroutines</h2>
|
|
<div class="panel panel-default">
|
|
<div class="panel-heading codesum"><span class="anchor" id="proc-apply_command"></span><h3> subroutine <a href='../proc/apply_command.html'>apply_command</a>(command, ok)
|
|
</h3></div>
|
|
<div class="panel-body">
|
|
|
|
|
|
|
|
<h4>Arguments</h4>
|
|
<table class="table table-striped varlist">
|
|
<thead>
|
|
<tr>
|
|
<th>Type</th>
|
|
<th>Intent</th><th>Optional</th> <th>Attributes</th>
|
|
<th></th>
|
|
<th>Name</th>
|
|
<th></th>
|
|
</thead>
|
|
<tbody>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" ></span>
|
|
character,
|
|
</td>
|
|
<td>intent(in)</td>
|
|
<td></td> <td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>command</strong></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" ></span>
|
|
logical,
|
|
</td>
|
|
<td>intent(out)</td>
|
|
<td></td> <td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>ok</strong></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
</tbody>
|
|
</table>
|
|
|
|
|
|
</div>
|
|
</div>
|
|
|
|
<div class="panel panel-default">
|
|
<div class="panel-heading codesum"><span class="anchor" id="proc-calculate_regression"></span><h3> subroutine <a href='../proc/calculate_regression.html'>calculate_regression</a>(mean_x, mean_y, a, b, c, sxy)
|
|
</h3></div>
|
|
<div class="panel-body">
|
|
|
|
|
|
|
|
<h4>Arguments</h4>
|
|
<table class="table table-striped varlist">
|
|
<thead>
|
|
<tr>
|
|
<th>Type</th>
|
|
<th>Intent</th><th>Optional</th> <th>Attributes</th>
|
|
<th></th>
|
|
<th>Name</th>
|
|
<th></th>
|
|
</thead>
|
|
<tbody>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" ></span>
|
|
real(kind=8),
|
|
</td>
|
|
<td>intent(in)</td>
|
|
<td></td> <td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>mean_x</strong></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" ></span>
|
|
real(kind=8),
|
|
</td>
|
|
<td>intent(in)</td>
|
|
<td></td> <td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>mean_y</strong></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" ></span>
|
|
real(kind=8),
|
|
</td>
|
|
<td>intent(out)</td>
|
|
<td></td> <td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>a</strong></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" ></span>
|
|
real(kind=8),
|
|
</td>
|
|
<td>intent(out)</td>
|
|
<td></td> <td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>b</strong></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" ></span>
|
|
real(kind=8),
|
|
</td>
|
|
<td>intent(out)</td>
|
|
<td></td> <td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>c</strong></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" ></span>
|
|
real(kind=8),
|
|
</td>
|
|
<td>intent(out)</td>
|
|
<td></td> <td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>sxy</strong></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
</tbody>
|
|
</table>
|
|
|
|
|
|
</div>
|
|
</div>
|
|
|
|
<div class="panel panel-default">
|
|
<div class="panel-heading codesum"><span class="anchor" id="proc-calculate_stats"></span><h3> subroutine <a href='../proc/calculate_stats.html'>calculate_stats</a>()
|
|
</h3></div>
|
|
<div class="panel-body">
|
|
|
|
|
|
|
|
<h4>Arguments</h4>
|
|
<em>None</em>
|
|
|
|
</div>
|
|
</div>
|
|
|
|
<div class="panel panel-default">
|
|
<div class="panel-heading codesum"><span class="anchor" id="proc-help"></span><h3> subroutine <a href='../proc/help.html'>help</a>()
|
|
</h3></div>
|
|
<div class="panel-body">
|
|
|
|
|
|
|
|
<h4>Arguments</h4>
|
|
<em>None</em>
|
|
|
|
</div>
|
|
</div>
|
|
|
|
<div class="panel panel-default">
|
|
<div class="panel-heading codesum"><span class="anchor" id="proc-invoke_binary"></span><h3> subroutine <a href='../proc/invoke_binary.html'>invoke_binary</a>(action)
|
|
</h3></div>
|
|
<div class="panel-body">
|
|
|
|
|
|
|
|
<h4>Arguments</h4>
|
|
<table class="table table-striped varlist">
|
|
<thead>
|
|
<tr>
|
|
<th>Type</th>
|
|
<th>Intent</th><th>Optional</th> <th>Attributes</th>
|
|
<th></th>
|
|
<th>Name</th>
|
|
<th></th>
|
|
</thead>
|
|
<tbody>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" ></span>
|
|
procedure(<a href='../interface/binary_f.html'>binary_f</a>),
|
|
</td>
|
|
<td>intent(in),</td>
|
|
<td></td> <td>
|
|
pointer
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>action</strong></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
</tbody>
|
|
</table>
|
|
|
|
|
|
</div>
|
|
</div>
|
|
|
|
<div class="panel panel-default">
|
|
<div class="panel-heading codesum"><span class="anchor" id="proc-invoke_unary"></span><h3> subroutine <a href='../proc/invoke_unary.html'>invoke_unary</a>(action)
|
|
</h3></div>
|
|
<div class="panel-body">
|
|
|
|
|
|
|
|
<h4>Arguments</h4>
|
|
<table class="table table-striped varlist">
|
|
<thead>
|
|
<tr>
|
|
<th>Type</th>
|
|
<th>Intent</th><th>Optional</th> <th>Attributes</th>
|
|
<th></th>
|
|
<th>Name</th>
|
|
<th></th>
|
|
</thead>
|
|
<tbody>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" ></span>
|
|
procedure(<a href='../interface/unary_f.html'>unary_f</a>),
|
|
</td>
|
|
<td>intent(in),</td>
|
|
<td></td> <td>
|
|
pointer
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>action</strong></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
</tbody>
|
|
</table>
|
|
|
|
|
|
</div>
|
|
</div>
|
|
|
|
<div class="panel panel-default">
|
|
<div class="panel-heading codesum"><span class="anchor" id="proc-print_value"></span><h3> subroutine <a href='../proc/print_value.html'>print_value</a>(name, x, y)
|
|
</h3></div>
|
|
<div class="panel-body">
|
|
|
|
|
|
|
|
<h4>Arguments</h4>
|
|
<table class="table table-striped varlist">
|
|
<thead>
|
|
<tr>
|
|
<th>Type</th>
|
|
<th>Intent</th><th>Optional</th> <th>Attributes</th>
|
|
<th></th>
|
|
<th>Name</th>
|
|
<th></th>
|
|
</thead>
|
|
<tbody>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" ></span>
|
|
character(len=*),
|
|
</td>
|
|
<td>intent(in)</td>
|
|
<td></td> <td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>name</strong></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" ></span>
|
|
real(kind=8),
|
|
</td>
|
|
<td>intent(in)</td>
|
|
<td></td> <td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>x</strong></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" ></span>
|
|
real(kind=8),
|
|
</td>
|
|
<td>intent(in),</td>
|
|
<td>optional</td> <td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>y</strong></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
</tbody>
|
|
</table>
|
|
|
|
|
|
</div>
|
|
</div>
|
|
|
|
<div class="panel panel-default">
|
|
<div class="panel-heading codesum"><span class="anchor" id="proc-sort"></span><h3> subroutine <a href='../proc/sort.html'>sort</a>(a)
|
|
</h3></div>
|
|
<div class="panel-body">
|
|
|
|
|
|
|
|
<h4>Arguments</h4>
|
|
<table class="table table-striped varlist">
|
|
<thead>
|
|
<tr>
|
|
<th>Type</th>
|
|
<th>Intent</th><th>Optional</th> <th>Attributes</th>
|
|
<th></th>
|
|
<th>Name</th>
|
|
<th></th>
|
|
</thead>
|
|
<tbody>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" ></span>
|
|
real(kind=8),
|
|
</td>
|
|
<td>intent(inout)</td>
|
|
<td></td> <td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>a</strong>(:)</td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
</tbody>
|
|
</table>
|
|
|
|
|
|
</div>
|
|
</div>
|
|
|
|
<div class="panel panel-default">
|
|
<div class="panel-heading codesum"><span class="anchor" id="proc-summary_stats"></span><h3> subroutine <a href='../proc/summary_stats.html'>summary_stats</a>(a, mean, median, stddev, lower_q, upper_q)
|
|
</h3></div>
|
|
<div class="panel-body">
|
|
|
|
|
|
|
|
<h4>Arguments</h4>
|
|
<table class="table table-striped varlist">
|
|
<thead>
|
|
<tr>
|
|
<th>Type</th>
|
|
<th>Intent</th><th>Optional</th> <th>Attributes</th>
|
|
<th></th>
|
|
<th>Name</th>
|
|
<th></th>
|
|
</thead>
|
|
<tbody>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" ></span>
|
|
real(kind=8),
|
|
</td>
|
|
<td>intent(in)</td>
|
|
<td></td> <td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>a</strong>(:)</td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" ></span>
|
|
real(kind=8),
|
|
</td>
|
|
<td>intent(out)</td>
|
|
<td></td> <td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>mean</strong></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" ></span>
|
|
real(kind=8),
|
|
</td>
|
|
<td>intent(out)</td>
|
|
<td></td> <td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>median</strong></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" ></span>
|
|
real(kind=8),
|
|
</td>
|
|
<td>intent(out)</td>
|
|
<td></td> <td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>stddev</strong></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" ></span>
|
|
real(kind=8),
|
|
</td>
|
|
<td>intent(out)</td>
|
|
<td></td> <td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>lower_q</strong></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" ></span>
|
|
real(kind=8),
|
|
</td>
|
|
<td>intent(out)</td>
|
|
<td></td> <td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>upper_q</strong></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
</tbody>
|
|
</table>
|
|
|
|
|
|
</div>
|
|
</div>
|
|
|
|
<div class="panel panel-default">
|
|
<div class="panel-heading codesum"><span class="anchor" id="proc-toggle_degrees_mode"></span><h3> subroutine <a href='../proc/toggle_degrees_mode.html'>toggle_degrees_mode</a>(new_mode)
|
|
</h3></div>
|
|
<div class="panel-body">
|
|
|
|
|
|
|
|
<h4>Arguments</h4>
|
|
<table class="table table-striped varlist">
|
|
<thead>
|
|
<tr>
|
|
<th>Type</th>
|
|
<th>Intent</th><th>Optional</th> <th>Attributes</th>
|
|
<th></th>
|
|
<th>Name</th>
|
|
<th></th>
|
|
</thead>
|
|
<tbody>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" ></span>
|
|
logical,
|
|
</td>
|
|
<td>intent(in)</td>
|
|
<td></td> <td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>new_mode</strong></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
</tbody>
|
|
</table>
|
|
|
|
|
|
</div>
|
|
</div>
|
|
|
|
<div class="panel panel-default">
|
|
<div class="panel-heading codesum"><span class="anchor" id="proc-tokenize"></span><h3> subroutine <a href='../proc/tokenize.html'>tokenize</a>(com)
|
|
</h3></div>
|
|
<div class="panel-body">
|
|
|
|
|
|
|
|
<h4>Arguments</h4>
|
|
<table class="table table-striped varlist">
|
|
<thead>
|
|
<tr>
|
|
<th>Type</th>
|
|
<th>Intent</th><th>Optional</th> <th>Attributes</th>
|
|
<th></th>
|
|
<th>Name</th>
|
|
<th></th>
|
|
</thead>
|
|
<tbody>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" ></span>
|
|
character,
|
|
</td>
|
|
<td>intent(in)</td>
|
|
<td></td> <td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>com</strong></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
</tbody>
|
|
</table>
|
|
|
|
|
|
</div>
|
|
</div>
|
|
|
|
<div class="panel panel-default">
|
|
<div class="panel-heading codesum"><span class="anchor" id="proc-update_angle_unit"></span><h3> subroutine <a href='../proc/update_angle_unit.html'>update_angle_unit</a>(rz)
|
|
</h3></div>
|
|
<div class="panel-body">
|
|
|
|
|
|
|
|
<h4>Arguments</h4>
|
|
<table class="table table-striped varlist">
|
|
<thead>
|
|
<tr>
|
|
<th>Type</th>
|
|
<th>Intent</th><th>Optional</th> <th>Attributes</th>
|
|
<th></th>
|
|
<th>Name</th>
|
|
<th></th>
|
|
</thead>
|
|
<tbody>
|
|
<tr>
|
|
<td>
|
|
<span class="anchor" ></span>
|
|
type(<a href='../type/rpn_t.html'>rpn_t</a>),
|
|
</td>
|
|
<td>intent(inout)</td>
|
|
<td></td> <td>
|
|
|
|
</td>
|
|
<td>::</td>
|
|
<td><strong>rz</strong></td>
|
|
<td>
|
|
|
|
</td>
|
|
</tr>
|
|
</tbody>
|
|
</table>
|
|
|
|
|
|
</div>
|
|
</div>
|
|
|
|
</section>
|
|
|
|
<section>
|
|
<h2 id="src">Source Code</h2>
|
|
<div class="highlight"><pre><span></span><span class="k">program </span><span class="n">hp15c</span><span class="w"></span>
|
|
<span class="w"> </span><span class="k">use </span><span class="n">rpn_stack</span><span class="w"></span>
|
|
<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>
|
|
<span class="w"> </span><span class="k">use </span><span class="n">amap</span><span class="w"></span>
|
|
<span class="w"> </span>
|
|
<span class="w"> </span><span class="k">implicit none</span>
|
|
<span class="k"> </span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<span class="w"> </span>
|
|
<span class="w"> </span><span class="c">! Create a stack of size 4</span>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<span class="w"> </span><span class="c">! Constants</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
|
|
<span class="w"> </span><span class="c">! Try to read the LANG environment variable</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<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>
|
|
|
|
<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>
|
|
|
|
<span class="w"> </span><span class="c">! Interrogate argument list</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">cycle</span>
|
|
<span class="k"> </span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">cycle</span>
|
|
<span class="k"> </span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">cycle</span>
|
|
<span class="k"> </span>
|
|
<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>
|
|
<span class="k"> call </span><span class="n">help</span><span class="w"></span>
|
|
<span class="w"> </span><span class="k">stop</span>
|
|
<span class="k"> </span>
|
|
<span class="k"> end if</span>
|
|
|
|
<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>
|
|
<span class="w"> </span>
|
|
<span class="w"> </span><span class="c">! Break the string up into a linked-list of tokens</span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<span class="w"> </span><span class="c">! Interpret each token as a command and appky it</span>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<span class="w"> </span><span class="c">! Do not print the stack at the end of a sequence -it's confusing</span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</span><span class="w"></span>
|
|
<span class="w"> </span>
|
|
<span class="w"> </span><span class="c">! Tidy</span>
|
|
<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>
|
|
|
|
<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>
|
|
<span class="k"> </span>
|
|
<span class="k"> end do</span>
|
|
<span class="k"> </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">have_expression</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</span><span class="w"></span>
|
|
<span class="w"> </span>
|
|
<span class="w"> </span><span class="c">! Loop until quit</span>
|
|
<span class="w"> </span><span class="k">all</span><span class="w"> </span><span class="p">:</span><span class="k">do</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">cycle all</span>
|
|
<span class="k"> end if</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
|
|
<span class="w"> </span><span class="c">! Tokenize input string</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="k"> </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">1</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">else</span>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<span class="k"> end do all</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>
|
|
<span class="w"> </span><span class="k">stop</span>
|
|
|
|
<span class="k">contains</span>
|
|
<span class="k"> </span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<span class="k"> return</span>
|
|
<span class="k"> end if</span>
|
|
<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>
|
|
<span class="w"> </span><span class="c">! Ensure there are no leading and trailing spaces</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">do</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end do</span>
|
|
<span class="k"> end subroutine </span><span class="n">tokenize</span><span class="w"></span>
|
|
|
|
<span class="w"> </span><span class="k">subroutine </span><span class="n">help</span><span class="w"></span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
|
|
<span class="w"> </span><span class="k">end subroutine </span><span class="n">help</span><span class="w"></span>
|
|
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">implicit none</span>
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<span class="k"> return</span>
|
|
<span class="k"> end if</span>
|
|
<span class="k"> </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">then</span>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<span class="k"> </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">1</span><span class="p">)</span><span class="w"> </span><span class="k">then</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">call </span><span class="n">calculate_stats</span><span class="w"></span>
|
|
<span class="w"> </span>
|
|
<span class="w"> </span><span class="k">else</span><span class="w"></span>
|
|
<span class="w"> </span><span class="c">! All elements must be the same so either all x or all x,y</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<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>
|
|
<span class="k"> goto</span><span class="w"> </span><span class="mi">901</span><span class="w"></span>
|
|
<span class="w"> </span><span class="k">end if</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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">else</span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</span><span class="w"></span>
|
|
<span class="w"> </span><span class="c">! Initial allocation</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<span class="k"> end if</span>
|
|
<span class="k"> </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="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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">else</span><span class="w"></span>
|
|
<span class="w"> </span><span class="c">! Expand array</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<span class="k"> end if</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</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">then</span>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<span class="k"> end if</span>
|
|
<span class="k"> return</span>
|
|
<span class="k"> end if</span>
|
|
<span class="k"> </span>
|
|
<span class="k"> select case</span><span class="p">(</span><span class="n">command</span><span class="p">)</span><span class="w"></span>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">return</span>
|
|
<span class="k"> </span>
|
|
<span class="k"> case</span><span class="p">(</span><span class="s1">'='</span><span class="p">)</span><span class="w"></span>
|
|
<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>
|
|
<span class="w"> </span><span class="k">return</span>
|
|
<span class="k"> </span>
|
|
<span class="k"> case</span><span class="p">(</span><span class="s1">'{'</span><span class="p">)</span><span class="w"></span>
|
|
<span class="w"> </span><span class="c">! Start sequence</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">1</span><span class="w"></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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<span class="w"> </span><span class="c">! Only raising to a real power is supported</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">else</span>
|
|
<span class="k"> goto</span><span class="w"> </span><span class="mi">901</span><span class="w"></span>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<span class="k"> </span>
|
|
<span class="k"> case</span><span class="p">(</span><span class="s1">'>'</span><span class="p">)</span><span class="w"></span>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">endif</span>
|
|
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="c">! Length is always reported as (x,0) and marked is_cartesian</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">else</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<span class="k"> </span>
|
|
<span class="k"> case</span><span class="p">(</span><span class="s1">'split'</span><span class="p">)</span><span class="w"></span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">else</span>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<span class="k"> </span>
|
|
<span class="k"> case</span><span class="p">(</span><span class="s1">'int'</span><span class="p">)</span><span class="w"></span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">else</span>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</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">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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<span class="k"> </span>
|
|
<span class="k"> case</span><span class="p">(</span><span class="s1">'nint'</span><span class="p">)</span><span class="w"></span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</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">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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<span class="k"> </span>
|
|
<span class="k"> case</span><span class="p">(</span><span class="s1">'rem'</span><span class="p">)</span><span class="w"></span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">else</span>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<span class="k"> </span>
|
|
<span class="k"> case</span><span class="p">(</span><span class="s1">'drop'</span><span class="p">)</span><span class="w"></span>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<span class="w"> </span><span class="c">! Swap real and imaginary parts</span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
|
|
<span class="k"> case</span><span class="p">(</span><span class="s1">'to_pol'</span><span class="p">)</span><span class="w"></span>
|
|
<span class="w"> </span><span class="c">! Convert x + iy to r + i theta</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
|
|
<span class="k"> case</span><span class="p">(</span><span class="s1">'to_cart'</span><span class="p">)</span><span class="w"></span>
|
|
<span class="w"> </span><span class="c">! Convert (r,theta) to (x,y)</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<span class="k"> </span>
|
|
<span class="k"> case</span><span class="p">(</span><span class="s1">'1/'</span><span class="p">)</span><span class="w"></span>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">else</span>
|
|
<span class="k"> goto</span><span class="w"> </span><span class="mi">901</span><span class="w"></span>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
|
|
<span class="k"> case</span><span class="p">(</span><span class="s1">'ncr'</span><span class="p">)</span><span class="w"></span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">else</span>
|
|
<span class="k"> goto</span><span class="w"> </span><span class="mi">901</span><span class="w"></span>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
|
|
<span class="k"> case</span><span class="p">(</span><span class="s1">'npr'</span><span class="p">)</span><span class="w"></span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">else</span>
|
|
<span class="k"> goto</span><span class="w"> </span><span class="mi">901</span><span class="w"></span>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<span class="k"> </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>
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">else</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">' ; mode = real'</span><span class="w"></span>
|
|
<span class="w"> </span><span class="k">end if</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">' ; 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>
|
|
<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>
|
|
|
|
<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>
|
|
<span class="w"> </span><span class="k">call </span><span class="n">help</span><span class="w"></span>
|
|
|
|
<span class="w"> </span><span class="k">case </span><span class="n">default</span><span class="w"></span>
|
|
<span class="w"> </span><span class="c">! Process constants first</span>
|
|
<span class="w"> </span><span class="k">block</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">else</span>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</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">im_comp</span><span class="p">))</span><span class="w"> </span><span class="k">then</span>
|
|
<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>
|
|
<span class="w"> </span><span class="k">else</span>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</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">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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">else</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">z</span><span class="p">)</span><span class="w"></span>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<span class="k"> else</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">command</span><span class="p">))</span><span class="w"> </span><span class="k">then</span>
|
|
<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>
|
|
<span class="w"> </span><span class="k">else</span>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</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="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>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<span class="k"> </span>
|
|
<span class="k"> else</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">command</span><span class="p">))</span><span class="w"> </span><span class="k">then</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">else</span>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</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="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>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<span class="k"> end block</span>
|
|
<span class="k"> end select</span>
|
|
<span class="k"> return</span>
|
|
|
|
<span class="mi">901</span><span class="w"> </span><span class="k">continue</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="n">command</span><span class="o">//</span><span class="s1">' ???'</span><span class="w"></span>
|
|
<span class="w"> </span><span class="k">return</span>
|
|
<span class="k"> </span>
|
|
<span class="k"> end subroutine </span><span class="n">apply_command</span><span class="w"></span>
|
|
|
|
<span class="w"> </span><span class="k">subroutine </span><span class="n">calculate_stats</span><span class="w"></span>
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">else</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<span class="w"> </span><span class="k">end subroutine </span><span class="n">calculate_stats</span><span class="w"></span>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end subroutine </span><span class="n">calculate_regression</span><span class="w"></span>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</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="n">name</span><span class="o">//</span><span class="n">fmt_x</span><span class="w"></span>
|
|
<span class="w"> </span><span class="k">end subroutine </span><span class="n">print_value</span><span class="w"></span>
|
|
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">else</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">else</span>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<span class="k"> end if</span>
|
|
<span class="k"> end subroutine </span><span class="n">summary_stats</span><span class="w"></span>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">else</span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</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">mid</span><span class="p">))</span><span class="w"> </span><span class="k">then</span>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<span class="k"> end function </span><span class="n">calc_median</span><span class="w"></span>
|
|
<span class="w"> </span>
|
|
<span class="w"> </span><span class="c">! 'a' won't be very big so a simple n**2 algorithm will do</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end associate</span>
|
|
<span class="k"> end do</span>
|
|
<span class="k"> end subroutine</span>
|
|
<span class="k"> </span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<span class="w"> </span><span class="c">! Only do something if the modes are different</span>
|
|
<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>
|
|
<span class="k"> </span>
|
|
<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>
|
|
<span class="w"> </span>
|
|
<span class="w"> </span><span class="c">! Convert all polar complex numbers</span>
|
|
<span class="w"> </span><span class="c">! 1) In the stack</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end do</span><span class="w"></span>
|
|
<span class="w"> </span>
|
|
<span class="w"> </span><span class="c">! 2) in memory</span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end do</span><span class="w"></span>
|
|
<span class="w"> </span>
|
|
<span class="w"> </span><span class="c">! 3) in multiple roots</span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end do</span>
|
|
<span class="k"> </span>
|
|
<span class="k"> end subroutine </span><span class="n">toggle_degrees_mode</span><span class="w"></span>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end subroutine </span><span class="n">update_angle_unit</span><span class="w"></span>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</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">us</span><span class="p">)</span><span class="w"></span>
|
|
<span class="w"> </span><span class="k">else</span>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<span class="k"> end subroutine </span><span class="n">invoke_binary</span><span class="w"></span>
|
|
<span class="w"> </span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end if</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">z</span><span class="p">)</span><span class="w"></span>
|
|
<span class="w"> </span><span class="k">else</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">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>
|
|
<span class="w"> </span><span class="k">end if</span>
|
|
<span class="k"> end subroutine </span><span class="n">invoke_unary</span><span class="w"></span>
|
|
|
|
<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>
|
|
<span class="w"> </span><span class="k">implicit none</span>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<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>
|
|
<span class="w"> </span><span class="k">return</span>
|
|
<span class="k"> end if</span>
|
|
<span class="k"> end do</span>
|
|
<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>
|
|
<span class="w"> </span><span class="k">end function </span><span class="n">nsp</span><span class="w"></span>
|
|
|
|
<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> |