diff options
Diffstat (limited to 'lang/dynamo')
43 files changed, 7098 insertions, 0 deletions
diff --git a/lang/dynamo/1.8.7/doc/dynamo handbuch b/lang/dynamo/1.8.7/doc/dynamo handbuch new file mode 100644 index 0000000..4012973 --- /dev/null +++ b/lang/dynamo/1.8.7/doc/dynamo handbuch @@ -0,0 +1,1826 @@ +#block##pageblock##page (2)##setcount (1)##count per page# +#head# +#center#DYNAMO-Compiler +#center#____________________________________________________________ + +#end# +#bottom odd# +#center#____________________________________________________________ +GMD #right#DYNAMO - % +#end# +#bottom even# +#center#____________________________________________________________ +DYNAMO - % #right#GMD +#end# + +#ib#1. Einleitung#ie# + + + +Diese Handbuch beschreibt die Funktion des EUMEL-DYNAMO-Compilers in der +Version 3.3+ und seine Einschränkungen oder Änderungen gegenüber dem +DYNAMO-Sprachstandard. In keiner Weise kann diese Beschreibung eine Einfüh +rung in die Programmiersprache DYNAMO ersetzen! + +Die beschriebene Compilerversion enthält nun auch ein Modul zur Unterstützung von +hochauflösender Grafik durch die häufig in IBM-PC/AT-Kompatiblen eingesetzte +CGA-Grafikkarte. Dennoch ist es einfach möglich, diesen Grafikmodus auszuschal +ten, und somit die alte, zeichenorientierte Grafik weiter zu verwenden. + +Der DYNAMO-Compiler wurde 1983 von Robert Keil und Torsten Fröhlich (Helm +holtz-Gymnasium, Bonn) im Rahmen des MIKROS-Projektes am Informatik-Kolleg +der GMD entwickelt. Für Spezifikation und Betreuung der Entwicklung war Dr. Diether +Craemer verantwortlich, software-technische Unterstützung kam von Prof. John +Henize, Dr. Peter Heyderhoff, Rudolf Legde und Dipl.- Math. Lothar Oppor. Die +Grafik wurde von D.Giffeler beigesteuert. + + + + +#ib#1.1. Referenzliteratur#ie# + + + + + [1] Craemer, Diether + "Mathematisches Modellieren dynamischer Vorgänge" + e. Einf. in die Programmiersprache DYNAMO + Stuttgart, Teuber, 1985 + ISBN 3-519-02477-2 + + [2] Craemer, Diether + "Fluß und Zustand - Simulation dynamischer Vorgänge in DYNAMO" + in: LOGIN 5 (1985), Heft 1, S. 20-23 + + [3] Pugh, Alexander L. + "DYNAMO II User's Manual" + Cambridge, London 1973: MIT-Press + ISBN 0-262-66018-0 +#page# + +#ib#1.2. Die Programmiersprache DYNAMO#ie# + + + +DYNAMO wurde von einer Gruppe um Jay FORRESTER am Massachusetts Institute +of Technology (MIT) um 1960 entwickelt. Die Sprache basiert auf der #on ("i")# System +Dynamic#off ("i")# von FORRESTER. + +In DYNAMO (#on ("u")##on ("b")#Dyna#off ("b")##off ("u")#mic #on ("u")##on ("b")#Mo#off ("b")##off ("u")#delling Language) können Systeme, in denen Veränderun +gen kontinuierlich geschehen, modelliert und simuliert werden. + +Kontinuierliche Veränderungen von Größen werden über deren Veränderungsrate im +Wesentlichen nach folgender Gleichung berechnet + +Größe jetzt = Größe früher + DT * Veränderungsrate, + +dabei ist DT die Länge des Zeitintervalls von "früher" bis "jetzt". + +Außer diesen Gleichungen für Größen braucht man Gleichungen für die Verände +rungsraten, für Hilfsgrößen, zur Initialisierung von Größen, zur Definition von Konstan +ten und Tabellen, zu Angaben von Simulationsläufen und zur Wiedergabe von Ergeb +nissen in Zahlentabellen oder Diagrammen. + +Alle diese Gleichungen können einfach in der Form, wie man sie aus dem Mathema +tik-Unterricht der Sekundarstufe kennt, hingeschrieben werden, ohne sich Gedanken +über den Ablauf des Programms machen zu müssen. + +#on ("b")# +DYNAMO ist also eine einfache funktional-applikative, nicht-prozedurale Sprache.#off ("b")# + +Das macht ihren Reiz und ihre Leistungsfähigkeit aus, die zur Formulierung der be +kannten Weltmodelle von FORRESTER, MEADOWS ("Die Grenzen des Wachstums"), +PESTEL, MESAROVIC u.a. in dieser Sprache führten. + +Anwendungsgebiete der Sprache sind ökologische, gesellschaftliche, wirtschaftliche +und technische Systeme, deren dynamisches Verhalten der Modellbildner nachbilden +und studieren möchte. + +Im Allgemeinen verfolgt der Modellbildner mit seinem Modell einen Zweck (Verhaltens +änderung des nachgebildeten Systems), so daß auch neben gesicherten Fakten die +Wertvorstellungen des Modellbildners in das Modell eingehen. + + + + +#ib#1.3 Kurz-Einführung in die DYNAMO- +Schreibweise#ie# + + + +Die System Dynamic Methode benutzt als Analogie-Bild den Archetyp des Flusses: + + - Wasser fließt durch das Flußbett, kann in Seen gestaut und in der Ge + schwindigkeit durch Schleusen und Wehre reguliert werden. + + - Analog dazu "fließt" Geld auf dem Überweisungsweg, wird in Konten gestaut, + und die Liquidität kann durch Zinssätze reguliert werden. + + - Gedanken "fließen" auf Nervenbahnen, werden im Gehirn gespeichert, und + Gedankenströme werden über Synapsen reguliert. + + - Autos "fließen" über Straßen, werden auf Parkplätzen gestaut, und der Ver + kehrsfluß wird über Ampeln reguliert. + + - Menschen "fließen" über Wanderwege, halten sich in Wohnorten auf, und die + Bevölkerungsdynamik wird durch ein komplexes, rückgekoppeltes Zusammen + spiel von Ein- und Auswanderungsraten sowie Geburts- und Sterberaten + reguliert. + +Am letzten Beispiel wird deutlich, daß sich ein soziales Phänomen nur im Zusam +menwirken vieler netzartig miteinander verbundener Variablen beschreiben läßt (wenn +überhaupt). + +Solange jedoch einigen Variablen ZUSTANDS-CHARAKTER ("Wasserstand") und +anderen VERÄNDERUNGS-CHARAKTER ("Flußgeschwindigkeit") zugeordnet +werden kann, können die Größen für Berechnungen folgender Art verwendet werden: + + + Wasserstand jetzt = Wasserstand früher + vergangene Zeit * + (Zuflußrate - Abflußrate) + + +analog: + + Bevölkerung jetzt = Bevölkerung früher + vergangene Zeit * + (Geburtsrate - Sterberate) + + +Diese Schreibweise kann praktisch so in ein Computerprogramm übernommen wer +den. Mit geringfügigen Änderungen handelt es sich bei diesen Gleichungen schon um +gültige Zeilen in der Programmiersprache DYNAMO. + +In DYNAMO wird er Zeitpunkt "jetzt" durch das Anhängsel .K, der Zeitpunkt "früher" +durch das Anhängsel .J, die Zeitspanne von jetzt bis später durch das Anhängsel .KL, +die Zeitspanne von früher bis jetzt durch das Anhänsel .JK und die vergangene Zeit +mit DT (wie "Delta Tempus": Zeitdifferenz) bezeichnet. Die Variablen mit Zustands- +Charakter heißen LEVELS (Niveaus) und die Veränderungs-Charakter heißen RATES +(Veränderungsraten, Geschwindigkeiten). Die entsprechenden Gleichungen werden mit +L bzw. R gekennzeichnet. Es gib weitere Kennzeichnungen: + + C für Konstantendefinition (constant) + T für Tabellendefintion (table) + A für Hilfsgrößen (auxiliaries) + N für Anfangswerte (initial) + X für Folgezeile (extension) + PRINT für Ausgabe von Zahlen + PLOT für Ausgabe von Diagrammen + +Ein einfaches Bevölkerungsmodell könnte z.B. so geschriben werden: + + + L BEVÖLKERUNG.K=BEVÖLKERUNG.J+DT*(GEBURTENRATE.JK + X -STERBERATE.JK) + R STERBERATE.KL=5 + R GEBURTENRATE.KL=20 + N BEVÖLKERUNG=1000 + C DT=1 (jedes Jahr wird neu berechnet) + C LENGTH=60 (60 Jahre werden simuliert) + PRINT BEVÖLKERUNG + + +Für eine tiefere Einführung in DYNAMO sollte man die Referenzliteratur zu Rate +ziehen. + + + + +#ib#1.4 Eine erste, kleine Sitzung mit dem +DYNAMO-System#ie# + + + +Wir gehen davon aus, daß das DYNAMO-System in ihrer Task generiert worden ist +(siehe 2.). + + 1. Tippen Sie das obrige Programm mittels des EUMEL-Editors ab. + + 2. Verlassen Sie den Editor mit <ESC><q> und starten Sie den DYNAMO- + Compiler durch die Eingabe des Befehls "dynamo". + + 3. Nach erfolgreichem Übersetzen sollte Ihnen nun das DYNAMO-Runtime- + System zur Verfügung stehen. Durch den Befehl 'run' wird das Programm aus + geführt und Sie erhalten eine Zahlenkolonne, die die Entwicklung der Bevöl + kerung in den zu untersuchenden 60 Jahren angibt. Falls Ihnen beim Abtippen + des Programms Fehler unterlaufen sein sollten, so kann das Programm nicht + fehlerfrei übersetzt werden. Fehlermeldunggen zur Compile-Zeit des + DYNAMO-Compilers werden im Paralleleditor angezeigt; das Programm kann + im oberen der beiden Editorfenster (in diesem befinden Sie sich auch nach + Fehlern) korrigiert werden. Danach können Sie erneut wie nach Punkt 2 ver + fahren. +#page# + + + +#ib#2. Generierung des DYNAMO-Compilers#ie# + + + +Der DYNAMO-Compiler, seine Funktionen und die Beispielprogramme werden auf +zwei Archiv-Disketten a#b#' 360 KB ausgeliefert. + +Zum Generieren des DYNAMO-Systems legen Sie bitte die erste Diskette in das +Dikettenlaufwerk Ihres Rechners und durch folgende Kommandozeile lesen Sie den +Generator vom Archiv und starten ihn: + + + archive ("dynamo"); fetch ("dyn.inserter", archive); run + + +Danach holt der Generator alle benötigten Dateien vom eingelegten Archiv bzw. von +dem zweiten Archiv (nachdem er Sie zum Wechseln der Diskette aufgefordert hat). +Anschließend wird der DYNAMO-Compiler insertiert. Am Ende der Generierung +werden Sie gefragt werden, ob Sie den Compiler mit Grafik#u##count ("Grafik")##e# oder ohne benutzen +wollen. Nach der Meldung "dynamo system generiert" können Sie den Compiler#foot# +#u##value ("Grafik")##e# Es kann z.Zt. nur eine CGA-Grafikkarte betrieben werden +#end# +nutzen. +#page# + + + +#ib#3. Der EUMEL-DYNAMO-Compiler#ie# + + + +Der im EUMEL-System implementierte DYNAMO-Compiler ist ein 2-Pass- +Compiler, der die DYNAMO-Programme zunächst in ELAN übersetzt. Der Vorteil +dieser Methode besteht darin, daß es möglich ist, übersetzte Programme unabhängig +vom DYNAMO-Compiler zur Ausführung bringen zu können. + +Die Notation der im folgenden aufgeführten ELAN-Prozeduren des Compilers ent +spricht der in den EUMEL-Handbüchern üblichen Prozedurkopf-Schreibweise. + +Als Beispiel: + + + dynamo ("dyn.grasshasenfuchs") + + +ein Beispiel für den Aufruf der Prozedur mit der Prozedurkopf-Schreibweise + + PROC dynamo (TEXT CONST filename) + +auf der Kommando-Ebene des Betriebssystems EUMEL. + +Der Prozedur 'dynamo' wird beim Aufruf der Dateiname (TEXT) 'filename' übergeben +und dadurch der Compiler auf die Datei mit dem Namen 'filename' angewendet. + + + + +#ib#3.1. Benutzung des DYNAMO-Compiler#ie# + + + +Um ein DYNAMO-Programm zu Übersetzen, gibt es grundsätzlich zwei Möglichkei +ten. Erst einmal kann man ein DYNAMO-Programm in ein ELAN-Programm um +wandeln, jedoch ohne es dabei zur Ausführung zu bringen. Dieses ELAN-Programm +kann man nun unabhängig vom eingentlichen Compiler starten. Die zweite, wohl öfter +angewendete Methode ist, ein DYNAMO-Programm in ein ELAN-Programm zu +compilieren, wobei es danach direkt ausgeführt wird. Ob danach ein ELAN- +Programm zur Verfügung stehen soll, kann der Benutzer selbst entscheiden. + + +PROC dynamo + + Zweck: Aufruf des DYNAMO-Compilers mit 'quelldatei' = 'last param', d.h. das + zu übersetzende Programm steht in der zuletzt bearbeiteten Datei. + + +PROC dynamo (TEXT CONST quelldatei) + + Zweck: Ruft den DYNAMO-Compiler für die Datei 'quelldatei' auf. Anmerkung: + Gleichbedeutend mit 'dynamo (quelltext, quelltext + ".elan", TRUE)', s. + nächste Prozedur. + + Beispiel: + + + dynamo ("dyn.grashasenfuchs") + + + Der DYNAMO-Compiler wird auf die Datei "dyn.grashasenfuchs" ange + wendet. + + +PROC dynamo (TEXT CONST quelldatei, zieldatei, + BOOL CONST pass2 ausfuehren) + + Zweck: Diese Prozedur startet den DYNAMO-Compiler. 'quelldatei' gibt den + Namen der Datei an, in welcher der DYNAMO-Quelltext enthalten ist, + 'zieldatei' ist der Name der Datei, die das erzeugte ELAN-Programm + beinhalten soll. Wenn 'pass2 ausfuehren' = TRUE, dann wird dieses auch + durch den ELAN-Compiler weiterverarbeitet (das Programm wird zur + Ausführung gebracht). + + Beispiel: + + + dynamo ("dyn.grashasenfuchs", + "grashasenfuchs.elanprogramm", FALSE) + + + Im obigen Beispiel wird der in der Datei "dyn.grashasenfuchs" enthaltene + DYNAMO-Quelltext in die Datei "grashasenfuchs.elanprogramm" als + ELAN-Programm geschrieben. Das ELAN-Programm wird nicht ausge + führt. + + +PROC erase (BOOL CONST erase option) + + Zweck: Wenn 'erase option' = TRUE, so werden die erzeugten ELAN-Programme + nach Beendigung der Ausführung gelöscht, bei 'erase option' = FALSE + bleiben sie erhalten (Voreinstellung: 'erase option' = FALSE). + + +PROC error listing (TEXT CONST fehlerdatei) + + Zweck: Falls gewünscht ist, die Fehlermeldungen, die ggf. beim Übersetzen ein + treten, auch in eine Datei zu schreiben, so können Sie hier unter 'fehler + datei' einen Dateinamen angeben. Bei der Angabe von "" wird die Umlei + tung in die Datei ausgeschaltet werden (Voreingestellt ist 'fehlerdatei' = + ""). + + +PROC graphic (BOOL CONST graphic option) + + Zweck: Mit dieser Prozedur läßt sich einstellen, ob bei der DYNAMO-Anweisung + PLOT die hochauflösende Grafik ('graphic option' = TRUE) oder die zei + chenorientierte Grafik ('grafik option' = FALSE) verwendet werden soll. Die + Voreinstellung wird bei der Installation des Compilers erfragt. + + +PROC protokoll (BOOL CONST protokoll option) + + Zweck: Bei 'protokoll option' = TRUE werden alle Textausgaben, die bei der + Laufzeit des DYNAMO-Programmes auftreten, nicht nur auf dem Bild + schirm dargestellt, sondern auch in eine Datei mit dem Namen "dyn.out" + protokolliert (voreingestellt ist 'protokoll option' = FALSE). Die Datei + "dyn.out" enthält auch Seitenvorschubbefehle ('\#page\#') und sollte nur mit + einem EUMEL-Printer ausgedruckt werden. + + + + +#ib#3.2. Abweichungen gegenüber dem + Sprachstandard#ie# + + + + - Die Länge der Namen ist nicht auf 7 Zeichen festgelegt, sondern praktisch be + liebig (32000). Dies ist eine Erweiterung; wer seine Programme auch auf ande + ren DYNAMO-Compilern laufen lassen will, sollte sich aber auf 7 Zeichen be + schränken. + + - Zahlen werden intern mit einer Mantisse von 13 Stellen abgespeichert, von denen + nur die ersten 7 bei der Ausgabe dargestellt werden. Die größte darstellbare Zahl + ist daher 9.999999999999e126. + + - Die maximale Anzahl der Gleichungen ist auf 950 festgelegt. + + - Der Compiler akzeptiert aus Gründen der besseren Lesbarkeit auch Programme, + die in Kleinschrift geschrieben sind. Dabei ist es sinnvoll, die Quellprogramme + konsistent zu halten (d.h. Groß- und Kleinschrift nicht zu vermischen). Man + sollte grundsätzlich Kleinschrift vorziehen, da diese vom Compiler auch effizienter + verarbeitet werden kann. + + - Quellprogramme dürfen eine beliebige Zahl von Leerzeilen enthalten. X - Befeh + le (Fortschreibungszeilen) werden davon nicht beeinflußt. + + - In der augenblicklichen Version 3.3 des Compilers gelten folgende Einschränkun + gen : + + 1. Bei der Verarbeitung von Array-Gleichungen werden Compilerseitig keine + Semantik-Überprüfungen auf eventuell unzureichende Initialisierung oder + Überlappung (d.h. mehrfaches Setzen desselben Elements) durchgeführt. + Defaultmäßig bekommen alle Elemente einer Array-Gleichung bei der Initiali + sierung den Wert '0.0' zugewiesen. + + 2. Die maximale Größe von Tables und Array-Gleichungen ist durch Verwen + dung des Vector-Pakets auf 4000 Elemente festgelegt. Da pro Table-Ele + ment aber zur Zeit eine Zeile im Zielprogramm generiert wird, sollte man dies + besser nicht ausnutzen. + + 3. Supplementary-Gleichungen werden aus Kompatibilitäts-Gründen korrekt + übersetzt, aber sonst wie Auxiliary-Gleichungen behandelt. + + 4. Print ('prtper')- und Plotperiode ('pltper') werden nur als Konstanten verarbei + tet. Falls Gleichungen für 'prtper' oder 'pltper' angegeben werden, so bewirken + diese keine Veränderung. + + 5. Array-Gleichungen dürfen nicht mehr als eine Dimension besitzen. + + 6. Für Gleichungen, die Makro-Aufrufe enthalten, sollten Initialisierungs (N)- + Gleichungen angegeben werden. + + + +#ib#3.3. Das DYNAMO Runtime-System#ie# + + + +Nach erfolgreicher Übersetzung wird vom Zielprogramm das Runtime-System aufge +rufen. In diesem Modus (das DYNAMO-Runtime-System meldet sich mit "dynamo +runtime system :") ist es möglich, Konstanten zu ändern und DynamoProgramme zur +Ausführung zu bringen. + +Im DYNAMO-Runtime-System stehen folgende Kommandos zur Verfügung (näheres +zur Notation siehe Kapitel 4, S. #to page ("Anweisungen und Funktionen")#). + + + run + + Zweck: Ausführen des übersetzten Programms + + + run <name> + + Zweck: Ausführen des übersetzten Programms und retten des Konstantendaten + raums in des Datenraum mit dem Namen "<name>.const". Existiert der + Datenraum bereits, werden die Konstanten aus dem Datenraum in den + Lauf übernommen. Somit ermöglicht der Compiler, Konstantenwerte aus + einem früheren Lauf wieder zu verwenden. + + + c <Konstantenname>=Wert [/<Konstantenname>=Wert [...]] + + Zweck: Änderung einer oder mehrerer Konstanten + + + ? + + Zweck: Anzeigen der Konstanten und ihrer Werte + + + quit + + Zweck: Verlassen des Runtime-Systems + + + help + + Zweck: Zeigt eine kurze Erklärung + + +Bei PRINT- und PLOT-Ausgaben sind folgende Kommandos möglich: + + + Nächster Bildschirm + o (Off), keine Unterbrechung der Ausgabe (nicht möglich bei hochauflösen + der Grafik) + e (End), Zurück zum Runtime System + p Phasendiagramm (nur bei hochauflösender Grafik möglich) + + + +#ib#3.4. Fehlermeldungen des + DYNAMO-Compilers#ie# + + + +Falls der Compiler einen Fehler im DYNAMO-Programm entdeckt, gibt er eine Feh +lermeldung nach dem folgenden Muster aus: +"Fehler in Zeile <zeilennummer> bei >> <symbol> << : <fehlertext>. + +Im folgenden sind alle Fehlermeldungen und Möglichkeiten zur Abhilfe aufgelistet, +sofern diese nicht klar ersichtlich sind: + + 1 GLEICHUNG DOPPELT DEFINIERT + + 2 DOPPELTE INITIALISIERUNG + + 3 FALSCHER ZEILENTYP + -> Erlaubt sind : a, c, l, n, r, s, print, plot, note, spec, *, x, macro, mend, + for, noise, run. + + 4 VERSCHACHTELTE MAKRO-DEFINITION + -> 'mend' - Befehl fehlt. + + 5 MAKRO-NAME ERWARTET + + 6 '(' ERWARTET + + 7 FORMALER PARAMETER ERWARTET + + 8 ')' NACH PARAMETERLISTE ERWARTET + + 9 BEI AUXILIARIES NUR SUBSKRIPTION MIT '.K' ERLAUBT + +10 BEI KONSTANTEN-DEFINITION NAME ERWARTET + +11 BEI LEVELS NUR SUBSKRIPTION MIT '.K' ERLAUBT + +12 BEI RATES NUR SUBSKRIPTTION MIT '.KL' ERLAUBT + +13 BEI TABLE-DEFINITIONEN KEINE SUBSKRIPTION ERLAUBT + +14 X - BEFEHL HIER NICHT ERLAUBT + +15 BEI FOR-DEFINITION NAME ERWARTET + +16 '=' NACH FOR-VARIABLE ERWARTET + +17 BEREICHSANGABE ERWARTET + +18 ',' ERWARTET + +19 LOKALE GLEICHUNG NUR IN MAKRO ERLAUBT + +20 BEI DEFINITION NAME ERWARTET + +21 '=' ERWARTET + +22 INDEX NICHT KORREKT + -> Als Index ist nur erlaubt : <for variable> !, + <add op> <ganze zahl>!. + <add op> ::= "+"; "-". + +23 ')' NACH INDIZIERUNG ERWARTET + +24 PRTPER NICHT DEFINIERT + -> Wenn das Programm einen Print-Befehl enthält, muß 'prtper' (Printperiode) + als Konstante definiert werden. + +25 PLTPER NICHT DEFINIERT + -> Wenn das Programm einen Plot-Befehl enthält, muß 'pltper' (Plotperiode) + als Konstante definiert werden. + +26 '/' ODER ',' BEI PLOT ERWARTET + +27 NAME ALS PLOTPARAMETER ERWARTET + +28 DOPPELTE SCALE - ANGABE IN EINER GRUPPE + -> Wenn mehrere Plotparameter mit ',' getrennt werden (also die gleiche Ska + lierung erhalten), dürfen nicht mehrere feste Skalierungen angegeben wer + den. + +29 ERSTE SCALE - ANGABE ERWARTET + +30 ZWEITE SCALE - ANGABE ERWARTET + +31 ')' NACH SCALE - ANGABE FEHLT + +32 PRINTPARAMETER NICHT DEFINIERT + +33 PRINTPARAMETER ERWARTET + +34 TIME DARF NUR INITIALISIERT WERDEN + +35 DT NICHT DEFINIERT + +36 LENGTH NICHT DEFINIERT + +37 BEI KONSTANTEN - DEFINITION ZAHL ERWARTET + +38 BEI INITIALISIERUNG KONSTANTE ERWARTET + +39 LEVELS MUESSEN INITIALISIERT WERDEN + +40 KONSTANTE BEI TABLE ERWARTET + +41 '/' ODER "," ERWARTET + +42 TABLE - DEFINITION OHNE BENUTZUNG + +43 SIMULTANE GLEICHUNGEN + -> Bei dem Versuch, A, R, oder N - Gleichungen zu sortieren, trat eine + direkte oder indirekte Rekursion auf. + +44 FAKTOR ERWARTET + -> Erwartet : <zahl>; + <funktions aufruf>; + <macro aufruf>; + <gleichungs name>; + '(', <ausdruck>, ')'; + <monadischer operator>, <faktor>. + <monadischer operator> ::= '+'; '-'. + +45 TIME MUSS MIT '.J' ODER '.K' SUBSKRIBIERT WERDEN + +46 SYMBOL NICHT DEFINIERT + +47 FUNKTION NICHT DEFINIERT + +48 UNZULAESSIGE INDIZIERUNG + -> Die Indices auf beiden Seiten der Gleichung müssen immer gleich sein. + +49 FALSCHE PARAMETERANZAHL + +50 FALSCHES TRENNSYMBOL ZWISCHEN PARAMETERN + +51 ALS PARAMETER TABLE ERWARTET + +52 FALSCHER PARAMETER IN TABLEFUNKTION + +53 ZU VIELE AKTUELLE PARAMETER + +54 ')' NACH MAKROAUFRUF FEHLT + +55 REKURSIVER MAKROAUFRUF + +56 BEI N - GLEICHUNG KEINE SUBSKRIPTION ERLAUBT + +57 FALSCHE SUBSKRIPTION IN AUXILIARY - GLEICHUNG + +58 ')' ERWARTET + +59 FALSCHE SUBSKRIPTION IN LEVEL - GLEICHUNG + +60 FALSCHE SUBSKRIPTION IN RATE - GLEICHUNG + +61 FOR - VARIABLE NICHT DEFINIERT + -> Eine FOR - Variable muß vor der ersten Benutzung definiert werden. + +62 KONSTANTE ERWARTET + +63 FALSCHES REAL - FORMAT + -> Exponent fehlt + +64 GLOBALE GLEICHUNG IN MACRO NICHT ERLAUBT + +65 DOPPELTE DEFINITION BEI MEHRFACHEM MAKROAFRUF + +66 ALS NOISE - PARAMETER ZAHL ERWARTET +#page# + +#ib#4. Anweisungen und Funktionen des + EUMEL-DYNAMO-Compilers#ie# +#goal page ("Anweisungen und Funktionen")# + + +Dieses Kapitel gibt eine alphabetische Übersicht über die im EUMEL-DYNAMO- +Compiler realisierten Anweisungen und Funktionen (wertliefernde Algorithmen). + +Die Beschreibung der Anweisungen und Funktionen ist nach der DYNAMO- +Syntaxregel angegeben, wobei folgende Zeichen mit besonderer Bedeutung verwendet +werden: + + [] optionale Angabe + [...] beliebig häufige Wiederholung der letzten optionalen Angabe + < > in spitzen Klammern stehende Namen sind Variablen- bzw. Konstan + tennamen + <Name> steht für einen beliebigen Bezeichner gemäß der DYNAMO-Syntax + <Zahl> bezeichnet einen beliebigen Wert (also auch eine Ausdruck) + {} Alternative Angabe + + X DYNAMO Anweisung, kennzeichnet eine Fortsetzungsszeile der + vorhergegangenen Anweiung (S. #to page ("X")#) + +Alle Anweisungen und Funktionen werden nach dem gleichen Schema dargestellt: + + + +Funktionsname#right#Typ (Funkt. oder Anweisung) + + +Zweck: Schlagwort zur Wirkung + +Format: Beschreibung des Formates (spezielle Zeichen s.o.) + +Erklärung: kurze Beschreibung der Anweisung/Funktion + +Beispiel: Anwendung der Anweisung/Funktion + +Programm: Beispielprogramm, in welchem die Anweisung/Funktion angewendet wird. + +Referenz: Verweis auf ähnliche oder äquivalente Anweisungen/Funktionen im + Format '<Funktions- bzw. Anweisungsname>, Seitennummer'. + + +Eine oder mehrere dieser Felder können fehlen (z.B. wenn es keine Referenz oder +kein Beispielprogramm gibt). +#page# + + + +#ib#4.1. Übersicht über die Anweisungen und + Funktionen#ie# + + + +#goal page ("A")##ib (2)#A#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Auxiliary-Gleichung (A-Gleichung, Hilfsgleichung) + +Format: A <Auxiliary-Name>.K=<Ausdruck>#u##count ("Ausdruck")##e# +#foot# +#u##value ("Ausdruck")##e# genaueres über die Definition eines Ausdruckes siehe [1], S. 93 +#end# + +Erklärung: Mit Hilfe von Auxiliary-Gleichungen werden Level- und Hilfsgrößen + (Auxiliaries) zum selben Zeitpunkt verknüpft. + +Beispiel: A JM.K=MM.K/MEJ + +Programm: "dyn.workfluc" + + + +#ib (2)#ABS#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Absolutbetrag + +Format: ABS(<Zahl>) + +Erklärung: Liefert den Absolutbetrag + + + IF <Zahl> >= 0 THEN + <Zahl> + ELSE + - <Zahl> + END IF + +Beispiel: N X=ABS(A*2.0) + + + +#goal page ("ARCTAN")#ARCTAN#on ("i")##right#Funktion#off ("i")# + + +Zweck: Berechnung der trigonometrischen Funktion Arcustangens + +Format: ARCTAN(<Zahl>) + +Erklärung: Berechnet den Arcustangens von <Zahl>; Ergebnis im Bogenmaß. + +Beispiel: N X=ARCTAN(TAN(1.3)) (X = 1.3) + + +Referenz: COSD, S. #to page ("COSD")# + SIN, S. #to page ("SIN")# + SIND, S. #to page ("SIND")# + TAN, S. #to page ("TAN")# + TAND, S. #to page ("TAND")# + ARCTAND, S. #to page ("ARCTAN")# + COS, S. #to page ("COS")# + + + +#goal page ("ARCTAND")##ib (2)#ARCTAND#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Berechnung der trigonometrischen Funktion Arcustangens + +Format: ARCTAND(<Zahl>) + +Erklärung: Berechnet den Arcustangens von <Zahl>; Ergebnis im Gradmaß + +Beispiel: N X=ARCTAND(TAND(45.0)) (X = 45.0) + + +Referenz: COSD, S. #to page ("COSD")# + SIN, S. #to page ("SIN")# + SIND, S. #to page ("SIND")# + TAN, S. #to page ("TAN")# + TAND, S. #to page ("TAND")# + COS, S. #to page ("COS")# + ARCTAN, S. #to page ("ARCTAND")# + + + +#goalpage ("C")##ib (2)#C#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Konstantendefinition + +Format: C <Name>=<Zahl> + +Erklärung: Werte, die während eines Simulationslaufes gleich bleiben, können durch + die Konstantendefintion benannt werden (s. auch 'c' im Runtime- + System). + +Beispiel: C POPI=30.3 + +Programm: "dyn.wohnen" + + + +#goal page ("CLIP")##ib (2)#CLIP#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Wert nach Bedingung + +Format: CLIP(<Zahl1>,<Zahl2>,<Zahl3>,<Zahl4>) + +Erklärung: Liefert den Wert des ersten Argumentes, wenn das dritte Argument + größer oder gleich dem vierten Argument ist. Andernfalls wird der Wert + des zweiten Argumentes geliefert. + + + IF <Zahl3> >= <Zahl4> THEN + <Zahl1> + ELSE + <Zahl2> + END IF + +Beispiel: N X=CLIP(1.0,2.0,3.0,4.0) (X = 2.0) + + +Programm: "dyn.welt/forrester" + +Referenz: FIFGE, S. #to page ("FIFGE")# (äquivalente Funktion) + + + +#goalpage ("COS")#COS#on ("i")##right#Funktion#off ("i")# + + +Zweck: Berechnung der trigonometrischen Funktion Cosinus + +Format: COS(<Zahl>) + +Erklärung: Es wird der Cosinus des Wertes <Zahl>, welcher im Bogenmaß vorlie + gen muß, geliefert. + +Beispiel: N X=COS(1.6) + +Referenz: COSD, S. #to page ("COSD")# + SIN, S. #to page ("SIN")# + SIND, S. #to page ("SIND")# + TAN, S. #to page ("TAN")# + TAND, S. #to page ("TAND")# + ARCTAN, S. #to page ("ARCTAN")# + ARCTAND, S. #to page ("ARCTAND")# + + + +#goal page ("COSD")##ib (2)#COSD#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Berechnung der trigonometrischen Funktion Cosinus + +Format: COSD(<Zahl>) + +Erklärung: Es wird der Cosinus des Wertes <Zahl>, welcher im Gradmaß vorliegen + muß, geliefert. + +Beispiel: N X=COSD(33.5) + +Referenz: COS, S. #to page ("COS")# + SIN, S. #to page ("SIN")# + SIND, S. #to page ("SIND")# + TAN, S. #to page ("TAN")# + TAND, S. #to page ("TAND")# + ARCTAN, S. #to page ("ARCTAN")# + ARCTAND, S. #to page ("ARCTAND")# + + + +#goal page ("EXP")##ib (2)#EXP#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Exponentialfunktion zur Basis e + +Format: EXP(<Zahl>) + +Erklärung: Liefert e#u#<Zahl>#e# + +Beispiel: N X=EXP(1.0) (X = 2.71 = e) + + +Referenz: LN, S. #to page ("LN")# (Umkehrfunktion) + + + +#goal page ("FIFGE")##ib (2)#FIFGE#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Wert nach Bedingung (#on ("u")#f#off ("u")#irst #on ("u")#if#off ("u")# #on ("u")#g#off ("u")#reater or #on ("u")#e#off ("u")#qual) + +Format: FIFGE(<Zahl1>,<Zahl2>,<Zahl3>,<Zahl4>) + +Erklärung: Liefert den Wert des ersten Argumentes, wenn das dritte Argument + größer oder gleich dem vierten Argument ist. Andernfalls wird der Wert + des zweiten Argumentes geliefert. + + + IF <Zahl3> >= <Zahl4> THEN + <Zahl1> + ELSE + <Zahl2> + END IF + +Beispiel: N X=FIFGE(1.0,2.0,3.0,4.0) (X = 2.0) + + +Referenz: CLIP, S. #to page ("CLIP")# (äquivalente Funktion) + + + +#goal page ("FIFZE")##ib (2)#FIFZE#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Wert nach Bedingung (#on ("u")#f#off ("u")#irst #on ("u")#if#off ("u")# #on ("u")#ze#off ("u")#ro) + +Format: FIFZE(<Zahl1>,<Zahl2>,<Zahl3>) + +Erklärung: Wenn der Parameter <Zahl3> den Wert 0 hat, so wird <Zahl1> + geliefert, andernfalls <Zahl2> + + + IF <Zahl3> = 0 THEN + <Zahl1> + ELSE + <Zahl2> + END IF + +Beispiel: N X=FIFZE(1.0,2.0,3.0) (X = 2.0) + + +Referenz: SWITCH, S. #to page ("SWITCH")# + + + +#goal page ("FLOOR")##ib (2)#FLOOR#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Vorkommastellen + +Format: FLOOR(<Zahl>) + +Erklärung: Liefert die Vorkommastellen von <Zahl> + +Beipiel: N X=FLOOR(3.14) (X = 3.0) + + +Referenz: FRAC, S. #to page ("FRAC")# + + + +#ib (2)#FOR#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Schleifen-Definition + +Format: FOR <Name>=<Zahl1>,<Zahl2> + +Erklärung: <Name> bezeichnet eine Schleifenvariable, die von <Zahl1> bis + <Zahl2> hochgezählt wird. Somit ist es möglich, gleiche Berechnungen + für die verschiedenen Werte einer Tabelle durchzuführen. + +Beispiel: FOR BERECHNUNGSZEITRAUM=1900,2100 + + +Programm: "dyn.bev" + + + +#goal page ("FRAC")##ib (2)#FRAC#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Nachkommastellen + +Format: FRAC(<Zahl>) + +Erklärung: Liefert die Nachkommastellen von <Zahl> + +Beispiel: N X=FRAC(3.14) (X = 0.14) + + +Referenz: FLOOR, S. #to page ("FLOOR")# + + + +#goal page ("L")##ib (2)#L#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Level-Gleichung + +Format: L <Level-Name>.K=<Level-Name>.J+ + <Vergangenheitsausdruck> + +Erklärung: Die Level-Gleichung stellt einen gegenwärtigen Wert in Bezug zu + seinem Wert in der Vergangenheit und seiner Veränderungsrate in der + bis dahin vergangenen Zeit (Vergangenheitsausdruck s. [1], S. 96). + +Beispiel: L HASEN.K=CLIP(HASEN.J+DT*(HGRATE.JK + X -HSRATE.JK),0,HASEN.J,0) + +Programm: "dyn.grashasenfuchs" + + + +#goal page ("LN")##ib (2)#LN#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Logarithmus-Funktion + +Format: LN(<Zahl>) + +Erklärung: Berechnet den natürlichen Logarithmus von <Zahl> + +Beispiel: N X=LN(1.0) (X = 0.0) + + +Programm: "dyn.wasseröko" + +Referenz: LOG2, S. #to page ("LOG2")# + LOG10, S. #to page ("LOG10")# + EXP, S. #to page ("EXP")# + + + +#goal page ("LOG2")##ib (2)#LOG2#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Logarithmus-Funktion + +Format: LOG2(<Zahl>) + +Erklärung: Berechnet den Logarithmus von <Zahl> zur Basis 2 + +Beispiel: N X=LOG2(8.0) (X = 3.0) + + +Referenz: LN, S. #to page ("LN")# + LOG10, S. #to page ("LOG10")# + + + +#goal page ("LOG10")##ib (2)#LOG10#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Logarithmus-Funktion + +Format: LOG10(<Zahl>) + +Erklärung: Berechnet den Logarithmus von <Zahl> zur Basis 10 + +Beispiel: N X=LOG10(100.0) (X = 2.0) + + +Referenz: LOG2, S. #to page ("LOG2")# + LN, S. #to page ("LN")# + EXP, S. #to page ("EXP")# + + + +#goal page ("MACRO")##ib (2)#MACRO#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Macro-Definition + +Format: MACRO <Name>(<Ausdruck>[,<Ausdruck>[...]]) + +Erklärung: Durch die Verwendung der MACRO-Anweisung können Sie einer oder + mehreren DYNAMO-Gleichungen einen Namen geben (<Name>). + Macros müssen durch MEND abgeschloßen werden und dürfen #on ("u")#nicht#off ("u")# + rekursiv aufgerufen werden (vergl. Refinements in ELAN). + +Beispiel: MACRO SMOOTH(IN,DEL) + L SMOOTH.K=SMOOTH.J+DT*(IN.J-SMOOTH.J)/DEL + N SMOOTH=IN + MEND + +Programm: "dyn.mac" (diese Datei enthält alle bisherigen Makros) + +Referenz: MEND, S. #to page ("MEND")# + + + +#goal page ("MAX")##ib (2)#MAX#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Maximum zweier Größen + +Format: MAX(<Zahl1>,<Zahl2>) + +Erklärung: Liefert die größere Zahl aus <Zahl1> und <Zahl2> + + + IF <Zahl1> > <Zahl2> THEN + <Zahl1> + ELSE + <Zahl2> + END IF + +Beispiel: N X=MAX(1.0,2.0) (X = 2.0) + + +Referenz: MIN, S. #to page ("MIN")# + + + +#goal page ("MEND")##ib (2)#MEND#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Macro-Definition + +Format: MEND + +Erklärung: MEND beendet eine Macro-Definition + +Beispiel: MACRO SMOOTH(IN,DEL) + L SMOOTH.K=SMOOTH.J+DT*(IN.J-SMOOTH.J) + X /DEL + N SMOOTH=IN + MEND + +Programm: "dyn.mac" (diese Datei enthält alle bisherigen Makros) + +Referenz: MACRO, S. #to page ("MACRO")# + + + +#goal page ("MIN")##ib (2)#MIN#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Minimum zweier Größen + +Format: MIN(<Zahl1>,<Zahl2>) + +Erklärung: Liefert die kleinere Zahl aus <Zahl1> und <Zahl2> + +Beispiel: N X=MIN(1.0,2.0) (X = 1.0) + + +Programm: "dyn.forst7" + +Referenz: MAX, S. #to page ("MAX")# + + + +#goal page ("N")##ib (2)#N#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Initialisierungsgleichung + +Format: N <Name>=<Zahl> + +Erklärung: Initialisert eine Variable mit dem Bezeichner <Name> auf den Wert + <Zahl>, d.h. es wird ihr ein Startwert zugewiesen. + +Beispiel: N X=1900 + +Programm: "dyn.grashasenfuchs" + + + +#goal page ("NOISE")##ib (2)#NOISE#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Pseudo-Zufallszahlen-Generator + +Format: NOISE(<Zahl>) + +Erklärung: Diese Funktion liefert eine Pseudo-Zufallszahl zwischen -0.5 und +0.5 + und setzt einen neuen Startwert für den Generator fest. Der Parameter + <Zahl> wird nicht ausgewertet. + +Beispiel: N X=NOISE(0) + +Referenz: NORMRN, S. #to page ("NORMRN")# + + + +#goal page ("NORMRN")##ib (2)#NORMRN#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Pseudo-Zufallszahlen-Generator + +Format: NORM(<Zahl1>,<Zahl2>) + +Erklärung: Liefert einen Wert zwischen <Zahl1> - <Zahl2> * 2.4 und <Zahl1> + + <Zahl2> * 2.4. + +Beispiel: N X=NORM(1.0,10.0) + +Referenz: NOISE, S. #to page ("NOISE")# + + + +#ib (2)#NOTE#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Kommentar + +Format: NOTE <Kommentarzeile> + +Erklärung: Die Zeilen, die mit NOTE gekennzeichnet sind, werden vom Compiler als + Kommentarzeilen erkannt und nicht beachtet. NOTE-Zeilen haben nur + dokumentierenden Charakter und sind für den Programmlauf ohne jede + Bedeutung. Dennoch sollte man, wenn immer möglich, Kommentare in + sein DYNAMO-Programm einfügen, denn sie sind in DYNAMO an + nähernd die einzige Möglichkeit, ein Programm lesbar zu machen, damit + es auch nach längerer Zeit noch korrigiert werden kann. + +Beispiel: NOTE Dies ist eine Kommentarzeile + +Programm: "dyn.welt/forrester" + + + +#goal page ("PLOT")##ib (2)#PLOT#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Darstellen der Ergebnisse in Diagrammform + +Format: PLOT <Name>[=<Druckzeichen>][(<Skalenbegin>, + <Skalenende>)][/...][,...] + +Erklärung: Durch diese Anweisung werden die Größen nach PLTPER Zeiteinheiten + in einem Diagramm ausgegeben. Die Angabe eines Druckzeichens ist + nur bei zeichenorientierten Grafik erforderlich, denn bei hochauflösender + Grafik werden die Graphen der verschiedenen Größen durch unterschied + liche Linientypen gezeichnet; fehlt bei der zeichenorientierten Grafik das + Druckzeichen, so werden die Graphen durch die Zahlen von 0...9 darge + stellt. Bei "/" werden verschiedene, bei "," gleiche Skalen benutzt. + +Beispiel: PLOT GRAS=G(995,1005)/HASEN=H(85,115) + X /FUECHS=F(15,35) + +Programm: "dyn.grashasenfuchs" + +Referenz: PRINT, S. #to page ("PRINT")# + + + +#goal page ("POWER")##ib (2)#POWER#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Potenzfunktion + +Format: POWER(<Zahl1>,<Zahl2>) + +Erklärung: Liefert <Zahl1>#u#<Zahl2>#e# + +Beipiel: N X=POWER(2, 2) (X = 4) + + +Referenz: SQRT, S. #to page ("SQRT")# + + + +#goal page ("PRINT")##ib (2)#PRINT#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Darstellung der Ergebnisse in Tabellenform + +Format: PRINT <Name>[/...][,...] + +Erklärung: Durch diese Anweisung werden die Werte (<Name>) nach PRTPER + Zeiteinheiten in einer Tabelle ausgegeben. Die Ausgabe kann umgeleitet + werden (s. 'protokoll'). + +Beispiel: PRINT GBEV,BEV(1),BEV(40),BEV(60),BEV(63) + X ,BEV(65),ZBEV,PRENT + +Programm: "dyn.bev" + +Referenz: PLOT, S. #to page ("PLOT")# + + + +#goal page ("R")##ib (2)#R#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Rate-Gleichung + +Format: R<Rate-Name>.KL=<Gegenwartsausdruck> + +Erklärung: Eine Rate-Gleichung stellt die Veränderungsrate in Bezug zu den aktu + ellen Level-Größen. + +Beispiel: R FGRATE.KL=FGK*HASEN*FUECHS.K + + +Programm: "dyn.grashasenfuchs" + +Referenz: A, S. #to page ("A")# + C, S. #to page ("C")# + L, S. #to page ("L")# + + + +#ib (2)#RAMP#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Wert nach Bedingung + +Format: RAMP(<Zahl1>,<Zahl2>) + +Erklärung: Wenn TIME kleiner <Zahl2>, dann liefert RAMP 0, andernfalls wird + <Zahl1> * (TIME - <Zahl2>) geliefert. + + + IF TIME < <Zahl2> THEN + 0 + ELSE + <Zahl1> * (TIME - <Zahl2>) + END IF + + + +#goal page ("RUN")##ib (2)#RUN#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Überschrift + +Format: RUN <Überschrift> + +Erklärung: Gibt dem aktuellen Lauf eine Überschrift. Gleichzeitig ist + "<Überschrift>.const" der Name eines Datenraums, in dem die Kon + stanten dieses Laufs aufgehoben werden (s. 'run' im Runtime-System). + +Beispiel: RUN Überschrift + +Referenz: *, S. #to page ("*")# + + + +#ib (2)#S#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Supplementary-Gleichung + +Format: S <Name>.K=<Vergangenheitsausdruck> + +Erklärung: Gleichungen für Hilfsgrößen werden durch Supplementary-Gleichungen + ausgedrückt. + +Beispiel: S SCHADSTOFFVERHÄLTNIS.K=COZWEI.K/OZWEI.K + + + + +#ib (2)#SCLPRD#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Skalarprodukt + +Format: SCLPRD(<Tabelle1>,<Zahl1>,<Zahl2>,<Tabelle2>,<Zahl3>) + +Erklärung: Liefert das Skalarprokukt der Tabellen <Tabelle1> und <Tabelle2>, + wobei <Zahl1> und <Zahl2> den Ausschnitt aus der ersten Tabelle + angeben und <Zahl3> den Startindex für den Vektor in der zweiten + Tabelle angibt. + +Beispiel: GB.K=SCLPRD(BEV.K,15,44,GR,1)/2 + + +Programm: "dyn.bev" + + + +#goal page ("SIN")##ib (2)#SIN#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Berechnung der trigonometrischen Funktion Sinus + +Format: SIN(<Zahl>) + +Erklärung: Berechnet den Sinus von <Zahl>, welche im Bogenmaß angegeben + wird. + +Beispiel: N X=SIN(0.5) + +Referenz: COS, S. #to page ("COS")# + COSD, S. #to page ("COSD")# + SIND, S. #to page ("SIND")# + TAN, S. #to page ("TAN")# + TAND, S. #to page ("TAND")# + ARCTAN, S. #to page ("ARCTAN")# + ARCTAND, S. #to page ("ARCTAND")# + + + +#goal page ("SIND")##ib (2)#SIND#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Berechnung der trigonometrischen Funktion Sinus + +Format: SIND(<Zahl>) + +Erklärung: Berechnet den Sinus von <Zahl>, welche im Gradmaß angegeben wird. + +Beispiel: N X=SIND(45.0) + +Referenz: COS, S. #to page ("COS")# + SIN, S. #to page ("SIN")# + COSD, S. #to page ("COSD")# + TAN, S. #to page ("TAN")# + TAND, S. #to page ("TAND")# + ARCTAN, S. #to page ("ARCTAN")# + ARCTAND, S. #to page ("ARCTAND")# + + + +#ib (2)#SPEC#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Lauf-Anweisung + + DT=<Zahl1> +Format: SPEC { LENGTH=<Zahl2> }[/...] + PLTPER=<Zahl3> + PRTPER=<Zahl4> + +Erklärung: Durch die Lauf-Anweisung werden die Systemkonstanten festgesetzt. + Sie darf pro Lauf nur einmal benutzt werden. + +Beispiel: SPEC DT=1/PLTPER=1/PRTPER=1/LENGTH=2000 + + +Referenz: C, S. #to page ("C")# (SPEC kann durch C-Def. ersetzt werden) + + + +#goal page ("SQRT")##ib (2)#SQRT#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Quadratwurzel + +Format: SQRT(<Zahl>) + +Erklärung: Berechnet die Quadratwurzel aus <Zahl> + +Beispiel: N X=SQRT(4.0) (X = 2.0) + + +Referenz: POWER, S. #to page ("POWER")# + + + +#ib (2)#STEP#ie (2)##on ("i")##right#Funktion#off ("i")# + +Zweck: Wert nach Bedingung + +Format: STEP(<Zahl1>,<Zahl2>) + +Erklärung: Ist TIME kleiner <Zahl2>, so wird 0 geliefert, ansonsten <Zahl1> + + + IF TIME < <Zahl2> THEN + 0.0 + ELSE + <Zahl1> + END IF + +Beispiel: N X=STEP(12.0,12.0) + + + +#goal page ("SUM")##ib (2)#SUM#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Summierung einer Tabelle + +Format: SUM(<Tabelle>) + +Erklärung: Liefert die Summe der Einträge in einer Tabelle + +Beispiel: A GESAMTBEV.K=SUM(BEV.K) + +Programm: "dyn.bev" + +Referenz: SUMV, S. #to page ("SUMV")# + + + +#goal page ("SUMV")##ib (2)#SUMV#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Summierung einer Tabelle + +Format: SUMV(<Tabelle>,<Zahl1>,<Zahl2>) + +Erklärung: Summierung der Einträge in der Tabelle von Element <Zahl1> bis + Element <Zahl2> + +Beispiel: A ZBEV.K=SUMV(BEV.K,16,59) Teilbevölkerung + + +Programm: "dyn.bev" + +Referenz: SUM, S. #to page ("SUM")# + + + +#goal page ("SWITCH")##ib (2)#SWITCH#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Wert nach Bedingung + +Format: SWITCH(<Zahl1>,<Zahl2>,<Zahl3>) + +Erklärung: Wenn der Parameter <Zahl3> den Wert 0 hat, so wird <Zahl1> + geliefert, andernfalls <Zahl2> (gleichbedeutend mit FIFZE). + + + IF <Zahl3> = 0 THEN + <Zahl1> + ELSE + <Zahl2> + END IF + +Beispiel: N X=SWITCH(1.0,2.0,3.0) (X = 2.0) + + +Referenz: FIFZE, S. #to page ("FIFZE")# + + + +#goal page ("T")##ib (2)#T#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Tabellen-Definition + +Format: T <Name>=<Zahl1>[/<Zahl2>[....]] + +Erklärung: Durch die T-Anweisung wird eine Tabelle definiert, die Elemente wer + den durch "/" getrennt hintereinander angegeben. + +Beispiel: T TABELLE=1/2/3/4/5/6/8/9/10/11/12 + + +Programm: "dyn.bev" + +Referenz: TABLE, S. #to page ("TABLE")# + TABHL, S. #to page ("TABHL")# + + + +#goal page ("TABHL")##ib (2)#TABHL#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Tabellenfunktion + +Format: TABHL(<Tabelle>,<Zahl1>,<Zahl2>,<Zahl3>) + +Erklärung: IF <Zahl1> < <Zahl2> THEN + <Tabelle> (<Zahl2>) + ELIF <Zahl2> <= <Zahl1> AND <Zahl1> <= <Zahl3> THEN + TABLE (<Tabelle>, <Zahl1>, <Zahl2>, <Zahl3>) + ELSE + <Tabelle> (<Zahl3>) + END IF + +Beispiel: A BRMM.K=TABHL(BRMMT,MSL.K,0,5,1) + + +Programm: "dyn.welt/forrester" + +Referenz: T, S. #to page ("T")# + TABLE, S. #to page ("TABLE")# + + + +#goal page ("TABLE")##ib (2)#TABLE#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Tabellenfunktion + +Format: TABLE(<Tabelle>,<Zahl1>,<Zahl2>,<Zahl3>,<Zahl4>) + +Erklärung: Verknüpft die Werte aus <Tabelle> mit <Zahl1>, wobei <Zahl2> den + ersten und <Zahl3> den letzten Tabelleneintrag angibt. <Zahl4> stellt + die Schrittweite dar. + +Beispiel: T TABELLE=1/2/3/4/5 + A BEISP.K=TABLE(TABELLE,X.K,2,4,1) + +Programm: "dyn.welt/forrester" + +Referenz: T, S. #to page ("T")# + TABHL, S. #to page ("TABHL")# + + + +#goal page ("TAN")##ib (2)#TAN#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Berechnung der trigonometrischen Funktion Tangens + +Format: TAN(<Zahl>) + +Erklärung: Berechnet den Tangens von <Zahl>, welche im Bogenmaß angegeben + wird. + +Beispiel: N X=TAN(0.5) + +Referenz: COS, S. #to page ("COS")# + SIN, S. #to page ("SIN")# + COSD, S. #to page ("COSD")# + SIND, S. #to page ("TAN")# + TAND, S. #to page ("TAND")# + ARCTAN, S. #to page ("ARCTAN")# + ARCTAND, S. #to page ("ARCTAND")# + + + +#goal page ("TAND")##ib (2)#TAND#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Berechnung der trigonometrischen Funktion Tangens + +Format: TAND(<Zahl>) + +Erklärung: Berechnet den Tangens von <Zahl>, welche im Gradmaß angegeben + wird. + +Beispiel: N X=TAND(45.0) + +Referenz: COS, S. #to page ("COS")# + SIN, S. #to page ("SIN")# + COSD, S. #to page ("COSD")# + TAN, S. #to page ("TAN")# + SIND, S. #to page ("SIND")# + ARCTAN, S. #to page ("ARCTAN")# + ARCTAND, S. #to page ("ARCTAND")# + + + +#goalpage ("X")##ib (2)#X#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Fortsetzungszeile + +Format: X <Fortsetzungszeile> + +Erklärung: Eine in der vorangegangenen Zeile nicht beendete Anweisung wird nach + einer X-Anweisung fortgesetzt (Es können beliebig viele X-Anweisun + gen nacheinander folgen). + +Beispiel: T TABELLE=1/2/3/4/5/6/7/8/9/10/11/12/13/14 + X /15/16/17/18/19 + +Programm: "dyn.bev" + + + +#goal page ("*")##ib (2)#*#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Überschrift + +Format: * <Überschrift> + +Erklärung: Gibt dem aktuellen Lauf eine Überschrift + +Beispiel: * Überschrift + +Referenz: RUN, S. #to page ("RUN")# +#page# + +#ib#5. Makros in DYNAMO#ie# + + + + +Der DYNAMO-Compiler bietet die Möglichkeit, benutzereigene Funktionen zu definie +ren. Makros werden ähnlich wie Refinements in ELAN in das DYNAMO-Programm +eingesetzt. Beim EUMEL-DYNAMO-Compiler werden mit "zz" beginnende Namen +generiert, so daß Sie es vermeiden sollten, eigene Namen mit "zz" beginnen zu +lassen. Weiterhin sollte man als Namen der aktuellen Parameter nicht die Namen der +formellen Parameter verwenden. + +Folgende Makros werden standardmäßig vom DYNAMO-Compiler zur Verfügung +gestellt: + + macro delay1 (in, del) Verzögerung erster Ordnung + + macro delay3 (in, del) Verzögerung dritter Ordnung + Material + + macro delay3p (in, del, ppl) Verzögerung dritter Ordnung mit + Pipeline + + macro delinf3 (in, del) Verzögerung dritter Ordnung für + Information + + macro smooth (in, del) Verzögerung erster Ordnung für + Information + + + + +#ib#5.1. Insertieren von Makros#ie# + + + + +Makros werden durch folgende Prozedur in die Compilertabelle eingetragen: + + +PROC insert macro (TEXT CONST filename): + + Zweck: Fügt die in der Datei 'filename' enthaltenen Makros in die Makrotabelle ein. + Die Datei sollte zweckmäßigerweise nur Makrodefinitionen enthalten. Es ist + - im Gegensatz zu normalen DYNAMO-Programmen - nicht nötig, die + Systemkonstanten zu definieren (die Standard-Makros sind in der Datei + "dyn.mac" enthalten; diese Datei kann beliebig ergänzt werden). + + + + +#ib#5.2. Aufbau eines Makros#ie# + + + + +Makros beginnen in DYNAMO immer mit der Anweisung MACRO (s. auch Seite #to page ("MACRO")#) +und enden mit MEND (s. Seite #to page ("MEND")#). Dazwischen steht ein Makrorumpf, bestehend +aus einer oder mehreren DYNAMO-Gleichungen. Beim Makroaufruf können, soweit +vorher definiert, Parameter angegeben werden, jedoch rekursiv aufrufen kann man +Makros nicht. + +Beispiel: MACRO SMOOTH (IN, DEL) + L SMOOTH.K = SMOOTH.J + DT * (IN.J - SMOOTH.J) + X /DEL + N SMOOTH = IN + MEND + +Lokale Variablen in Makros beginnen mit einem $-Zeichen. Der Makro-Expandierer +ersetzt das $-Zeichen durch "zz" gefolgt von einer Zahl. Aus diesem Grund sollen +eigene Namen nicht mit "zz" beginnen. + +Falls Sie eine Fehlermeldung bekommen, die sich auf einen mit "zz" beginnenden +Namen bezieht, sollten Sie den Fehler in dem entsprechenden Makro suchen. + +#on ("b")# +Achtung: #off ("b")#Makros sollten nur von fortgeschrittenden DYNAMO-Programmieren + verwendet werden, da Makros Eigenschaften von Refinements (textuelle + Ersetzung) und Prozeduren (Parameterübergabe) vereinigen. Der daraus + folgende Effekt ist nicht ganz einfach zu durchschauen. +#page# + + + +#ib#6. Erweiterung des Sprachumfangs#ie# + + + + +Während Makros in DYNAMO geschrieben werden, ist es ferner möglich, die Menge +der Funktionen mittels der Sprache ELAN zu erweitern. + +Hierbei geht man wie folgt vor: + + 1. Schreiben einer Funktion in ELAN (näheres siehe unten) + + 2. Einbinden der Funktion in die Tabellen des DYNAMO-Compilers + + 2.1. Einschreiben des Namens der Funktion, gefolgt von den Typen der Ein + gabeparameter in die bestehende Datei "dyn.std", wobei folgende Typen + existieren: + + r real (Datentyp REAL) + t table (Datentyp TAB) + + Abgeschlossen wird die "dyn.std"-Datei durch die Zeichensequenz "/*". + + Beispiele: + + power rr table trrrr /* + + + 2.2. Laden der Funktion(en) mittels der Prozedur 'init std ("dyn.std")' + + +Eine zur Einbindung in den DYNAMO-Compiler vorgesehene ELAN-Funktion wird +unter Beachtung gewisser Regeln erstellt: + + 1. Die deklarierten ELAN-Prozeduren dürfen nur Parameter vom Typ REAL oder + TAB besitzen oder gänzlich ohne Parameter sein. + + 2. Der Typ des Resultaten muß vom Typ REAL sein. + +Zur Manipulation von Tabellen wurde der Datentyp TAB geschaffen, auf welchen man +wie auf das Standard-Vektorpaket zugreifen kann. + +Beispiel: + + REAL PROC abs (REAL CONST a): + IF a < 0.0 THEN + -a + ELSE + a + END IF + END PROC abs; + + PROC sumv (TAB CONST tab, REAL CONST erstes, letztes): + REAL VAR summe := 0.0; + INT VAR i; + FOR i FROM int (erstes) UPTO int (letztes) REPEAT + summe INCR wert (tab, i) + END REPEAT; + summe + END PROC sumv + + + + +#ib#6.1. Für fortgeschrittende ELAN-Program + mierer#ie# + + + +Der Quellcode des EUMEL-DYNAMO-Compilers wird mit ausgeliefert. Daher +können Einschränkungen (s. 3.2 Abweichungen gegenüber dem Sprachstandard) +leicht beseitigt werden. Wem z.B. die Anzahl der Gleichungen (950) zu wenig ist, der +kann im Quelltext des Compilers diesen Wert (annähernd) beliebig nach oben hin +erhöhen. + diff --git a/lang/dynamo/1.8.7/doc/dynamo handbuch.index b/lang/dynamo/1.8.7/doc/dynamo handbuch.index new file mode 100644 index 0000000..af77d79 --- /dev/null +++ b/lang/dynamo/1.8.7/doc/dynamo handbuch.index @@ -0,0 +1,69 @@ +#block##pageblock##page (52)# +#head# +#center#DYNAMO-Compiler +#center#____________________________________________________________ + +#end# +#bottom odd# +#center#____________________________________________________________ +GMD #right#DYNAMO - % +#end# +#bottom even# +#center#____________________________________________________________ +DYNAMO - % #right#GMD +#end# +Anhang - Übersicht über Anweisungen und +Funktionen + + +#clear pos##l pos (0.0)##r pos (10.0)##fillchar (" ")# +#table# +A 21 +ABS 21 +ARCTAND 22 +C 23 +CLIP 23 +COSD 24 +EXP 25 +FIFGE 25 +FIFZE 26 +FLOOR 26 +FOR 27 +FRAC 27 +L 28 +LN 28 +LOG2 29 +LOG10 29 +MACRO 30 +MAX 31 +MEND 31 +MIN 32 +N 32 +NOISE 33 +NORMRN 33 +NOTE 34 +PLOT 35 +POWER 35 +PRINT 36 +R 36 +RAMP 37 +RUN 37 +S 38 +SCLPRD 38 +SIN 39 +SIND 39 +SPEC 40 +SQRT 40 +STEP 41 +SUM 41 +SUMV 42 +SWITCH 42 +T 43 +TABHL 43 +TABLE 44 +TAN 44 +TAND 45 +X 45 +* 46 +#table end# + diff --git a/lang/dynamo/1.8.7/doc/dynamo handbuch.inhalt b/lang/dynamo/1.8.7/doc/dynamo handbuch.inhalt new file mode 100644 index 0000000..2d1b1f3 --- /dev/null +++ b/lang/dynamo/1.8.7/doc/dynamo handbuch.inhalt @@ -0,0 +1,131 @@ +____________________________________________________________________________ + + +#on("b")##on ("u")# +#center#Betriebssystem E U M E L +#off ("u")# + + +#center#DYNAMO + + + + +#off("b")# +#center#Lizenzfreie Software der +#on ("b")# + +#center#Gesellschaft für Mathematik und Datenverarbeitung mbH, +#center#5205 Sankt Augustin + + +#off("b")# +#center#Die Nutzung der Software ist nur im Schul- und Hochschulbereich für +#center#nichtkommerzielle Zwecke gestattet. + +#center#Gewährleistung und Haftung werden ausgeschlossen + + +____________________________________________________________________________ +#page# +#block# +#center#____________________________________________________________________________ + + Copyright 1988 + + Selbstverlag GMD + Alle Rechte vorbehalten. + Insbesondere ist die Überführung in maschinenlesbare + Form, sowie das Speichern in Informationssystemen, auch + auszugsweise, nur mit schriftlicher Genehmigung der + GMD gestattet. +#center#____________________________________________________________________________ + + + Herausgeber: + + Gesellschaft für Mathematik und Datenverarbeitung mbH + + Postfach 1240, Schloß Birlinghoven + D-5205 Sankt Augustin 1 + Telefon(02241) 14-1, Telex 8 89 469 gmd d + Telefax(02241) 14 28 89, BTX *43900\# + Teletex 2627-224135=GMDVV + + +Autor: + + Christian Szymanski + +nach Anregungen von: + + Diether Craemer, Robert Keil + +überarbeitet von: + + Thomas Müller + +Texterstellung: + + Dieser Text wurde mit der EUMEL-Textverarbeitung erstellt und aufbereitet und + mit dem Agfa Laserdrucksystem P400 gedruckt. + + + + Hinweis: + +#on("italics")# + Diese Dokumentation wurde mit größtmöglicher Sorgfalt erstellt. Dennoch wird + für die Korrektheit und Vollständigkeit der gemachten Angaben keine Gewähr + übernommen. Bei vermuteten Fehlern der Software oder der Dokumentation + bitten wir um baldige Meldung, damit eine Korrektur möglichst rasch erfolgen + kann. Anregungen und Kritik sind jederzeit willkommen.#off("italics")# +#page# +#pagenr ("%", 1")##setcount (1)##block##pageblock##count per page# +#head# +#center#DYNAMO-Compiler +#center#____________________________________________________________ + +#end# +#bottom odd# +#center#____________________________________________________________ +GMD #right#DYNAMO - % +#end# +#bottom even# +#center#____________________________________________________________ +DYNAMO - % #right#GMD +#end# + +Inhalt + + + +#clear pos##lpos (0.0)##r pos (10.0)##fillchar (" ")# +#table# +1. Einleitung 2 + 1.1. Referenzliteratur 2 + 1.2. Die Programmiersprache DYNAMO 3 + 1.3. Kurz-Einführung in die DYNAMO-Schreibweise 4 + 1.4. Eine erste, kleine Sitzung mit dem DYNAMO-System 6 + +2. Generierung des DYNAMO-Compilers 7 + +3. Der EUMEL-DYNAMO-Compiler 8 + 3.1. Benutzung des DYNAMO-Compiler 8 + 3.2. Abweichungen gegenüber dem Sprachstandard 11 + 3.3. Das DYNAMO Runtime-System 12 + 3.4. Fehlermeldungen des DYNAMO-Compilers 14 + +4. Anweisungen und Funktionen des EUMEL-DYNAMO-Compilers 19 + 4.1. Übersicht über die Anweisungen und Funktionen 21 + +5. Makros in DYNAMO 47 + 5.1. Insertieren von Makros 48 + 5.2. Aufbau eines Makros 48 + +6. Erweiterung des Sprachumfangs 50 + 6.1. Für fortgeschrittende ELAN-Programmierer 51 + +Anhang - Übersicht über Anweisungen unf Funktionen 52 +#table end# + diff --git a/lang/dynamo/1.8.7/source-disk b/lang/dynamo/1.8.7/source-disk new file mode 100644 index 0000000..e61107d --- /dev/null +++ b/lang/dynamo/1.8.7/source-disk @@ -0,0 +1 @@ +informatikpaket/01_sprachen.img diff --git a/lang/dynamo/1.8.7/src/"15"TAB1"14" b/lang/dynamo/1.8.7/src/"15"TAB1"14" Binary files differnew file mode 100644 index 0000000..ce88e03 --- /dev/null +++ b/lang/dynamo/1.8.7/src/"15"TAB1"14" diff --git a/lang/dynamo/1.8.7/src/dyn.33 b/lang/dynamo/1.8.7/src/dyn.33 new file mode 100644 index 0000000..a17bd55 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.33 @@ -0,0 +1,2073 @@ +(**************************************************************************) +(**************************************************************************) +(****** ******) +(****** ******) +(****** DYNAMO - III - ELAN PRECOMPILER ******) +(****** ******) +(****** ******) +(****** AUTOREN : R. Keil, ******) +(****** T. Froehlich ******) +(****** ******) +(****** VERSION : 3.3.7 ******) +(****** ******) +(****** ******) +(****** AENDERUNGEN: ******) +(****** 05.10.1983 ******) +(****** 06.05.1985 Hua&DC: forget("zzdyn.const") ******) +(****** 08.04.1986 Ley : Anpassung an 1.7.5 ******) +(****** 02.04.1987 C.Fallis & C.Rensen Einbettung in BOX ******) +(****** 18.05.1988 dc: Udi Katzirs changes ******) +(****** should declare vector eingeführt ******) +(****** 20.05.1988 dc: already used in loop body eingeführt ******) +(****** Fehlermeldung bei Ref. int index unterdrückt ******) +(****** weil sie wahrscheinlich selbst ein Fehler ist ******) +(****** 21.07.1988 Christian Szymanski ******) +(****** Ausbettung aus BOX ******) +(****** ******) +(****** ******) +(**************************************************************************) +(**************************************************************************) + + +PACKET dynamo compiler 33 DEFINES init std, dynamo, insert macro, + erase, table dump, graphic: + +(********************** T A B L E S ********************************) + +LET max tab size = 950, + max hash size = 300, + library = ""15"TAB1"14"", + tab name = ""15"TAB2"14""; + +BOOL VAR is draw := FALSE; + +TYPE TABLE = STRUCT (ROW max tab size TEXT name, init, right part, + ROW max tab size INT type, line no, pred, mac, + index, index type, + ROW max tab size BOOL in use, idef, rdef, + already used in loop body, + should declare vector, + (*18.5.88 dc: Änderung von Udi Katzir *) + ROW max hash size INT class, + INT tab size, + tab beg); + +(* already used in loop body: is set to TRUE , if that table-element has been + used to generate a line within a loop --> PROC gen loop 20.5.88 dc*) + +(* should declare vector : used when rows are declared and indicates if the*) +(* length of the row is to be taken from the index of the current variable *) + +BOUND TABLE VAR tab; + +PROC enter (TEXT CONST name, right part, INT CONST type of equ) : + INT VAR tab pos; + INT CONST hash class := hash (name); + search (name, tab pos, lmp, equtype, hash class); + table index := tab pos; + enter equ. + + enter equ : + IF not found OR subscript COR CONCR (tab).type (tabpos) = mac param + THEN enter name + ELIF type of equ = nequ + THEN enter nequ + ELIF CONCR (tab).right part (tab pos) = nt + THEN complete nequ + ELSE err (name, 1) + FI. + + equtype : + IF subscript + THEN type of equ + ELSE nil + FI. + + enter name : + CONCR (tab).tab size INCR 1; + tab size := CONCR (tab).tab size; + IF tab size > max tab size + THEN errorstop ("dynamo table overflow") + FI; + IF type of equ = nequ + THEN CONCR (tab).init (tab size) := right part; + CONCR (tab).right part (tab size) := nt + ELSE CONCR (tab).init (tab size) := nt; + CONCR (tab).right part (tab size) := right part + FI; + init element. + + init element : + CONCR (tab).name (tab size) := name; + CONCR (tab).type (tab size) := type of equ; + CONCR (tab).line no (tab size) := line no; + CONCR (tab).mac (tab size) := lmp; + CONCR (tab).index (tab size) := nil; + CONCR (tab).index type (tab size) := nil; + CONCR (tab).in use (tab size) := FALSE; + CONCR (tab).idef (tab size) := FALSE; + CONCR (tab).rdef (tab size) := FALSE; + CONCR (tab).already used in loop body (tab size) := FALSE; + CONCR (tab).pred (tab size) := CONCR (tab).class (hash class); + CONCR (tab).class (hash class) := tab size. + + enter nequ : + IF CONCR (tab).init (tab pos) <> nt + THEN err (name, 2) + FI; + CONCR (tab).init (tab pos) := right part. + + complete nequ : + CONCR (tab).right part (tab pos) := right part; + CONCR (tab).type (tab pos) := type of equ; + CONCR (tab).line no (tab pos) := line no. +END PROC enter; + +PROC test (TEXT CONST name, INT VAR tab pos, INT CONST last mp, type, + err no) : + search (name, tab pos, last mp, type); + IF not found + THEN err (err no) + FI +END PROC test; + +PROC search (TEXT CONST name, INT VAR tab pos, INT CONST last mp, type) : + search (name, tab pos, last mp, type, hash (name)) +END PROC search; + +PROC search (TEXT CONST name, INT VAR tab pos, + INT CONST last mp, type, hash class) : + not found := TRUE; + tab pos := CONCR (tab).class (hash class); + WHILE tab pos <> nil CAND name not found REP + tab pos := CONCR (tab).pred (tab pos) + PER. + + name not found : + not found := NOT (CONCR (tab).name (tab pos) = name + AND same macro AND type ok); + not found. + + same macro : + CONCR (tab).mac (tab pos) = last mp. + + type ok : + type = nil OR CONCR (tab).type (tab pos) = type. +END PROC search; + +PROC insert macro (TEXT CONST source) : + dynamo (source, ""8"", FALSE); + kill (""8""); + IF errors = nil + THEN kill (library); + copy (tab name, library) + FI +END PROC insert macro; + +PROC init std (TEXT CONST std name) : + lmp := nil; + kill (library); + tab := new (library); + FOR i FROM 1 UPTO max hash size REP + CONCR (tab).class (i) := nil + END REP; + CONCR (tab).tab size := nil; + enter std procs; + CONCR (tab).tab beg := tab size + 1. + +enter std procs : + FILE VAR std file := sequential file (input, std name); + TEXT VAR name, params; + WHILE NOT eof (std file) REP + get (std file, name); + test eof; + IF params = "()" + THEN params := "" + FI; + enter (name, params, std p) + END REP. + + test eof : + IF name = "/*" + THEN LEAVE enter std procs + ELSE get (std file, params) + FI. +END PROC init std; + +PROC next sym : + next sym (scan buf, sym, type, scan position) +END PROC next sym; + +PROC next sym (TEXT CONST buf) : + next sym (buf, sym, type, scan position) +END PROC next sym; + +PROC test open bracket (TEXT CONST sym) : + IF sym <> "(" + THEN err (sym, 6) + FI +END PROC test open bracket; + +PROC test closing bracket (TEXT CONST sym) : + IF sym <> ")" + THEN err (sym, 58) + FI +END PROC test closing bracket; + +PROC test bold (INT CONST err no) : + IF type <> bold + THEN err (err no) + FI +END PROC test bold; + +PROC test equal (INT CONST err no) : + IF sym <> "=" + THEN err (err no) + FI +END PROC test equal; + +BOOL OP IN (TEXT CONST pattern, source) : + pos (source, pattern) > nil. +END OP IN; + +PROC scan (TEXT CONST buf) : + scan buf := buf; + scan position := 1 +END PROC scan; + +PROC err (TEXT CONST a, INT CONST b) : + err (a, b, line no) +END PROC err; + +PROC err (INT CONST i) : + err (sym, i, line no) +END PROC err; + +PROC gen (TEXT CONST a) : + out buf CAT a +END PROC gen; + +PROC gen (TEXT CONST a, b) : + out buf CAT a; + out buf CAT b +END PROC gen; + +PROC gen (TEXT CONST a, b, c) : + out buf CAT a; + out buf CAT b; + out buf CAT c +END PROC gen; + +PROC gen (TEXT CONST a, b, c, d) : + out buf CAT a; + out buf CAT b; + out buf CAT c; + out buf CAT d +END PROC gen; + +PROC genln (TEXT CONST a, b, c) : + gen (a, b, c); + lf +END PROC genln; + +PROC lf : + putline (target, outbuf); + outbuf := nt +END PROC lf; + +PROC gen ln (TEXT CONST t) : + outbuf CAT t; + putline (target, outbuf); + outbuf := nt +END PROC gen ln; + +PROC erase (BOOL CONST b) : + erase option := b +END PROC erase; + +PROC dynamo (TEXT CONST s) : + TEXT VAR target name := s + ".elan"; + dynamo (s, target name, TRUE); + IF erase option + THEN kill (target name) + FI; + last param (s) +END PROC dynamo; + +PROC dynamo : + dynamo (last param) +END PROC dynamo; + +PROC graphic (BOOL CONST mode): + is draw := NOT mode +END PROC graphic; + +(********************** C O M P I L E R ************************) + +LET bold = 1, number = 2, + delimiter = 3, eol = 4, + aux = 1, rate = 2, + level = 3, nequ = 4, + mac name = 6, std p = 7, + sub init = 8, table = 9, + for = 10, mac param = 11, + const = 12, print = 1, + plot = 2, global param = 1, + none = 3, max print no = 10, + supp = 5, any = "ß"; + +FILE VAR source, target; + +ROW max print no TEXT VAR print param; + +ROW 10 TEXT VAR plot name, id; +ROW 10 INT VAR scale pointer; +ROW 10 TEXT VAR lower bound, upper bound; +ROW 10 BOOL VAR l fixed scale, u fixed scale; + +TEXT VAR buffer, left part, right part, outbuf, print buf, + headline, sym, plot buf, asterisk buffer, + macro name, noise buffer, constant, run buffer, + scan buf; + +INT VAR print param no, print line no, tab beg, type, line no, + plot line no, scale counter, plot param no, + last pos, lmp, index, (* lmp = Last Macro Position *) + index type, for index, i, tab size, expansion no, + table index, scan position, old tab beg; + +BOOL VAR k, kl, is first, fixed scale, in macro, + in loop, not found, internal, subscript, + erase option := FALSE; + +TEXT CONST nt := ""; + +INT CONST nil := 0; + + +(*$$$$$$$$$$ ZUSATZ C & C 20.2.87 eingefuegt : error listing $$$$$$$$$*) +(* Diese Prozedur erzeugt einen zweigeteilten Bildschirm, wobei *) +(* die Datei 'procsource' (d.h. das Dynamo-Quellprogramm) in der *) +(* oberen Haelfte und die Fehlerdatei 'notebook' in der unteren *) +(* Haelfte steht. *) + +PROC error listing (FILE VAR procsource) : (* C.S. 21.07.88 *) + note edit (procsource); +END PROC error listing; +(*$$$$$$$$$$$$$$$$$$$$ ENDE ZUSATZ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$*) + + +PROC dynamo (TEXT CONST source name, target name, BOOL CONST pass2) : + init dynamo; + first pass; + IF no errors + THEN second pass + ELSE error listing(source); + error stop ("") (* C.S. 21.07.88 *) + (* Falls Fehler im ersten Durchlauf gefunden wurden, wird der zweite *) + (* Durchlauf erst gar nicht durchgefuehrt, sondern das fehlerhafte *) + (* Dynamo-Programm und die Fehlerdatei werden ausgegeben . *) + FI. + + first pass : + WHILE NOT eof (source) REP + read source line; + translate line + PER; + IF NOT pass2 + THEN LEAVE dynamo + FI; + end of first pass. + + second pass : + generate initializations; + generate equations. + + generate initializations : + generate rts call; + generate noise card; + generate table part; + generate for variables; + generate variable part; + generate table init; + generate init print; + generate init plot; + generate init scale; + generate asterisk; + gen repeat. + + generate equations : + generate print line; + generate plot line; + gen equations (level); + gen equations (aux); + gen equations (supp); + gen equations (rate); + gen end repeat; + IF no errors + THEN run (target name) + ELSE error listing(source); + error stop ("") (* C.S. 21.07.88 *) + (* Falls im zweiten Durchlauf Fehler gefunden wurden, wird das *) + (* ELAN-Zielprogramm nicht ausgefuehrt, sondern das fehlerhafte *) + (* Dynamo-Quellprogramm und die Fehlerdatei werden ausgegeben . *) + FI. + + init dynamo : + kill (target name); + init tables; + source := sequential file (input, source name); + target := sequential file (output, target name); + print buf := nt; + outbuf := nt; + plot buf := nt; + noise buffer := nt; + asterisk buffer := nt; + macro name := nt; + run buffer := "zzdyn"; + line no := nil; + plot param no := nil; + last pos := nil; + lmp := nil; + index := nil; + index type := nil; + expansion no := nil; + in macro := FALSE; + internal := FALSE; + in loop := FALSE; + is first := TRUE; + tab beg := CONCR (tab).tab beg; + old tab beg := CONCR (tab).tab size + 1; + init errors. + + init tables : + kill (tab name); + copy (library, tab name); + tab := old (tab name). + + read source line : + line no INCR 1; + getline (source, buffer); + cout (line no); + scan (buffer); + next sym. + + translate line : + TEXT VAR start := sym; + next sym; + WHILE sym = " " REP next sym PER; + SELECT + pos ("a c l n r print plot note EOL spec * x macro mend for s noise run ", + start + " ") OF + CASE 1 : enter equ (TRUE, FALSE, aux, 9) + CASE 3, 31 : constant equ + CASE 5 : enter equ (TRUE, FALSE, level, 11) + CASE 7 : enter equ (FALSE, FALSE, nequ, 56) + CASE 9 : enter equ (FALSE, TRUE, rate, 12) + CASE 11 : print card + CASE 17 : plot card + CASE 22, 27 : (* comment; empty line *) + CASE 36 : gen headline + CASE 15 : enter equ (FALSE, FALSE, table, 13) + CASE 38 : continuation card + CASE 40 : macro card + CASE 46 : macro end + CASE 51 : for card + CASE 55 : enter equ (TRUE, FALSE, supp, 9) + CASE 57 : noise card + CASE 63 : run card + OTHERWISE : err (start, 3) + END SELECT. + + macro card : + IF in macro + THEN err (4) + FI; + in macro := TRUE; + get macro name; + get macro param list. + + get macro name : + IF type = bold + THEN enter (sym, nt, mac name); + CONCR (tab).line no (tab size) := nil; + macro name := sym; + lmp := tab size + ELSE err (5) + FI. + + get macro param list : + next sym; + test open bracket (sym); + next sym; + WHILE sym <> ")" REP + IF type = bold + THEN enter (sym, nt, mac param) + ELSE err (7) + FI; + next sym; + IF sym = "," + THEN next sym + FI + END REP; + test closing bracket (sym). + + macro end : + lmp := nil; + in macro := FALSE. + + constant equ : + REP + analyze constant equ; + enter (left part, constant, const); + last pos := tab size + UNTIL end of constants PER. + + analyze constant equ : + test bold (10); + left part := sym; + next sym; + test equal (21); + get constant. + + end of constants : + next sym; + test delimiter. + + get constant : + next sym; + IF NOT sym is number (constant) + THEN err (37) + FI. + + print card : + IF print buf = nt + THEN print buf := subtext (buffer, scanposition - length (sym)); + print line no := line no + ELSE print buf CAT "," + subtext (buffer, scanposition - length (sym)) + FI; + last pos := print. + + plot card : + IF plot buf = nt + THEN plot buf := subtext (buffer, scanposition - length (sym)); + plot line no := line no; + ELSE plot buf CAT "/" + subtext (buffer, scanposition - length (sym)) + FI; + last pos := plot. + + gen headline : + asterisk buffer := "asterisk (""" + subtext (buffer, 3) + """);". + + generate asterisk : + IF asterisk buffer <> nt + THEN genln (asterisk buffer) + FI. + + continuation card : + skip blanks; + TEXT CONST tail := subtext (buffer, i); + SELECT last pos OF + CASE print : print buf CAT "," + tail + CASE plot : plot buf CAT "/" + tail + CASE none : err (14) + OTHERWISE : content CAT tail + END SELECT. + + content : + IF CONCR (tab).type (last pos) = nequ + THEN CONCR (tab).init (last pos) + ELSE CONCR (tab).right part (last pos) + FI. + + skip blanks : + i := 1; + REP + i INCR 1 + UNTIL (buffer SUB i) <> " " END REP. + + for card : + REP + read for variable + UNTIL end of forlist END REP. + + end of forlist : + IF sym = "/" + THEN next sym; FALSE + ELSE TRUE + FI. + + read for variable : + TEXT VAR init; (* left part = name *) + test bold (15); (* right part = obere Grenze *) + left part := sym; (* init = untere Grenze *) + next sym; + test equal (16); + next sym; + pass ranges; + enter (left part, right part, for); + CONCR (tab).init (tab size) := init. + + pass ranges : + test number (init); + IF sym <> "," + THEN err (18) + FI; + next sym; + test number (right part). + + noise card : + IF NOT sym is number (noise buffer) + THEN err (66) + FI. + + run card : + test bold (65); + run buffer := sym. + + gen repeat : + lf; + genln ("WHILE time <= length REP");genln (" cout(int(time));"); + genln (" set time (time);"). + + gen end repeat : + genln ("UNTIL " + draw ad + "stop request PER;"); + IF plot buf <> nt + THEN genln (draw ad + "end of program;") + FI; + genln ("END PROC target program"). + + generate rts call : + genln ("forget (""zzdyn.const"",quiet);"); + genln ("run card (""", run buffer, """);"); + genln ("run time system (PROC target program);"); + lf; + genln ("PROC target program :"). + + generate noise card : + IF noise buffer <> nt + THEN genln (" initialize random (", noise buffer, ");") + FI. + + generate plot line : + IF plot buf <> nt + THEN gen plots + FI. + + gen plots : + genln (draw ad + " new plot line (time);"); + FOR i FROM 1 UPTO plot param no REP + genln (draw ad + " plot (", plot name (i), ");"); + genln ("IF " + draw ad + " stop request THEN LEAVE target program " + + "END IF;") + END REP. + + generate print line : + IF print buf <> nt + THEN gen prints + FI. + + gen prints : + genln (" new line (time);"); + FOR i FROM 1 UPTO print param no REP + genln (" print (", printparam (i), ");") + END REP. + + generate init plot : + INT VAR tab pos; + IF plot buf <> nt + THEN search ("pltper", tab pos, nil, const); + IF not found + THEN IF is draw THEN + err ("draw", 25, plot line no) + ELSE + err ("plot", 25, plot line no) + END IF + ELSE genln (draw ad + "initialize plot (""", plot buf, """);"); +(*$$$$$$$$$$$$$ ZUSATZ Februar87 C&C eingefuegt: pltper INCR 0 $$$$$$$$$*) + genln ("pltper INCR 0.0 ;"); + genln (" (* um Warnung des ELAN-Compilers zu unterdruecken *)") +(*$$$$$$$$$$$$$$$$$$$$$$$$$$ ENDE ZUSATZ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$*) + FI + FI. +END PROC dynamo; + +PROC test number (TEXT VAR content) : + SELECT type OF + CASE bold : content := sym + CASE number : content := trunc (sym) + OTHERWISE err (17) + END SELECT; + next sym +END PROC test number; + +PROC enter equ (BOOL CONST x, y, INT CONST exp type, err no) : + get left part; + enter (left part, right part, exp type); + set index; + test global; + IF incorrect time script + THEN err (err no) + FI. + + incorrect time script : + (k XOR x) OR (kl XOR y). + + set index : + INT VAR last entry := table position; + last pos := last entry; + CONCR (tab).index (last entry) := index; + CONCR (tab).index type (last entry) := index type. + + table position : + IF exp type = nequ AND index type = nil AND NOT not found + THEN table index + ELSE tab size + FI. + + test global : + IF in macro AND NOT internal + THEN search global + FI. + + search global : + INT VAR tab pos; + search (left part, tab pos, lmp, mac param); + IF not found + THEN IF left part <> macro name + THEN err (left part, 64) + FI + ELSE CONCR (tab).index (last entry) := tab pos; + CONCR (tab).index type (last entry) := -1; + CONCR (tab).index type (tab pos) := global param; + CONCR (tab).index (tab pos) := last entry + FI. + + get left part : + get name; + get time script; + get index. + + get name : + internal := sym = "$"; + IF internal + THEN next sym; + IF NOT in macro + THEN err (19) + FI + FI; + test bold (20); + left part := sym; next sym. + + get time script : + IF sym = "." + THEN process time script + ELSE k := FALSE; kl := FALSE + FI; + subscript := sym = "(". + + get index : + IF subscript + THEN process index + ELSE index := nil; + index type := nil + FI; + right part := subtext (buffer, scanposition); + test equal (21). + + process time script : + next sym; + k := sym = "k"; kl := sym = "kl"; + next sym. + + process index : + next sym; + SELECT type OF + CASE number : index := int (sym) + CASE bold : search for variable + OTHERWISE : err (22) + END SELECT; + index type := type; + next sym; + test closing bracket (sym); + next sym. + + search for variable : + test (sym, tab pos, lmp, for, 61); + index := tab pos. +END PROC enter equ; + +PROC end of first pass : + INT VAR tab pos; + init time; + search macro calls; + search system constants. + + init time : + search ("time", tab pos, nil, nequ); + IF not found + THEN enter ("time", "0.0", nequ) + FI; + enter ("time", "time.j+dt", level). + + search system constants : + sym := nt; + test ("dt", tab pos, nil, const, 35); + test ("length", tab pos, nil, const, 36). + + search macro calls : + INT VAR old tabsize := tabsize; + FOR i FROM old tabbeg UPTO old tabsize REP + IF is normal equ + THEN enter global macro params + FI + END REP; + tab size := old tabsize. + + is normal equ : + SELECT CONCR (tab).type (i) OF + CASE aux, rate, level, nequ, supp : TRUE + OTHERWISE : FALSE + END SELECT. + + enter global macro params : + enter params (CONCR (tab).right part (i), FALSE); + enter params (CONCR (tab).init (i), TRUE). +END PROC end of first pass; + +PROC enter params (TEXT CONST buf, BOOL CONST is init) : + TEXT VAR macro name; + IF pos (buf, "(") > nil + THEN read params + FI. + + read params : + scan position := 1; + REP + next sym (buf, macro name, type, scan position); + IF type = bold + THEN next sym (buf); + IF sym = "(" + THEN parameter list + FI + FI + UNTIL type = eol END REP. + + parameter list : + INT VAR act param, tab pos; + search (macro name, tab pos, nil, nil); + IF NOT not found CAND CONCR (tab).type (tab pos) = mac name + THEN read param list + FI. + + read param list : + CONCR (tab).index type (tab pos) INCR 1; + act param := tab pos; + REP + next sym (buf); + act param INCR 1; + IF CONCR (tab).type (act param) = mac param + THEN test parameter + ELSE err (macro name, 53) + FI + UNTIL end of parameter list END REP. + + test parameter : + TEXT VAR param; + IF CONCR (tab).index type (act param) = global param + THEN get global param + ELSE get actual param + FI; + content CAT param + "%". + + content : + IF is init + THEN CONCR (tab).init (act param) + ELSE CONCR (tab).right part (act param) + FI. + + get global param : + INT VAR param index; + IF type = bold + THEN enter param + FI. + + enter param : + param index := CONCR (tab).index (act param); + enter (sym, CONCR (tab).right part (param index), + CONCR (tab).type (param index)); + CONCR (tab).init (tab size) := CONCR (tab).init (param index); + CONCR (tab).index (tab size) := act param; + param := sym; + next sym (buf); + get time script. + + get actual param : + INT VAR brackets := nil; + param := nt; + REP + param CAT sym; + next sym (buf); + get time script + UNTIL end of param END REP. + + get time script : + IF sym = "." + THEN param CAT sym; + next sym (buf); + param CAT any; + next sym (buf) + FI. + + end of param : + IF brackets = nil + THEN sym IN ",)" + ELIF sym = "(" + THEN brackets INCR 1; + FALSE + ELIF sym = ")" + THEN brackets DECR 1; + TRUE + ELSE FALSE + FI. + + end of parameter list : + SELECT pos (",)", sym) OF + CASE 1 : FALSE + CASE 2 : TRUE + OTHERWISE : err (50); TRUE + END SELECT. +END PROC enter params; + +(************************* P A S S 2 ***************************) + +PROC generate init print : + INT VAR tab pos; + IF print buf <> nt + THEN test ("prtper", tab pos, nil, const, 24); + gen init + FI. + + gen init : + print param no := nil; + headline := nt; + scan (print buf); + line no := print line no; + cout (line no); + REP + get parameter + UNTIL sym <> "," END REP; + genln ("initialize print (""", headline, """);"); + (*$$$$$$$$$$$$$ ZUSATZ Februar87 C&C eingefuegt: prtper INCR 0 $$$$$$$$$$*) + genln ("prtper INCR 0.0 ;"); + genln ("(* Um Warnung des ELAN-Compilers zu unterdruecken *)"). + (*$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ ENDE ZUSATZ $$$$$$$$$$$$$$$$$$$$$$$*) + get parameter : + next sym; + test bold (33); + get print param. + + get print param : + test (sym, tab pos, nil, nil, 32); + enter name. + + enter name : + TEXT VAR act param := sym; + INT VAR pos := scanposition - length (sym); + test subscript (act param, 33); + print param no INCR 1; + print param (print param no) := act param; + headline CAT text (subtext (print buf, pos, scanposition - 1), 13); + headline CAT " ". +END PROC generate init print; + +PROC test subscript (TEXT VAR act param, INT CONST err no) : + INT VAR tab pos; + next sym; + IF sym = "(" + THEN test index + FI. + + test index : + next sym; + act param CAT " SUB "; + act param CAT subscript; + next sym; + test closing bracket (sym); + next sym. + + subscript : + SELECT type OF + CASE number : trunc (sym) + CASE bold : search index + OTHERWISE : err (err no); nt + END SELECT. + + search index : + test (sym, tab pos, nil, for, 61); + sym. +END PROC test subscript; + +PROC generate init scale : + IF plot buf <> nt + THEN gen plot card + FI. + + gen plot card : + scale counter := 1; + plot param no := nil; + line no := plot line no; + cout (line no); + scan (plot buf); + REP + equal scale; + different scale + UNTIL type = eol OR sym = " " END REP; + generate scales. + + equal scale : + fixed scale := FALSE; + REP + next sym; + single scale param + UNTIL sym <> "," END REP. + + different scale : + IF sym = "/" + THEN scale counter INCR 1 + ELIF type <> eol + THEN err (sym, 26, plot line no) + FI. + + generate scales : + clear scales; + gen plot scales. + + gen plot scales : + FOR i FROM 1 UPTO plot param no REPEAT + gen (draw ad + "plot scale (""", id (i), """, ", + text (scale pointer (i))); + gen (", ", lower scale, ", ", upper scale); + gen (", ", text (l fixed scale (i)), ", ", text (u fixed scale (i))); + genln (");") + END REP. + + lower scale : + IF l fixed scale (i) + THEN lower bound (i) + ELSE "9.0e126" + FI. + + upper scale : + IF u fixed scale (i) + THEN upper bound (i) + ELSE "-9.0e126" + FI. + + clear scales : + FOR i FROM scale counter+1 UPTO plot param no REP + lower bound (i) := "0.0"; + upper bound (i) := "0.0" + PER. + + single scale param : + test bold (27); + enter plot param. + + enter plot param : + TEXT VAR param := sym; + test subscript (param, 22); + plot param no INCR 1; + IF plot param no > 10 + THEN err (64); + LEAVE generate init scale + FI; + plot name (plot param no) := param; + scalepointer (plot param no) := scalecounter; + set id; + set scale. + + set id : + IF sym = "=" + THEN next sym; + id (plot param no) := (sym SUB 1); + next sym + ELSE id (plot param no) := text (plot param no - 1) + FI. + + set scale : + IF sym = "(" + THEN get plot scale; + fixed scale := TRUE + ELIF NOT fixed scale + THEN l fixed scale (scale counter) := FALSE; + u fixed scale (scale counter) := FALSE; + FI. + + get plot scale : + IF fixed scale + THEN err (28) + FI; + read scale param (lower bound, l fixed scale, 29); + IF sym <> "," + THEN err (30) + FI; + read scale param (upper bound, u fixed scale, 30); + test closing bracket (sym); + next sym. +END PROC generate init scale; + +PROC read scale param (ROW 10 TEXT VAR bound, ROW 10 BOOL VAR fixed scale, + INT CONST err no) : + TEXT VAR scale; + INT VAR tab pos; + next sym; + IF type = bold + THEN test (sym, tab pos, nil, const, 61); + bound (scale counter) := sym; + fixed scale (scale counter) := TRUE + ELIF sym is number (scale) + THEN bound (scale counter) := scale; + fixed scale (scale counter) := TRUE + ELIF sym = "*" + THEN fixed scale (scale counter) := FALSE + ELSE err (err no) + FI; + next sym +END PROC read scale param; + +BOOL PROC sym is number (TEXT VAR constant) : + constant := nt; + IF sym IN "+-" + THEN constant := sym; next sym + FI; + IF type = number + THEN constant CAT sym; + TRUE + ELSE FALSE + FI +END PROC sym is number; + +PROC gen equations (INT CONST equ type) : + INT VAR i; + gen normal equs; + end of init list; + gen index equs. + + gen normal equs : + FOR i FROM tabbeg UPTO tabsize REP + IF is normal equ + THEN generate equ + FI + END REP. + + generate equ : + declare variables (i, equ type, FALSE). + + is normal equ : + CONCR (tab).type (i) = equ type + AND NOT CONCR (tab).rdef (i) AND CONCR (tab).index type (i) <= nil + AND NOT CONCR (tab).already used in loop body(i). + + gen index equs : + FOR i FROM tabbeg UPTO tabsize REP + IF is index equ + THEN gen loop (i, equ type) + FI + END REP. + + is index equ : + CONCR (tab).type (i) = equ type AND + NOT CONCR (tab).rdef (i) AND CONCR (tab).index type (i) > nil + AND NOT CONCR (tab).already used in loop body(i). + +END PROC gen equations; + +PROC gen loop (INT CONST i, equ type) : + for index := CONCR (tab).index (i); + TEXT VAR gen buf; + SELECT CONCR (tab).index type (i) OF + CASE bold : gen for loop + CASE number : generate replace + END SELECT. + + generate replace : + INT VAR k := i; + expression (equ type, gen buf, k); + gen replace (gen buf, k, text (for index)). + + gen for loop : + gen (" FOR ", CONCR (tab).name (for index), " FROM ", + CONCR (tab).init (for index)); + genln (" UPTO ", CONCR (tab).right part (for index), " REP"); + in loop := TRUE; + IF equ type = sub init + THEN gen replace (equ type, i) + ELSE search equal indices + FI; + in loop := FALSE; + genln (" PER;"). + + search equal indices : + INT VAR j; + FOR j FROM i UPTO tab size REP + IF is same index + THEN gen replace (equ type, j); + CONCR (tab).already used in loop body(j):=TRUE + FI + END REP. + + is same index : + for index = CONCR (tab).index (j) + AND CONCR (tab).index type (j) = bold + AND CONCR (tab).type (j) = CONCR (tab).type (i) + AND NOT CONCR (tab).rdef (j) + AND NOT CONCR (tab).already used in loop body(j). + +END PROC gen loop; + +PROC gen replace (TEXT VAR gen buf, INT CONST table index) : + gen replace (gen buf, table index, CONCR (tab).name (for index)) +END PROC gen replace; + +PROC gen replace (TEXT VAR gen buf, INT CONST table index, TEXT CONST index): + gen (" replace (", CONCR (tab).name (table index), ", ", index); + genln (", ", gen buf, ");") +END PROC gen replace; + +PROC gen replace (INT CONST equ type, tabpos) : + INT VAR no := tab pos; + TEXT VAR gen buf; + expression (equ type, gen buf, no); + gen replace (gen buf, no) +END PROC gen replace; + +PROC generate for variables : + is first := TRUE; + FOR i FROM tab beg UPTO tab size REP + IF CONCR (tab).type (i) = for + THEN gen for var + FI + END REP; + end of init list. + + gen for var : + set line no (i); + IF is first + THEN gen ("INT VAR "); + is first := FALSE + ELSE continue init list + FI; + gen (CONCR (tab).name (i)). +END PROC generate for variables; + +PROC generate variable part : + generate constants; + generate variables; + generate missed inits. + + generate constants : + INT VAR i; + FOR i FROM tab beg UPTO tabsize REP + IF CONCR (tab).type (i) = const AND NOT CONCR (tab).idef (i) + THEN gen const + FI + END REP. + + generate variables : + FOR i FROM tab beg UPTO tab size REP + SELECT CONCR (tab).type (i) OF + CASE level, aux, nequ, rate : gen normal equ + END SELECT + END REP. + + generate missed inits : + FOR i FROM tab beg UPTO tab size REP + SELECT CONCR (tab).type (i) OF + CASE aux, rate : gen missed init + END SELECT; + END REP; + end of init list. + + gen missed init : + IF sub init necessary + THEN declare variables (i, sub init, TRUE) + FI. + + sub init necessary : + CONCR (tab).init (i) = nt AND + NOT CONCR (tab).idef (i) AND CONCR (tab).index type (i) <= nil. + + gen normal equ : + IF equ not yet declared + THEN declare variables (i, nequ, TRUE) + FI. + + equ not yet declared : + NOT CONCR (tab).idef (i) AND CONCR (tab).init (i) <> nt + AND CONCR (tab).index type (i) <= nil. + + gen const : + gen linefeed; + gen (" "); + gen zz (i); + gen (CONCR (tab).name (i), " := ", "constant (""", CONCR (tab).name (i)); + gen (""", ", CONCR (tab).right part (i), ")"). +END PROC generate variable part; + +PROC end of init list : + IF NOT is first + THEN is first := TRUE; + genln (";") + FI +END PROC end of init list; + +PROC gen zz (INT CONST no) : + IF CONCR (tab).mac (no) > nil + THEN gen ("zz", CONCR(tab).name (CONCR(tab).mac (no)), text (expansion no)) + FI +END PROC gen zz; + +PROC declare variables (INT CONST no, equ type, BOOL CONST is init) : + INT VAR mac no := CONCR (tab).mac (no); + IF mac no > nil + THEN gen local equs + ELSE declare variable (no, equ type, is init) + FI. + + gen local equs : + INT VAR no of expansions := CONCR (tab).indextype (mac no); + FOR expansion no FROM 1 UPTO no of expansions REP + declare variable (no, equ type, is init) + END REP. +END PROC declare variables; + +PROC declare variable (INT CONST no, exp type, BOOL CONST init) : + TEXT VAR gen buf; + INT VAR i := no; + IF (init AND NOT CONCR (tab).idef (no)) OR + (NOT init AND NOT CONCR (tab).rdef (no)) + THEN gen equ + FI. + +gen equ : + expression (exp type, gen buf, i); + IF init + THEN gen linefeed + FI; + gen (" "); + gen zz (i); + gen (CONCR (tab).name (i), " := ", gen buf); + IF NOT init + THEN genln (";") + FI +END PROC declare variable; + +PROC gen linefeed : + IF is first + THEN is first := FALSE; + gen ("REAL VAR ") + ELSE continue init list + FI +END PROC gen linefeed; + +PROC set line no (INT CONST index) : + line no := CONCR (tab).line no (index); + cout (line no) +END PROC set line no; + +PROC continue init list : + genln (","); gen (" "); +END PROC continue init list; + +PROC gen tab var : + IF is first + THEN gen ("TAB VAR "); is first := FALSE + ELSE continue init list + FI +END PROC gen tab var; + +PROC generate table part : + is first := TRUE; + FOR i FROM tabbeg UPTO tabsize REP + SELECT CONCR (tab).type (i) OF + CASE table : gen tab declaration; + gen tab init + CASE aux, rate, level : IF CONCR (tab).index type (i) = bold + THEN + IF CONCR(tab).type(i)=aux THEN + IF NOT CONCR(tab).should declare vector(i) + THEN + find maximum index for current variable + FI; + IF CONCR(tab).should declare vector(i) + THEN + gen row init + FI + ELSE + gen row init + FI (*18.5.88 dc*) + FI + END SELECT + END REP; + end of init list. + +gen tab declaration : + gen tab var; + gen (CONCR (tab).name (i), " := vector (", vec length); + genln (");"); + is first := TRUE. + +gen tab init : + INT VAR elem no := 1; + scan (CONCR (tab).right part (i)); next sym; + set line no (i); + WHILE type is number REP + gen ("replace (", CONCR (tab).name (i), ", ", text (elem no)); + genln (", ", constant, ");"); + next sym; + elem no INCR 1 + UNTIL end of constant list END REP. + + type is number : + IF sym is number (constant) + THEN TRUE + ELSE err (40); FALSE + FI. + + end of constant list : + test delimiter. + + vec length : + INT VAR p, l := 1; + FOR p FROM 2 UPTO length (CONCR (tab).right part (i)) REP + IF (CONCR (tab).right part (i) SUB p) IN ",/" + THEN l INCR 1 + FI + PER; text (l). + + gen row init : + gen tab var; + gen (CONCR (tab).name (i), " := vector (", row length, ")"). + + row length : + set line no (i); + CONCR (tab).right part (CONCR (tab).index (i)). + + find maximum index for current variable: + INT VAR maximum, place, k; + TEXT VAR name::CONCR(tab).name(i); + maximum:=int(CONCR(tab).right part(CONCR(tab).index(i))); + place:=i; + FOR k FROM tabbeg UPTO tabsize REPEAT + check maximum of index and change if needed; + CONCR(tab).should declare vector(k):=FALSE + PER; + CONCR(tab).should declare vector(place):=TRUE. + +check maximum of index and change if needed: + IF same variable CAND need to change + THEN + maximum:=int(CONCR(tab).right part(CONCR(tab).index(k))); + place:=k + FI. + +need to change: + maximum < int(CONCR(tab).right part(CONCR(tab).index(k))). + +same variable: + name =CONCR(tab).name(k) CAND CONCR(tab).index type(k) = 1. + + +END PROC generate table part; + +BOOL PROC test delimiter : + SELECT pos ("/, EOL", sym) OF + CASE 1, 2 : next sym; FALSE + CASE 3, 4 : TRUE + OTHERWISE : err (62); TRUE + END SELECT +END PROC test delimiter; + +PROC generate table init : + INT VAR i, tab pos; + FOR i FROM tabbeg UPTO tabsize REP + IF CONCR (tab).index type (i) > nil AND NOT CONCR (tab).idef (i) + THEN gen tab init + FI + END REP. + + gen tab init : + SELECT CONCR (tab).type (i) OF + CASE nequ : gen loop (i, nequ) + CASE aux, rate : gen missed table init + CASE mac name : CONCR (tab).line no (i) := nil + END SELECT. + + gen missed table init : + search (CONCR (tab).name (i), tab pos, nil, nequ); + IF not found + THEN gen loop (i, sub init) + FI. +END PROC generate table init; + +PROC sort equ (INT CONST tab pos, equ type) : + IF in loop + THEN gen replace (equ type, tab pos) + ELSE declare variable (tab pos, equ type, equ type = nequ OR + equ type = sub init) + FI +END PROC sort equ; + +PROC expression (INT CONST equtype, TEXT VAR gen buf, INT VAR no) : + TEXT VAR symbol, buf := equation; + INT VAR spos := 1, stype, tabpos; + gen buf := nt; + set line no (no); + test global equ; + compile equ; + IF CONCR (tab).mac (no) = nil + COR expansion no >= CONCR (tab).index type (CONCR (tab).mac (no)) + THEN set def flag + FI. + + test global equ : + IF CONCR (tab).index type (no) < nil + THEN replace global mac param + FI. + + replace global mac param : + INT CONST param index := CONCR (tab).index (no); + search (actual parameter (CONCR (tab).rightpart (paramindex)), + tabpos, nil, nil); + no := tabpos; + expression (type of param, gen buf, no); + LEAVE expression. + + type of param : + IF equ type = sub init + THEN CONCR (tab).type (no) + ELSE equ type + FI. + + compile equ : + IF CONCR (tab).in use (no) + THEN err (CONCR (tab).name (no), 43) + ELSE pass expression + FI. + + pass expression : + CONCR (tab).in use (no) := TRUE; + expression2 (equtype, no, spos, stype, genbuf, symbol, buf); + CONCR (tab).in use (no) := FALSE. + + equation : + IF equtype = nequ + THEN CONCR (tab).init (no) + ELSE CONCR (tab).right part (no) + FI. + + set def flag : + SELECT equtype OF + CASE nequ, sub init : CONCR (tab).idef (no) := TRUE + CASE level : test level + OTHERWISE : CONCR (tab).rdef (no) := TRUE + END SELECT. + + test level : + IF CONCR (tab).init (no) = nt AND CONCR (tab).index type (no) = nil + THEN err (CONCR (tab).name (no), 39) + FI. +END PROC expression; + +PROC expression2 (INT CONST equtype, no, INT VAR spos, stype, + TEXT VAR gen buf, symbol, buf) : + next sym (buf, symbol, stype, spos); + REP + factor (equtype, no, spos, gen buf, buf, symbol, stype) + UNTIL is no operator END REP. + + is no operator : + IF symbol IN "+-*/" + THEN gen buf CAT symbol; + next sym (buf, symbol, stype, spos); + process obelix; + FALSE + ELSE TRUE + FI. + + process obelix : + IF symbol = "*" + THEN gen buf CAT symbol; + next sym (buf, symbol, stype, spos) + FI. +END PROC expression2; + +TEXT PROC actual parameter (TEXT CONST params) : + INT VAR position := nil, old position; + FOR i FROM 1 UPTO expansion no REP + old position := position; + position := pos (params, "%", position + 1) + END REP; + subtext (params, old position + 1, position - 1). +END PROC actual parameter; + +PROC factor (INT CONST equtype, no, INT VAR spos, TEXT VAR genbuf, + buf, symbol, INT VAR stype) : + BOOL VAR dollar := symbol = "$"; + INT VAR tab pos, mac num := CONCR (tab).mac (no); + IF dollar + THEN next sym (buf, symbol, stype, spos) + FI; + SELECT stype OF + CASE number : process number + CASE bold : process quantity + CASE delimiter : process delimiter + OTHERWISE : err (symbol, 44) + END SELECT. + + process number : + gen buf CAT symbol; + next sym (buf, symbol, stype, spos). + + process quantity : + TEXT VAR name := symbol, time script; + INT VAR old spos := spos; + next sym (buf, symbol, stype, spos); + IF mac num > nil + THEN search (name, tab pos, mac num, mac param); + IF not found + THEN search (name, tab pos, mac num, nil); + IF not found + THEN search (name, tab pos, nil, nil) + FI + FI + ELSE search (name, tab pos, nil, nil) + FI; + IF is global param + THEN search (name, tab pos, macro number of param, nil) + FI; + IF not found + THEN err (name, 46) + ELSE test type + FI. + + is global param : + not found AND CONCR (tab).index (no) > nil + AND CONCR (tab).index type (no) = nil. + + macro number of param : + CONCR (tab).mac (CONCR (tab).index (no)). + + test type : + INT VAR nop; + BOOL VAR is equ := FALSE; + search table entry; + get time script; + type := CONCR (tab).type (tab pos); + SELECT type OF + CASE std p : std function + CASE table : (* nanu *) + CASE mac param : replace param + CASE mac name : macro expansion + CASE const : constant + OTHERWISE test quantity + END SELECT; + IF symbol = "(" + THEN test index + ELIF is equ + THEN gen buf CAT name + FI. + + search table entry : + IF CONCR (tab).index type (tab pos) > nil AND + CONCR (tab).type (tab pos) = n equ + THEN search correct table; + IF not found + THEN err (name, 46); + LEAVE process quantity + FI + FI. + + search correct table : + not found := TRUE; + WHILE tab pos <> nil CAND table not found REP + tab pos := CONCR (tab).pred (tab pos) + END REP. + + table not found : + not found := NOT (CONCR (tab).name (tab pos) = name + AND not in macro AND type ok); + not found. + + not in macro : + CONCR (tab).mac (tab pos) = nil. + + type ok : + type := CONCR (tab).type (tab pos); + type = aux OR type = rate OR type = level. + + test quantity : + IF CONCR (tab).mac (tab pos) > nil + THEN name := "zz" + CONCR (tab).name (CONCR (tab).mac (tab pos)) + + text (expansion no) + name + FI; + is equ := TRUE; + SELECT equtype OF + CASE nequ : initialization + CASE aux : auxiliary + CASE level : level equation + CASE sub init: substitute init + CASE supp : supplementary + OTHERWISE : rate equation + END SELECT. + + get time script : + time script := nt; + IF symbol = "." + THEN next sym (buf, time script, stype, spos); + next sym (buf, symbol, stype, spos) + FI; + BOOL VAR is any := time script = any. + + replace param : + buf := text (buf, old spos - 2) + + actual param + subtext (buf, spos - 1); + spos := old spos - 1; + next sym (buf, symbol, stype, spos); + factor (equtype, no, spos, genbuf, buf, symbol, stype); + LEAVE factor. + + actual param : + TEXT VAR param := actual parameter (content); + IF param contains time script OR is number + THEN param + ELSE param + "." + any + FI. + + param contains time script : + (param SUB (length (param))) = any. + + is number : + pos ("0123456789", param SUB (length (param))) > 0. + + content : + IF type = nequ AND CONCR (tab).index (no) = nil + THEN CONCR (tab).init (tab pos) + ELSE CONCR (tab).right part (tab pos) + FI. + + test index : + gen buf CAT "("; + gen buf CAT name; + next sym (buf, symbol, stype, spos); + gen buf CAT " SUB "; + SELECT stype OF + CASE number : int index + CASE bold : var index + OTHERWISE : err (symbol, 48) + END SELECT; + test offset; + test closing bracket (symbol); + gen buf CAT symbol; + next sym (buf, symbol, stype, spos). + + test offset : + next sym (buf, symbol, stype, spos); + IF symbol IN "+-" + THEN pass offset + FI. + + pass offset : + gen buf CAT symbol; + next sym (buf, symbol, stype, spos); + gen buf CAT trunc (symbol); + IF stype <> number + THEN err (symbol, 48) + FI; + next sym (buf, symbol, stype, spos). + + int index : +(*IF CONCR (tab).index (no) <> int (symbol) + THEN err (symbol, 48); + message("Starten Sie trotzdem das übersetzte ELAN Programm") FI;*) +(*20.5.88 dc: hier kommt eine falsche Fehlermeldung *) + gen buf CAT trunc (symbol). + + var index : + search (symbol, tab pos, mac num, for); + gen buf CAT symbol; + IF incorrect index + THEN err (symbol, 48) + FI. + + incorrect index : + not found COR CONCR (tab).name (CONCR (tab).index (no)) <> symbol. + + std function : + test open bracket (symbol); + nop := length (CONCR (tab).right part (tab pos)); + gen buf CAT (name + " ("); + IF nop > nil + THEN pass actual params + ELSE next sym (buf, symbol, stype, spos); + test closing bracket (symbol) + FI; + next sym (buf, symbol, stype, spos); + IF act param <> nop + THEN err (symbol, 49) + FI. + + pass actual params : + INT VAR table pos := tab pos, act param := nil; + REP + act param INCR 1; + IF (CONCR (tab).right part (table pos) SUB act param) = "t" + THEN test if param is table + ELSE expression2 (equtype, no, spos, stype, gen buf, symbol, buf) + FI + UNTIL no more params END REP. + + no more params : + gen buf CAT symbol; + SELECT pos (",)", symbol) OF + CASE 1 : FALSE + CASE 2 : TRUE + OTHERWISE : err (symbol, 50); TRUE + END SELECT. + + test if param is table : + next sym (buf, symbol, stype, spos); + IF s type = bold + THEN search (symbol, tab pos, mac num, nil); + IF not found + THEN err (symbol, 51) + ELSE gen table + FI + ELSE err (symbol, 52) + FI. + + gen table : + IF CONCR (tab).type (tab pos) = table + THEN gen buf CAT symbol; + next sym (buf, symbol, stype, spos) + ELIF CONCR (tab).index type (tab pos) > nil + THEN factor (equtype, no, spos, genbuf, buf, symbol, stype) + ELSE err (symbol, 52) + FI. + + macro expansion : + CONCR (tab).line no (tab pos) INCR 1; + gen buf CAT "zz"; + gen buf CAT name; + gen buf CAT text (CONCR (tab).line no (tab pos)); + gen buf CAT name; + get actual parameters. + + get actual parameters : + TEXT VAR char; + test open bracket (symbol); + get macro parameter list; + next sym (buf, symbol, stype, spos). + + get macro parameter list : + REP + get act param + UNTIL end of parameter list END REP. + + end of parameter list : + SELECT pos (",)", char) OF + CASE 1 : FALSE + CASE 2 : TRUE + OTHERWISE : TRUE + END SELECT. + + get act param : + INT VAR brackets := nil; + char := buf SUB spos; + REP + spos INCR 1; + char := buf SUB spos + UNTIL end of param END REP; + spos INCR 1. + + end of param : + IF brackets = nil + THEN char IN ",)" + ELIF char = "(" + THEN brackets INCR 1; + FALSE + ELIF char = ")" + THEN brackets DECR 1; + FALSE + ELSE FALSE + FI. + + constant : + is equ := TRUE; + CONCR (tab).idef (tab pos) := TRUE. + + initialization : + IF time script = nt OR is any + THEN IF NOT CONCR (tab).idef (tab pos) + THEN IF CONCR (tab).init (tab pos) <> nt + THEN sort equ (tab pos, equ type) + ELIF is sub init + THEN sort equ (tab pos, sub init) + ELSE err (symbol, 39) + FI + FI + ELSE err (time script, 56) + FI. + + is sub init : + CONCR (tab).init (tab pos) = nt AND correct type (type). + + auxiliary : + IF time script = aux time script OR is any + THEN IF NOT CONCR (tab).rdef (tab pos) AND type = aux + THEN sort equ (tab pos, equtype) + FI + ELSE err (time script, 57) + FI. + + aux time script : + SELECT type OF + CASE aux, level : "k" + CASE rate : "jk" + OTHERWISE : " " + END SELECT. + + level equation : + IF time script <> level time script AND NOT is any + THEN err (time script, 59) + FI. + + level time script : + SELECT type OF + CASE aux, level : "j" + CASE rate : "jk" + OTHERWISE : " " + END SELECT. + + rate equation : + IF time script <> rate time script AND NOT is any + THEN err (time script, 60) + FI. + + rate time script : + SELECT type OF + CASE aux, level : "k" + CASE rate : "jk" + OTHERWISE : " " + END SELECT. + + supplementary : + IF time script <> supp time script AND NOT is any + THEN err (time script, 57) + FI. + + supp time script : + SELECT type OF + CASE aux, level, supp : "k" + CASE rate : "jk" + OTHERWISE : " " + END SELECT. + + substitute init : + IF NOT CONCR (tab).idef (tab pos) + THEN gen sub init equ + FI. + + gen sub init equ : + IF CONCR (tab).index type (tab pos) > nil + THEN IF CONCR (tab).index type (no) = nil + THEN process index equ + FI + ELIF CONCR (tab).init (tab pos) = nt + THEN IF correct type (type) + THEN sort equ (tab pos, equtype) + FI + ELSE sort equ (tab pos, nequ) + FI. + + process index equ : + INT VAR table type := sub init; + IF type <> nequ + THEN search nequ + FI; + IF NOT CONCR (tab).idef (tab pos) AND correct type (type) + THEN end of init list; + gen loop (tab pos, table type); + CONCR (tab).idef (tab pos) := TRUE + FI. + + search nequ : + search (CONCR (tab).name (tabpos), table pos, nil, nequ); + IF NOT (not found CAND CONCR (tab).idef (tab pos)) + THEN type := nequ; + tab pos := table pos; + table type := type + FI. + + process delimiter : + genbuf CAT symbol; + SELECT pos ("(+-", symbol) OF + CASE 1 : process bracket + CASE 2, 3: process monadic operator + OTHERWISE err (symbol, 44) + END SELECT. + + process bracket : + expression2 (equtype, no, spos, stype, genbuf, symbol, buf); + test closing bracket (symbol); + gen buf CAT symbol; + next sym (buf, symbol, stype, spos); + IF symbol = "(" + THEN gen buf CAT "*"; + factor (equtype, no, spos, gen buf, buf, symbol, stype) + FI. + + process monadic operator : + next sym (buf, symbol, stype, spos); + factor (equtype, no, spos, gen buf, buf, symbol, stype). +END PROC factor; + +BOOL PROC correct type (INT CONST equ type) : + SELECT equ type OF + CASE aux, rate, nequ : TRUE + OTHERWISE : FALSE + END SELECT. +END PROC correct type; + +TEXT PROC draw ad: + IF is draw THEN "b" ELSE "" END IF +END PROC draw ad; + +(*$$$$$$$$$$$$$$$ ZUSATZ Februar 87 C&C geaendert: Ausgabe "dump" $$$$$$$$*) + +(* In dieser Prozedur wird eine Datei 'dump' angelegt, in der alle *) +(* Dynamo-Standardfunktionen, Macros und die programmspezifischen *) +(* Variablen und Konstanten eingetragen werden. *) + +PROC table dump : +IF exists ("dump") +THEN forget("dump",quiet) +FI; +FILE VAR dump := sequential file(output, "dump"); +sysout("dump"); + FOR i FROM 1 UPTO CONCR (tab).tab size REP + put (i); + put ("NAM :"); put (CONCR (tab).name (i)); + put ("RP :"); put (CONCR (tab).right part (i)); + put ("INI :"); put (CONCR (tab).init (i)); + put ("IND :"); put (CONCR (tab).index (i)); + put ("IT :"); put (CONCR (tab).index type (i)); + put ("TYP :"); put (CONCR (tab).type (i)); + line; + END REP; +sysout("") +END PROC table dump +(*$$$$$$$$$$$$$$$$$$$$ ENDE ZUSATZ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$*) +END PACKET dynamo compiler 33 + diff --git a/lang/dynamo/1.8.7/src/dyn.abnahme b/lang/dynamo/1.8.7/src/dyn.abnahme new file mode 100644 index 0000000..e8c100d --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.abnahme @@ -0,0 +1,19 @@ +NOTE +NOTE Ein einfaches Modell der Bevoelkerungsentwicklung +NOTE +L BEVOELKERUNG.K=BEVOELKERUNG.J+DT*(GEBURTENRATE.JK-STERBERATE.JK) +N BEVOELKERUNG=1000 +R GEBURTENRATE.KL=BEVOELKERUNG.K*WACHSTUMSFAKTOR +N GEBURTENRATE=10 +C WACHSTUMSFAKTOR=0.01 das heisst: 1 Prozent +R STERBERATE.KL=BEVOELKERUNG.K*STERBEFAKTOR +C STERBEFAKTOR=0.001 das heisst: 1 Promille +N STERBERATE=10 +NOTE +NOTE Simulationsparameter +NOTE +PLOT BEVOELKERUNG=B(0,2000)/GEBURTENRATE=G(0,40)/STERBERATE=S(0,6) +C DT=1 +C PLTPER=1 +C LENGTH=68 + diff --git a/lang/dynamo/1.8.7/src/dyn.bev b/lang/dynamo/1.8.7/src/dyn.bev new file mode 100644 index 0000000..5b759d3 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.bev @@ -0,0 +1,50 @@ +NOTE EIN BEVÖLKERUNGSMODELL DER BUNDESREPUBLIK DEUTSCHLAND +NOTE +NOTE ANGABEN DER GEBURTENRATEN (GR) UND STERBEQUOTIENTEN (SQ) +NOTE AUS DEM STATISTISCHEN JAHRBUCH 1982 +NOTE +FOR LJ=1,80 LEBENSJAHRE +FOR LJ2=2,80 +L BEV.K(1)=BEV.J(1)+DT*(GB.J-A.J(1)-S.J(1)) BABIES +L BEV.K(LJ2)=BEV.J(LJ2)+DT*(A.J(LJ2-1)-A.J(LJ2)-S.J(LJ2)) BEVÖLKERUNG +A A.K(LJ)=(1-SQ(LJ))*BEV.K(LJ) +A S.K(LJ)=SQ(LJ)*BEV.K(LJ) +A GB.K=SCLPRD(BEV.K,15,44,GR,1)/2 Geburten +A GBEV.K=SUM(BEV.K) Gesamtbevölkerung +A ZBEV.K=SUMV(BEV.K,16,59) zahlende Bevölkerung (in Rentenversicherung) +A PRENT.K=SUMV(BEV.K,60,80) potentielle Rentner +NOTE +N BEV(LJ)=IBEV(LJ)*1E3 +T IBEV= +X 584/585/590/609/652/728/780/843/927/980/ +X 1014/1032/1045/1049/1024/1003/986/959/929/903/ +X 884/857/850/845/841/844/854/872/854/810/ +X 756/676/722/826/829/905/1029/1062/1026/968/ +X 934/919/884/783/711/725/763/784/784/768/ +X 742/744/724/700/716/751/765/673/488/385/ +X 397/479/613/690/698/681/664/666/654/630/ +X 603/573/546/510/476/445/402/359/320/1681 +NOTE +T SQ= +X .01965/.00123/.00082/.00082/.00082/.00055/.00055/.00055/.00055/.00055/ +X .00033/.00033/.00033/.00033/.00033/.00064/.00064/.00064/.00064/.00064/ +X .00183/.00183/.00183/.00183/.00183/.00131/.00131/.00131/.00131/.00131/ +X .00152/.00152/.00152/.00152/.00152/.00193/.00193/.00193/.00193/.00193/ +X .00302/.00302/.00302/.00302/.00302/.00497/.00497/.00497/.00497/.00497/ +X .00750/.00750/.00750/.00750/.00750/.01220/.01220/.01220/.01220/.01220/ +X .01868/.01868/.01868/.01868/.01868/.03146/.03146/.03146/.03146/.03146/ +X .05206/.05206/.05206/.05206/.05206/.08241/.08241/.08241/.08241/.175 +NOTE +T GR= +X .0008/.0041/.0138/.0274/.0453/.0597/.0745/.0861/.0933/.1025/ +X .1067/.1074/.1050/.0963/.0872/.0753/.0642/.0531/.0430/.0360/ +X .0297/.0225/.0184/.0144/.0114/.0087/.0063/.0044/.0031/.0020 +NOTE +C DT=1 +C PLTPER=1 +C PRTPER=1 +N TIME=1982 +C LENGTH=2000 +NOTE PRINT GB,A(1),S(1),BEV(1),BEV(2),GR(1),GR(15),GR(30) +PRINT GBEV,BEV(1),BEV(40),BEV(60),BEV(63),BEV(65),ZBEV,PRENT + diff --git a/lang/dynamo/1.8.7/src/dyn.cob b/lang/dynamo/1.8.7/src/dyn.cob new file mode 100644 index 0000000..eabb1b8 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.cob @@ -0,0 +1,19 @@ +NOTE COBWEB MODEL 27.11.81 +L PREIS.K=PREIS.J+(DT)*K*(NACHFR.J-ANGEBOT.J) +L ANGEBOT.K=A+B*PREIS.J +A NACHFR.K=C-D*PREIS.K +NOTE B>0, D>0, K>0 +N PREIS=0 +N ANGEBOT=11 +C K=1 +C A=1. +C B=.9 +C C=12.4 +C D=1.2 +C DT=.1 +C LENGTH=10 +C PRTPER=.1 +C PLTPER=.1 +PLOT PREIS=P/NACHFR=N(1,10)/ANGEBOT=A +PRINT PREIS,ANGEBOT,NACHFR + diff --git a/lang/dynamo/1.8.7/src/dyn.const b/lang/dynamo/1.8.7/src/dyn.const Binary files differnew file mode 100644 index 0000000..c42ad1c --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.const diff --git a/lang/dynamo/1.8.7/src/dyn.delaytest b/lang/dynamo/1.8.7/src/dyn.delaytest new file mode 100644 index 0000000..c475433 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.delaytest @@ -0,0 +1,8 @@ +NOTE GOODMAN S.248 +A Y.K=DELAY3(X,D) +C D=50 +R X.KL=TABLE(XT,TIME.K,0,125,25) +T XT=0/10/0/-10/0/10 +PLOT X=X,Y=Y(-10,10) +SPEC DT=0.5,LENGTH=125,PLTPER=2 + diff --git a/lang/dynamo/1.8.7/src/dyn.errors b/lang/dynamo/1.8.7/src/dyn.errors new file mode 100644 index 0000000..64a4f27 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.errors @@ -0,0 +1,68 @@ +gleichung doppelt definiert +doppelte initialisierung +falscher zeilentyp +verschachtelte makro-definition +makro-name erwartet +'(' erwartet +formaler parameter erwartet +')' nach parameterliste erwartet +bei auxiliaries nur subskription mit '.k' erlaubt +bei konstanten-definition name erwartet +bei levels nur subskription mit '.k' erlaubt +bei rates nur subskription mit '.kl' erlaubt +bei table-definition keine subskription erlaubt +x - befehl hier nicht erlaubt +bei for-definition name erwartet +'=' nach for-variable erwartet +bereichsangabe erwartet +',' erwartet +lokale gleichung nur in makro erlaubt +bei definition name erwartet +'=' erwartet +index nicht korrekt +')' nach indizierung erwartet +prtper nicht definiert +pltper nicht definiert +'/' oder ',' bei plot erwartet +name als plotparameter erwartet +doppelte scale-angabe in einer gruppe +erste scale-angabe erwartet +zweite scale-angabe erwartet +')' nach scale-angabe erwartet +printparameter nicht definiert +printparameter erwartet +time darf nur initialisiert werden +dt nicht definiert +length nicht definiert +bei konstanten-definition zahl erwartet +bei initialisierung konstante erwartet +levels muessen initialisiert werden +konstante bei table erwartet +'/' oder ',' erwartet +table-definition ohne benutzung +simultane gleichungen +faktor erwartet +time muss mit '.j' oder '.k' subskribiert werden +symbol nicht definiert +funktion nicht definiert +unzulaessige indizierung +falsche parameteranzahl +falsches trennsymbol zwischen parametern +als parameter table erwartet +falscher parameter in tablefunktion +zuviele aktuelle parameter +')' nach makroaufruf fehlt +rekursiver makroaufruf +bei n-gleichung keine subskription erwartet +falsche subskription in auxiliary-gleichung +')' erwartet +falsche subskription in level-gleichung +falsche subskription in rate-gleichung +for-variable nicht definiert +konstante erwartet +falsches real-format +zu viele plot-parameter +bei run-befehl dateiname erwartet +als noise-parameter zahl erwartet +plot- und draw-Anweiungen dürfen im Programm nicht gemischt werden + diff --git a/lang/dynamo/1.8.7/src/dyn.forest b/lang/dynamo/1.8.7/src/dyn.forest new file mode 100644 index 0000000..5075925 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.forest @@ -0,0 +1,47 @@ +NOTE 23.04.1985 english version 22.11.1985 +note forest management model +note +note wood standing within the forest +l wood.k=wood.j+dt*(woodgrowth.jk-harvest.jk) +n wood=startingwood +c startingwood=15000 m**3 +r woodgrowth.kl=wood.k*stocksfactor*cultivationfactor.k +c stocksfactor=0.04 growth in % of wood +a cultivationfactor.k=tabhl(tclfactor,clstate.k,0,1,0.1) +t tclfactor=0/.1/.2/.3/.4/.5/.7/.95/1/1.05/1.2 +r harvest.kl=wood.k*harvestpercent.k*0.1 +a harvestpercent.k=tabhl(tharvestpercent,ratio1.k,0.8,1.2,0.1) +t tharvestpercent=0.1/0.3/0.35/0.4/0.6 +a ratio1.k=wood.k/maxstock +c maxstock=16000 +note +note resources +l resources.k=resources.j+dt*(income.jk-clexpense.jk-draw.jk) +n resources=startresources +c startresources=100000 money units +r income.kl=wood.k*harvestpercent.k*0.1*price +c price=190 money units per cubic m +r clexpense.kl=resources.k-constdraw +r draw.kl=constdraw +c constdraw=20000 +note +note cultivationstate (clstate; dimensionless ) +l clstate.k=clstate.j+dt*(clbetter.jk-clworse.jk) +n clstate=startclstate +c startclstate=0.8 +r clbetter.kl=clbetterfactor.k*(1-clstate.k) +a clbetterfactor.k=tabhl(tclbetter,cultivationcost.k,80000,180000,100000) +t tclbetter=0.0/0.1 +a cultivationcost.k=resources.k-constdraw +r clworse.kl=clworsefactor.k*clstate.k +a clworsefactor.k=tabhl(tclworse,cultivationcost.k,0,80000,80000) +t tclworse=0.2/0 +note +note +print wood,resources,clstate +plot wood=w/resources=r/clstate=c(0,1) +c dt=1 +c length=50 +c prtper=1 +c pltper=1 + diff --git a/lang/dynamo/1.8.7/src/dyn.forst7 b/lang/dynamo/1.8.7/src/dyn.forst7 new file mode 100644 index 0000000..d767a50 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.forst7 @@ -0,0 +1,76 @@ +#papersize(20.5,61.0)# +#pagelength(59.0)# +#type("picac")# +NOTE 25.04.1985 14.30 +note forstbetriebsmodell +note +note stehender Holzvorrat +l holz.k=holz.j+dt*(zuwachs.jk-ernte.jk) +n holz=startholz +c startholz=15000 Angabe in Festmetern(fm) +r zuwachs.kl=holz.k*vorratsfaktor*pflegefaktor.k +c vorratsfaktor=0.035 Zuwachs in % von holz +a pflegefaktor.k=tabhl(tpffaktor,pfzustand.k,0,1,0.1) +t tpffaktor=.7/.7/.7/.7/.7/.8/.9/.95/1/1.05/1.2 +r ernte.kl=ernte1.k +a ernte1.k=holz.k*ernteproz.k*ernteprozfak.k +a ernteproz.k=tabhl(ternproz,ratio1.k,0.5,1.2,0.1) +t ternproz=0.02/0.025/0.03/0.03/0.03/0.035/0.06/0.08 +a ratio1.k=holz.k/maxvorrat +c maxvorrat=16000 +note +note resourcen +l resourcen.k=resourcen.j+dt*(einnahme.jk-eig.jk-pfausgaben.jk) +n resourcen=startresourcen +c startresourcen=100000 Geldeinheiten +c preis=190 Geldeinheiten pro fm +r einnahme.kl=ernte1.k*preis +r pfausgaben.kl=resourcen.k-eigenent.k +r eig.kl=eigenent.k +a anpassungsfaktor.k=tabhl(tanpass,ratio2.k,0.5,1.5,0.1) +t tanpass=.5/.55/.6/.7/.9/1/1/1/1.1/1.2/1.3 +l eigenent.k=min(eigenent.j*anpass.jk,resourcen.j) +r anpass.kl=anpassungsfaktor.k +n eigenent=eigenentstart +c eigenentstart=20000 +note +note arbeitseinheiten +note +l arbeit.k=arbeit.j+dt*(pfausgaben.jk/preisae-arbeitsverbrauch.jk) +n arbeit=startarbeit +c startarbeit=800 +c preisae=100 ( preis pro arbeitseinheit in geldeinheiten ) +r arbeitsverbrauch.kl=min(arbeit.k,notwarbeit.k) +a notwarbeit.k=tabhl(tnotwarb,pfzustand.k,0.0,1.0,0.1) +t tnotwarb=1600/1550/1500/1450/1400/1300/1150/950/800/700/600 +a ratio2.k=arbeit.k/notwarbeit.k +a ernteprozfak.k=tabhl(ternteprozfak,ratio2.k,0.2,1.6,0.2) +t ternteprozfak=.4/.5/1/2/1.05/1/.9/.7 +note +note Pflegezustand (pfzustand; dimensionslose Größe) +l pfzustand.k=pfzustand.j+dt*(pfverbess.jk-pfversch.jk) +n pfzustand=startpfzustand +c startpfzustand=0.8 +r pfverbess.kl=smooth(pfx1.k,pfverzoeg) +a pfx1.k=pfverbfaktor.k*(1-pfzustand.k) +a pfverbfaktor.k=tabhl(tpfverb,ratio2.k,.8,1.4,.2) +t tpfverb=0/0/.1/0.2 +r pfversch.kl=smooth(pfverschfaktor.k*pfzustand.k,pfverzoeg) +c pfverzoeg=2 +a pfverschfaktor.k=tabhl(tpfversch,ratio2.k,0,.8,.2) +t tpfversch=.4/.2/.1/.05/0 +note +note +note print ratio1,ratio2,eigenent,arbeit,pfzustand +plot holz=h(1e4,2e4)/eigenent=e(0,2e5)/pfzustand=P(0,1)/ratio2=2(0,5) +c dt=1 +c length=50 +note prtper=1 +c pltper=1 +run dyn.forst7 + + + + + + diff --git a/lang/dynamo/1.8.7/src/dyn.gekoppeltependel b/lang/dynamo/1.8.7/src/dyn.gekoppeltependel new file mode 100644 index 0000000..3f2a961 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.gekoppeltependel @@ -0,0 +1,19 @@ +NOTE gekoppelte pendel +L x1.k=x1.j+dt*v1.j +L x2.k=x2.j+dt*v2.j +L v1.k=v1.j+dt*(-d0/m1*x1.j-(d/m1)*(x1.j-x2.j)) +L v2.k=v2.j+dt*(-d0/m2*x2.j-(d/m2)*(x2.j-x1.j)) +N x1=a +N x2=0 +N v1=0 +N v2=0 +C a=3 +C m1=2 +C m2=2 +C d0=9 +C d=2 +C dt=0.1 +C length=50 +C pltper=0.3 +PLOT x1=1(-3,9)/x2=2(-9,3) + diff --git a/lang/dynamo/1.8.7/src/dyn.grashasenfuchs b/lang/dynamo/1.8.7/src/dyn.grashasenfuchs new file mode 100644 index 0000000..046a1e1 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.grashasenfuchs @@ -0,0 +1,42 @@ +NOTE +NOTE Raeuber-Beute-Beziehung nach VOLTERRA am Beispiel Fuchs-Hase +NOTE Aenderung: mit FUTTER und CLIP-Funktion +L GRAS.K=CLIP(GRAS.J+DT*(WACHSR.JK-FRESSR.JK),0,GRAS.J,0) +L HASEN.K=CLIP(HASEN.J+DT*(HGRATE.JK-HSRATE.JK),0,HASEN.J,0) +L FUECHS.K=CLIP(FUECHS.J+DT*(FGRATE.JK-FSRATE.JK),0,FUECHS.J,0) +R WACHSR.KL=(GPROZ/100)*GRAS.K GPROZ Wachstumsprozente +R FRESSR.KL=GFRESS*HASEN.K*GRAS.K GFRESS in: pro Hasen +R HGRATE.KL=HGK*HASEN.K*GRAS.K +R HSRATE.KL=TREFF*HASEN.K*FUECHS.K+HSTIRB*HASEN.K +R FGRATE.KL=FGK*HASEN.K*FUECHS.K +R FSRATE.KL=FSK*FUECHS.K +NOTE +NOTE Gleichgewichtsbedingungen: +NOTE HASEN=GPROZ/(100*Gfress) +NOTE +NOTE Hasengeburtenkoeffizient*GRAS=Trefferwahrscheinlichkeit*Fuechse +NOTE +Hstirb +NOTE Fuechsesterbekoeffizient=Fuechsegeburtenkoeffizient*Hasen +NOTE +N GRAS=IG +N HASEN=IH +N FUECHS=IF +C GPROZ=3 Graswachstum 3% +C GFRESS=3E-4 (Grasfressanteil) pro Hasen +C HGK=1E-3 Hasengeburtskoeff +C TREFF=4E-2 Trefferwahrscheinlichkeit +C HSTIRB=0.001 Hasensterbekoeffizient (ohne Fuechse) +C FGK=0.05 Fuechsegeburtenkoeffizient +C FSK=5 Fuechsesterbekoeffizient +C IG=1E+3 +C IH=110 +C IF=25 +NOTE +NOTE SIMULATIONSPARAMETER +NOTE +C DT=0.083 +C PLTPER=.083 monatlich, 0.083=1/12 ! +C LENGTH=5 +PLOT GRAS=G(995,1005)/HASEN=H(85,115)/FUECHS=F(15,35) + + diff --git a/lang/dynamo/1.8.7/src/dyn.help b/lang/dynamo/1.8.7/src/dyn.help new file mode 100644 index 0000000..e4f82c0 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.help @@ -0,0 +1,24 @@ + Im Dynamo Runtime-System stehen folgende Kommandos + zur Verfügung (Verlassen dieser Erklärung mit <ESC> q) : + + run ...................... Ausführen des übersetzten Programms + + c <Konstantenname>=Wert .. Änderung einer oder mehrerer Konstanten + + ? ........................ Anzeige der Konstanten und ihrer Werte + + quit ..................... Verlassen des Runtime-Systems + + help ..................... Zeigt diese Erklärungen + + + Bei PRINT oder PLOT - Ausgaben sind folgende Kommandos möglich : + + + ....................... Nächster Bildschirm + + o ....................... (Off), keine Unterbrechung der Ausgabe + + e ....................... (End), Zurück zum Runtime-System + + <ESC> .................... Abbruch der Ausgabe + diff --git a/lang/dynamo/1.8.7/src/dyn.inserter b/lang/dynamo/1.8.7/src/dyn.inserter new file mode 100644 index 0000000..4b0b9d5 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.inserter @@ -0,0 +1,54 @@ +put line ("DYNAMO 3.3+ wird generiert"); +line; +WHILE noch nicht alle dateien da REPEAT (* Christian Szymanski *) + hole dateien vom archiv (* 10.08.88 *) +END REPEAT; +putline ("Die Pakete werden insertiert."); +putline ("Bitte warten !"); +checkoff; +IF id(0) < 182 + THEN insert ("dyn.kleiner182") +FI ; +insert ("dyn.tool"); +insert ("dyn.33"); +insert ("dyn.vec"); +insert ("dyn.proc"); +insert ("dyn.rts"); +insert ("dyn.plot+"); +insert ("dyn.plot"); +insert ("dyn.print"); +command dialogue (TRUE); +do ("init errors (""dyn.errors"")"); +do ("init std (""dyn.std"")"); +do ("insert macro (""dyn.mac"")"); +do ("graphic (yes (""mit CGA-Grafik""))"); +putline ("dynamo-system generiert"); +check on. + +noch nicht alle dateien da: + THESAURUS VAR alle dateien := empty thesaurus; + IF id(0) < 182 THEN + insert (alle dateien,"dyn.kleiner182") + FI ; + insert (alle dateien, "dyn.tool"); + insert (alle dateien, "dyn.33"); + insert (alle dateien, "dyn.vec"); + insert (alle dateien, "dyn.proc"); + insert (alle dateien, "dyn.rts"); + insert (alle dateien, "dyn.plot+"); + insert (alle dateien, "dyn.plot"); + insert (alle dateien, "dyn.print"); + highest entry (alle dateien - all) > 0 . + +hole dateien vom archiv: + IF yes ("DYNAMO-Diskette eingelegt") THEN + archive ("dynamo"); + fetch (ALL archive - all, archive); + release (archive) + FI. + + + + + + diff --git a/lang/dynamo/1.8.7/src/dyn.mac b/lang/dynamo/1.8.7/src/dyn.mac new file mode 100644 index 0000000..03a0f9f --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.mac @@ -0,0 +1,44 @@ +macro delay1(in,del) +a delay1.k=$lv.k/del +l $lv.k=$lv.j+dt*(in.jk-delay1.j) +n $lv=del*in +mend +macro delay3(in,del) +a $dl.k=del/3 +l $lv3.k=$lv3.j+dt*($rt2.jk-delay3.j) +n $lv3=$dl*in +r $rt2.kl=$lv2.k/$dl.k +l $lv2.k=$lv2.j+dt*($rt1.jk-$rt2.jk) +n $lv2=$lv3 +r $rt1.kl=$lv1.k/$dl.k +l $lv1.k=$lv1.j+dt*(in.jk-$rt1.jk) +n $lv1=$lv3 +a delay3.k=$lv3.k/$dl.k +mend +macro delay3p(in,del,ppl) +a delay3p.k=$lv3.k/$dl.k +l $lv3.k=$lv3.j+dt*($rt2.jk-delay3p.j) +n $lv3=$dl*in +r $rt2.kl=$lv2.k/$dl.k +l $lv2.k=$lv2.j+dt*($rt1.jk-$rt2.jk) +n $lv2=$lv3 +r $rt1.kl=$lv1.k/dl.k +l $lv1.k=$lv1.j+dt*(in.jk-$rt1.jk) +n $lv1=$lv3 +a $dl.k=del/3 +a ppl.k=$lv3.k+$lv2.k+$lv1.k +mend +macro dlinf3(in,del) +l dlinf3.k=dlinf3.j+dt*($lv2.j-dlinf3.j)/$dl.j +n dlinf3=in +l $lv2.k=$lv2.j+dt*($lv1.j-$lv2.j)/$dl.j +n $lv2=in +l $lv1.k=$lv1.j+dt*(in.j-$lv1.j)/$dl.j +n $lv1=in +a $dl.k=del/3 +mend +macro smooth(in,del) +l smooth.k=smooth.j+dt*(in.j-smooth.j)/del +n smooth=in +mend + diff --git a/lang/dynamo/1.8.7/src/dyn.mehreredelays b/lang/dynamo/1.8.7/src/dyn.mehreredelays new file mode 100644 index 0000000..6eac8fe --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.mehreredelays @@ -0,0 +1,9 @@ +NOTE GOODMAN S.248 +A Y.K=DELAY3(X,D) +A Z.K=DELAY3(Y,D) +C D=50 +R X.KL=TABLE(XT,TIME.K,0,125,25) +T XT=0/10/0/-10/0/10 +PLOT X=X,Y=Y,Z=Z(-10,10) +SPEC DT=0.5,LENGTH=125,PLTPER=2 + diff --git a/lang/dynamo/1.8.7/src/dyn.natchez b/lang/dynamo/1.8.7/src/dyn.natchez new file mode 100644 index 0000000..e62c70d --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.natchez @@ -0,0 +1,14 @@ +NOTE Heiratsregeln der NATCHEZ Indianer +L SUN.K=SWITCH(0,SUN.J,STINKARD.J) +L NOBLE.K=SWITCH(0,NOBLE.J+SUN.J,STINKARD.J) +L HONORED.K=SWITCH(0,HONORED.J+NOBLE.J,STINKARD.J) +L STINKARD.K=CLIP(STINKARD.J-NOBLE.J,0,STINKARD.J-NOBLE.J,0) +N SUN=20 +N NOBLE=10 +N HONORED=10 +N STINKARD=3000 +C DT=1 +C LENGTH=17 +C PLTPER=1 +PLOT SUN=*,NOBLE=N,HONORED=H,STINKARD=S + diff --git a/lang/dynamo/1.8.7/src/dyn.oszillator b/lang/dynamo/1.8.7/src/dyn.oszillator new file mode 100644 index 0000000..3f1e815 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.oszillator @@ -0,0 +1,26 @@ +NOTE OSZILLATOR +L X.K=X.J+Y.J*DT +N X=2 +L Y.K=(Y.J+DT*(F/M-X.J*OMEGANULLQUADRAT.J))/(1+GAMMA.J*DT) +N Y=3 +C M=5 +NOTE +NOTE linearer harmonischer Oszillator mit BETA=0 und F=0 +NOTE +NOTE gedaempfter Oszillator mit BETA<>0 und F=0 +NOTE +NOTE allgemeiner Oszillator mit BETA<>0 und F=f(TIME) +C BETA=0.5 +A GAMMA.K=BETA/M +C F=0 +C K=1 +A OMEGANULLQUADRAT.K=K/M +NOTE hier heisst eine Konstante"K". DYNAMO verwechselt das nicht mit .K !! +C DT=0.01 +NOTE DT WIRD EXTRA SO KLEIN GEWAEHLT; DAMIT DIE ANNAEHERUNG GUT IST +NOTE +NOTE DAS GEHT AUF KOSTEN DER RECHENZEITEN !!! +C LENGTH=68 +C PLTPER=1 +PLOT Y + diff --git a/lang/dynamo/1.8.7/src/dyn.plot b/lang/dynamo/1.8.7/src/dyn.plot new file mode 100644 index 0000000..fe1228a --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.plot @@ -0,0 +1,235 @@ +PACKET dynamo plotter (* Änder.: C.Szymanski, 21.07.88 *) + DEFINES b initialize plot, b new plot line, b plot, b end of program, + b plot scale : + +LET maxvalue = 200, + valuepagelength = 18, + max param numb = 10; + +TYPE PLOTPARAM = STRUCT (TEXT name, id, + INT scale pointer, + REAL lower bound, upper bound, + BOOL l fixed scale, u fixed scale); + +ROW max param numb PLOTPARAM VAR plotparam;(* Enth. Plotparameter *) +ROW maxvalue REAL VAR value; (* Ausgabepuffer *) +ROW max param numb ROW 5 REAL VAR scale; (* Enth. errechnete Skalierungen *) + +BOOL VAR plt; +TEXT VAR headline; +REAL VAR pltper, nextplot; +INT VAR value no, param no, plot line no, + plot param no, line no; +INT CONST nil := 0; + +LET line1 = ".____________.____________.____________.____________.", + line2 = ". . . . ."; + +PROC plot one page : + init plot routine; + plot values. + + init plot routine : + print suppressed output; + plot line no := nil. + + plot values : + INT VAR act value := 1, i; + TEXT VAR plot buf; + line; + vdt; + line; + IF b stop request THEN LEAVE plot one page END IF; + sys page; + plot output (headline); + put scales; + WHILE act value < value no REP + put time; + gen line; + FOR i FROM 1 UPTO plot param no REP + plot single value + END REP; + plot output (plot buf + line0 + collision); + plot line no INCR 1; + act value INCR plot param no; + act value INCR 1 + END REP. + + put time : + plot buf := text (text (round (value (act value), 2)), 6). + (* Erstes Pufferelement enthaelt time *) + + gen line : + TEXT VAR line0, collision := ""; + line0 := act line. + + act line : + IF (plot line no MOD 5) = nil (* Prueft, ob gestrichelte oder durch - *) + THEN line1 (* gezogene Linie gedruckt wird *) + ELSE line2 + FI. + + plot single value : + INT VAR position := int ((x-low)*53.0/(up-low))+1; (*Interpolationsformel*) + position := limit; + IF pos ("._ ", line0 SUB position) > nil + THEN replace (line0, position, plotparam (i).id) + ELSE collision CAT plotparam (i).id + FI. + + limit : + IF position > 53 + THEN 53 + ELIF position < 1 + THEN 1 + ELSE position + FI. + + up : + scale (i) (5). (* Oberer Grenzwert (der Skalierung) *) + + low : + scale (i) (1). (* Unterer Grenzwert *) + + x : + value (act value + i). + + put scales : (* Gibt Skalierung der Variablen aus *) + INT VAR j := 1, l, scalecounter; + WHILE j <= plot param no REP + plot buf := " "; + FOR l FROM 1 UPTO 4 REP + plot buf CAT text (text (scale (j) (l)), 13) + END REP; + plot buf CAT text (scale (j) (5)); + scalecounter := plotparam (j).scalepointer; + WHILE scalecounter = plotparam (j).scalepointer REP + plot buf CAT plotparam (j).id; + j INCR 1 + UNTIL j > max param numb END REP; + plot output (plot buf) + END REP. +END PROC plot one page; + +PROC b plot scale (TEXT CONST id, INT CONST scale pointer, + REAL CONST lower bound, upper bound, + BOOL CONST l fixed scale, u fixed scale) : + (* Liest Skalierungen vom Zielprogramm ein *) + plot param no INCR 1; + plot param (plot param no).id := id; (*Variablenname *) + plot param (plot param no).scale pointer := scale pointer;(*Zeiger *) + plot param (plot param no).lower bound := lower bound; (*Obere Grenze *) + plot param (plot param no).upper bound := upper bound; (*Untere Grenze *) + plot param (plot param no).l fixed scale := l fixed scale;(*Fix-Skalierung*) + plot param (plot param no).u fixed scale := u fixed scale; +END PROC b plot scale; + +PROC gen scales : + INT VAR act param, i; (* Generiert Skalierungen fuer eine Seite *) + FOR act param FROM 1 UPTO plot param no REP + compute single scale + END REP. + + compute single scale : + REAL VAR max := plotparam(plot param(act param).scale pointer).upper bound, + min := plotparam(plot param(act param).scale pointer).lower bound; + IF min > max THEN errorstop ("invalid scale") FI; + compute extreme scales; + FOR i FROM 1 UPTO 3 REP + scale (act param) (i+1) := (scale (act param) (5) - scale (act param) (1)) + * real (i) / 4.0 + scale (act param) (1) + (* Interpolationsformel *) + END REP. + + compute extreme scales : + (* Wenn die Skalierungen nicht gegeben sind, muessen sie berechnet werden. + Zur leichteren Lesbarkeit werden die Skalierungen nach oben bzw. unten + um jeweils eine Stelle gerundet *) + scale (act param) (5) := upper limit; + scale (act param) (1) := lower limit. + + upper limit : + IF plot param (plot param (act param).scale pointer).u fixed scale + THEN max + ELSE round (floor (max) + 0.5, 0) + FI. + + lower limit : + IF plot param (plot param (act param).scale pointer).l fixed scale + THEN min + ELSE round (floor (min) - 0.5, 0) + FI. +END PROC gen scales; + +PROC b initialize plot (TEXT CONST h) : + headline := h; + pltper := get pltper; + plot line no := value pagelength; + nextplot := 0.0; + value no := nil; + line no := nil; + plot param no := nil +END PROC b initialize plot; + +PROC b new plot line (REAL CONST time) : + plt := time >= nextplot; + IF plt (* Wird vom Zielprogramm aufgerufen, um *) + THEN add (time); (* Zeilenvorschub durchzufuehren *) + line no INCR 1; + param no := nil + FI; + WHILE time >= nextplot REP (* Ist noetig, weil pltper ungleich dt sein *) + nextplot INCR pltper (* kann *) + END REP +END PROC b new plot line; + +PROC b end of program : (* Druckt am Schluss evt. noch gepufferte *) + IF plot line no = value page length AND NOT stop request (* Werte aus *) + THEN gen scales; + plot one page + FI +END PROC b end of program; + +PROC b plot (REAL CONST r) : + IF plt (* Wenn genuegend PLOT-Werte gepuffert *) + THEN get extreme value; (* sind, wird eine neue Seite gedruckt *) + add (r); + IF param no = plot param no AND line no = value pagelength + THEN gen scales; + plot one page; + value no := nil; + line no := nil + FI + FI. + + get extreme value : + (* Sucht Maximal bzw. Minimalwert, falls keine festen Skalierungs- *) + (* grenzen angegeben wurden (im Quellprogramm)*) + param no INCR 1; + INT VAR act pointer := plot param (param no).scalepointer; + set lower bound; + set upper bound. + + set lower bound : + IF NOT plot param (act pointer).l fixed scale AND + r < plot param (act pointer).lower bound + THEN plot param (act pointer).lower bound := r + FI. + + set upper bound : + IF NOT plot param (act pointer).u fixed scale AND + r > plot param (act pointer).upper bound + THEN plot param (act pointer).upper bound := r + FI. +END PROC b plot; + +PROC add (REAL CONST r) : (* Puffert PLOT-Werte *) + value no INCR 1; + value (value no) := r +END PROC add; + +END PACKET dynamo plotter; + + + + diff --git a/lang/dynamo/1.8.7/src/dyn.plot+ b/lang/dynamo/1.8.7/src/dyn.plot+ new file mode 100644 index 0000000..db04dfc --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.plot+ @@ -0,0 +1,729 @@ +PACKET graphics DEFINES graphmode, + attribut, + palette, + move, + plot, + draw line, + draw linetype, + color, + draw to: + + +(* Autor: Giffeler GD *) +(* Datum: 31.03.1988 *) +(* Schönbeck SHard *) + +INT VAR linie :: -1, farbe :: 1, dummy; + + +PROC attribut (INT CONST nr): + +(* 0..15 Vordergrundfarben fuer Textdarstellung + 0..7 Hintergrundfarben + Attribut fuer blinkende Darstellung (+128) *) + + control (-3, nr, 0, dummy) + +END PROC attribut; + + +PROC palette (INT CONST nr): + +(* Farbauswahl fuer Grafikmodi *) + + control (-4, 0, nr, dummy) + +END PROC palette; + + +PROC graphmode (INT CONST mode): + +(* 0 -> TEXT 40*25 monochrom + 2 -> 80*25 + 1 -> 40*25 farbig + 3 -> 80*25 + 7 -> 80*25 Herkules + 4 -> GRAFIK 320*200 farbig + 5 -> monochrom + 6 -> 640*200 + 64 -> Olivetti 640*400 monochrom + 72 -> kleine Schrift + 512 -> Herkules 720*348 monochrom *) + + control (-5, mode, 0, dummy) + +END PROC graphmode; + + +PROC draw linetype (INT CONST pen, color): + +(* Linienschraffur und Zeichenfarbe *) + + linie:= pen; + farbe:= color; + control (-8, linie, farbe, dummy) + +END PROC draw linetype; + + +PROC draw linetype (INT CONST nr): + +(* Ausschliessliche Aenderung der Linienschraffur *) + + linie:= nr; + control (-8, linie, farbe, dummy) + +END PROC draw linetype; + + +PROC color (INT CONST nr): + +(* Ausschliessliche Aenderung der Zeichenfarbe *) + + farbe:= nr; + control (-8, linie, farbe, dummy) + +END PROC color; + + +PROC move (INT CONST x, y): + +(* Bewegt Zeichencursor zu Koordinaten (0,0 = Links oben) *) + + control (-7, x, y, dummy) + +END PROC move; + + +PROC move (REAL CONST x, y): + + control (-7, int(x+0.5), int(y+0.5), dummy) + +END PROC move; + + +PROC draw to (INT CONST x, y): + +(* Zeichnet Gerade von momentaner Zeichencursorposition nach x,y *) + + control (-6, x, y, dummy) + +END PROC draw to; + + +PROC draw to (REAL CONST x, y): + + control (-6, int(x+0.5), int(y+0.5), dummy) + +END PROC draw to; + + +PROC draw line (INT CONST x1, y1, x2, y2): + +(* Zieht eine Linie von x1,y1 nach x2,y2 *) + + plot (x1, y1); + draw to (x2, y2) + +END PROC draw line; + + +PROC draw line (REAL CONST x1, y1, x2, y2): + + plot (x1, y1); + draw to (x2, y2) + +END PROC draw line; + + +PROC plot (INT CONST x, y): + +(* Zeichnet einen Punkt *) + + control (-7, x, y, dummy); + control (-6, x, y, dummy) + +END PROC plot; + + +PROC plot (REAL CONST x, y): + + control (-7, int(x+0.5), int(y+0.5), dummy); + control (-6, int(x+0.5), int(y+0.5), dummy) + +END PROC plot; + + +PROC draw to (INT CONST x, y, f): + +(* Zeichnet Gerade von momentaner Zeichencursorposition nach x,y *) + + color (f); + control (-6, x, y, dummy) + +END PROC draw to; + + +PROC draw to (REAL CONST x, y, INT CONST f): + + color (f); + control (-6, int(x+0.5), int(y+0.5), dummy) + +END PROC draw to; + + +PROC draw line (INT CONST x1, y1, x2, y2, f): + +(* Zieht eine Linie von x1,y1 nach x2,y2 *) + + plot (x1, y1, f); + draw to (x2, y2) + +END PROC draw line; + + +PROC draw line (REAL CONST x1, y1, x2, y2, INT CONST f): + + plot (x1, y1, f); + draw to (x2, y2) + +END PROC draw line; + + +PROC plot (INT CONST x, y, f): + +(* Zeichnet einen Punkt mit der Farbe f (0 = schwarz) *) + + color (f); + control (-7, x, y, dummy); + control (-6, x, y, dummy) + +END PROC plot; + + +PROC plot (REAL CONST x, y, INT CONST f): + + color (f); + control (-7, int(x+0.5), int(y+0.5), dummy); + control (-6, int(x+0.5), int(y+0.5), dummy) + +END PROC plot + + +END PACKET graphics; + + +PACKET dynamo plotter plus DEFINES configurate plot, + initialize plot, + new plot line, + plot, + end of program, + stop request, + plot scale: + +(* DYNAMO Grafikausgabe *) +(* Autor : Giffeler GD *) +(* Datum : 29.04.1988, 03.06.1988 *) +(* Änder.: Christian Szymanski *) +(* 21.07.88 *) + + +LET max value = 330, + value page length = 30, + max param numb = 10, + + PARAM = ROW value page length REAL, + BIG = ROW 300 REAL, + + max devices = 3, + SWITCH = STRUCT (TEXT bezeichnung, INT on, off, + zeichenbreite, zeichenhoehe, + h offset, + x, y, breite, hoehe), + SIZE = ROW max devices SWITCH; + + +TYPE PLOTPARAM = STRUCT (TEXT name, REAL lower bound, upper bound); + + +ROW max param numb PLOTPARAM VAR plotparam; +ROW max value REAL VAR value; + +BOOL VAR plt, ende; +REAL VAR pltper, nextplot; +INT VAR value no, param no, plot line no, mode nr, plot param no, line no, + xp, yp; + +SIZE CONST table :: SIZE: + (SWITCH: ("CGA 640 * 200", 6, 2, 8, 8, 5, 4, 20, 615, 102), + SWITCH: ("HGC 720 * 348", 512, 0, 0, 0, 0, 0, 0, 0, 0), + SWITCH: ("OLI 640 * 400", 64, 2, 8, 16, 10, 4, 25, 615, 223)); + +configurate plot; (* Erster Aufruf nach der Insertierung *) + + +PROC plot one page : +INT VAR loop nr, n, m; +PARAM VAR x, y; +BIG VAR xr, yr; + + kopfzeile ("Stuetzstellen: ", TRUE); + xp:= 1; yp:= 19; + FOR loop nr FROM 1 UPTO plot param no REP + werte aus value in x und y uebertragen; + koordinatenkreuz (table[mode nr].x, table[mode nr].y, + table[mode nr].breite, table[mode nr].hoehe); + x raster (table[mode nr].x, table[mode nr].y, + table[mode nr].breite, table[mode nr].hoehe, n); + zusatzinformationen ausgeben; + spline (n, m, 1, x, y, xr, yr); + draw picture (table[mode nr].x, table[mode nr].y, + table[mode nr].breite, table[mode nr].hoehe, + loop nr, m, + plot param[loop nr].lower bound, + plot param[loop nr].upper bound, + xr, yr); + legende ausgeben + PER; + abbruch; + graphmode(table[mode nr].off). + +werte aus value in x und y uebertragen: +INT CONST erh :: plot param no + 1; +INT VAR z :: 1, w :: loop nr + 1; + + FOR n FROM 1 UPTO value no DIV erh REP + x[n]:= value[z]; y[n]:= value[w]; + z INCR erh; + w INCR erh + PER; + n DECR 1; + m:= n * 10. + +zusatzinformationen ausgeben: +TEXT CONST xn :: text(x[n]); + + cursor (1, 17); put (x[1]); + cursor (81 - LENGTH xn, 17); + out (xn); + cursor (74, 1). + +legende ausgeben: +INT VAR xph, yph; + + cursor (xp, yp); + put (plot param[loop nr].name + "="); + put (plot param[loop nr].lower bound); + put ("-"); + put (plot param[loop nr].upper bound); + get cursor (xph, yph); + draw line (xph * table[mode nr].zeichenbreite - 8, + yph * table[mode nr].zeichenhoehe - table[mode nr].h offset, + xph * table[mode nr].zeichenbreite + 24, + yph * table[mode nr].zeichenhoehe - table[mode nr].h offset); + IF xp > 1 THEN line ELSE cursor (40, yph) FI; + get cursor (xp, yp). + +abbruch: +TEXT VAR eingabe; + + REP + cursor (30, 1); + put (39*" "+"(+, p, e)?"); + inchar (eingabe); + SELECT code (eingabe) OF + CASE 43 : eingabe:= "" + CASE 69, 101: ende:= TRUE; eingabe:= "" + CASE 80, 112: phasendiagramm + OTHERWISE out(""7"") + END SELECT + UNTIL eingabe = "" PER + +END PROC plot one page; + + +PROC initialize plot (TEXT CONST h) : +INT VAR c :: 1, typ; +TEXT VAR sym, num; + + ende:= FALSE; + pltper:= get pltper; + plot line no:= value page length; + nextplot:= 0.0; + value no:= 0; + line no:= 0; + plot param no:= 0; + kopfzeile zerlegen. + +kopfzeile zerlegen: + scan (h); + REP + next symbol (plot param[c].name); + next symbol (sym, typ); + IF sym = "(" THEN + next symbol (num); + next symbol (sym, typ); + IF sym = ")" THEN + plot param[c].name CAT ("(" + num + ")") + FI + FI; + WHILE typ < 7 CAND NOT (sym = "(" COR sym = ",") REP + next symbol (sym, typ) + PER; + IF typ < 7 CAND sym = "(" THEN + REP next symbol (sym) + UNTIL sym = "," PER; + REP next symbol (sym, typ) + UNTIL typ > 6 COR sym = "," COR sym = "/" PER + FI; + c INCR 1 + UNTIL typ > 6 PER + +END PROC initialize plot; + + +PROC plot scale (TEXT CONST id, INT CONST scale pointer, + REAL CONST lower bound, upper bound, + BOOL CONST l fixed scale, u fixed scale) : + + plot param no INCR 1; + plot param[plot param no].lower bound:= lower bound; + plot param[plot param no].upper bound:= upper bound + +END PROC plot scale; + + +PROC new plot line (REAL CONST time) : + + plt:= time >= nextplot; + IF plt THEN + add (time); + line no INCR 1; + param no:= 0 + FI; + WHILE time >= nextplot REP + nextplot INCR pltper + PER + +END PROC new plot line; + + +PROC plot (REAL CONST r): + + IF plt THEN + param no INCR 1; + add (r); + IF NOT ende CAND param no = plot param no AND + line no = value page length THEN + plot one page; + value no:= 0; + line no:= 0 + FI + FI + +END PROC plot; + + +PROC add (REAL CONST r): + + IF NOT ende THEN + value no INCR 1; + value[value no]:= r + FI + +END PROC add; + + +PROC spline (INT CONST n, m, s, PARAM CONST x, y, BIG VAR xr, yr): + +{ Kubische Splineinterpolation 3. Grades; 2 fach Differenzierbar } +{ Quelle: Rita Schmidt, Hahn-Meitner-Institut für Kernforschung Berlin } +{ "Spline-Prozeduren" (HMI-B 220) } +{ Umsetzung & Modifikation: Giffeler GD, 13.04.1988, 22.04.1988 } + +{ n = Anzahl der Stützstellen } +{ m = Anzahl der zu berechnenden Funktionswerte } +{ s = Index des x-Startpunktes } +{ x = x-Werte der Stützstellen (linear steigend) } +{ y = y-Werte der Stützstellen } +{ xr = x-Werte der Punkte, an denen die Funktion berechnet werden } +{ soll } +{ yr = y-Werte der Punkte, an denen die Funktion berechnet werden } +{ soll } + + +INT CONST nn :: n - 1; +REAL CONST steps :: (real(nn) * (x[2] - x[1])) / real(m - 1); + +PARAM VAR q, au; +REAL VAR hi, hk, hk1, dij, dim1j; +INT VAR k, kk, j, m1, m2, m3; + + q[1]:= 0.0; + yr[1]:= x[s]; + FOR j FROM 2 UPTO m REP yr[j]:= yr[j - 1] + steps PER; + xr:= yr; + block 0; + FOR k FROM 2 UPTO nn REP block 1 PER; + FOR kk FROM 2 UPTO nn REP block 2 PER; + FOR j FROM 1 UPTO m REP block 3 PER. + +block 0: + au[1]:= (y[3] - y[2] - y[2] + y[1]) / ((x[2] - x[1]) * (x[3] - x[2])); + au[n]:= (y[n] - y[nn] - y[nn] + y[n - 2]) / + ((x[n] - x[nn]) * (x[nn] - x[n - 2])). + +block 1: +INT CONST km1 :: k - 1, kp1 :: k + 1; + + hk:= x[k] - x[km1]; + hk1:= x[kp1] - x[k]; + q[k]:= - hk1 / (hk * (q[km1] + 2.0) + 2.0 * hk1); + au[k]:= (hk * au[km1] - 6.0 * ((y[kp1] - y[k]) / hk1 - (y[k] - + y[km1]) / hk)) * q[k] / hk1. + +block 2: + k:= nn - kk + 2; + au[k]:= q[k] * au[k + 1] + au[k]. + +block 3: + zeige benutzer das du noch lebst; + IF yr[j] < x[1] THEN + m1:= 1; + m2:= 2 + ELIF yr[j] > x[n] THEN + m1:= n - 1; + m2:= n + ELSE + m1:= 1; + m2:= n; + wiederholung + FI; + dij:= x[m2] - yr[j]; + hi:= x[m2] - x[m1]; + dim1j:= x[m1] - yr[j]; + yr[j]:= 1.0 / 6.0 / hi * (au[m1] * dij ** 3 - au[m2] * dim1j ** 3 + + (6.0 * y[m1] - hi ** 2 * au[m1]) * dij - (6.0 * y[m2] - hi ** 2 + * au[m2]) * dim1j). + +wiederholung: + REP + m3:= (m2 + m1) DIV 2; + IF yr[j] >= x[m3] THEN m1:= m3 ELSE m2:= m3 FI + UNTIL m2 - m1 = 1 PER. + +zeige benutzer das du noch lebst: + cout (j) + +END PROC spline; + + +PROC phasendiagramm: +REAL VAR l :: maxreal, u :: smallreal; +BIG VAR x, y; +INT VAR i, no1, no2; + + IF plot param no > 1 THEN + partnerwahl; + werte aus value uebertragen; + kopfzeile ("Phasendiagramm", TRUE); + koordinatenkreuz (table[mode nr].x, table[mode nr].y, + table[mode nr].breite, table[mode nr].hoehe+50); + draw picture (table[mode nr].x, table[mode nr].y, + table[mode nr].breite, table[mode nr].hoehe+50, + 1, i-1, l, u, x, y); + legende + FI. + +partnerwahl: + kopfzeile ("Phasendiagramm", FALSE); + line (2); + FOR i FROM 1 UPTO plot param no REP + putline (text(i, 3) + " = " + plot param[i].name) + PER; + REP + cursor (1, plot param no +5); + put ("X-ACHSE:"); get (no1); + cursor (1, plot param no +5); + put ("Y-ACHSE:"); get (no2) + UNTIL no1 > 0 CAND no1 <= plot param no CAND + no2 > 0 CAND no2 <= plot param no CAND + no1 <> no2 PER. + +werte aus value uebertragen: +INT CONST erh :: plot param no + 1; +INT VAR n1 :: no1 + 1, n2 :: no2 + 1; + + FOR i FROM 1 UPTO value no DIV erh REP + x[i]:= value[n1]; + y[i]:= value[n2]; + n1 INCR erh; + n2 INCR erh + PER. + +legende: + cursor (1, 23); + putline ("X-Achse: " + plot param[no1].name); + out ("Y-Achse: " + plot param[no2].name) + +END PROC phasendiagramm; + + +PROC draw picture (INT CONST x, y, xb, yb, schraffur, m, + REAL VAR lower bound, upper bound, + BIG CONST xr, yr): + +{ Ausgabe einer Funktionskurve } +{ Autor: Giffeler GD, 22.04.1988, 27.04.1988 } + +{ x = X-Position (oben links = 0) } +{ y = Y-Position (oben links = 0) } +{ xb = Ausgabebreite } +{ yb = Ausgabehöhe } +{ schraffur = Linienschraffur (1 - 10) } +{ m = Anzahl der Funktionswerte } +{ lower bound = Unterer Grenzwert (maxreal wenn Grenze beliebig) } +{ upper bound = Oberer Grenzwert (smallreal wenn Grenze beliebig) } +{ xr = Durch SPLINE erzeugte X-Werte } +{ yr = Durch SPLINE erzeugte Y-Werte } + + +ROW 10 INT CONST linienarten :: ROW 10 INT: (-1, -256, 3855, -240, + 21845, -1, -1, -1, -1, -1); + +REAL VAR lbx :: maxreal, ubx :: smallreal; +INT VAR i; + + minimum und maximum fuer x und y berechnen; + abmessungsparameter umwandeln; + spannweite errechnen; + linienschraffur bestimmen; + eine funktion ausgeben. + +minimum und maximum fuer x und y berechnen: + FOR i FROM 1 UPTO m REP + lower bound:= min (lower bound, yr[i]); + upper bound:= max (upper bound, yr[i]); + lbx:= min (lbx, xr[i]); + ubx:= max (ubx, xr[i]) + PER. + +abmessungsparameter umwandeln: +REAL CONST xpos :: real (x), ypos :: real (y), + breite :: real (xb), hoehe :: real (yb). + +spannweite errechnen: +REAL CONST sy :: (upper bound - lower bound) / hoehe, + sx :: (ubx - lbx) / breite. + +linienschraffur bestimmen: + draw linetype (linienarten [abs(schraffur) MOD 10]). + +eine funktion ausgeben: + move (xpos + (xr[1] - lbx) / sx, + ypos + hoehe - (yr[1] - lower bound) / sy); + FOR i FROM 2 UPTO m REP + drawto (xpos + (xr[i] - lbx) / sx, + ypos + hoehe - (yr[i] - lower bound) / sy) + PER + +END PROC draw picture; + + +PROC koordinatenkreuz (INT CONST nx, ny, breite, hoehe): + + anpassung; + rahmen; + pfeil oben; + pfeil rechts. + +anpassung: +INT CONST x :: nx - 1, + y :: ny - 10, + b :: breite + 21, + h :: hoehe + 11. + +rahmen: + draw linetype (-1); + draw line (x, y, x, y + h); + draw to (x + b, y + h). + +pfeil oben: + draw line (x - 3, y + 4, x, y); + draw to (x + 3, y + 4). + +pfeil rechts: + draw line (x + b - 5, y + h - 2, x + b, y + h); + draw to (x + b - 5, y + h + 2) + +END PROC koordinatenkreuz; + + +PROC x raster (INT CONST nx, ny, breite, hoehe, anzahl): +REAL CONST y :: real (ny + hoehe + 2), + w :: real (breite) / real (anzahl); +REAL VAR s :: real (nx); +INT VAR i; + + FOR i FROM 1 UPTO anzahl REP + s INCR w; + plot (s, y) + PER + +END PROC x raster; + + +PROC configurate plot: +(* +BOOL CONST cmd :: command dialogue; +INT VAR i; + + command dialogue (TRUE); + REP + bildschirmausgabe zur auswahl + UNTIL (mode nr <= max devices AND mode nr > 0) CAND + yes ("Eingabe richtig") PER; + command dialogue (cmd). + +bildschirmausgabe zur auswahl: + page; + putline ("CONFIGURATIONSTABELLE DYNAMO GRAFIK"); + line (2); + FOR i FROM 1 UPTO max devices REP + putline (text(i)+" -- "+table[i].bezeichnung) + PER; + line (2); + put ("Modus:"); + get (mode nr) + +*) +mode nr := 1. (* CGA *) +END PROC configurate plot; + + +PROC kopfzeile (TEXT CONST message, BOOL CONST grafik): + + IF grafik THEN graphmode (table[mode nr].on) + ELSE graphmode (table[mode nr].off) FI; + out (""1""); (* C.S. 21.07.88 *) + out ("DYNAMO 3.3+"); + cursor (79 - LENGTH message, 1); + out (message) + +END PROC kopfzeile; + + +PROC end of program : + + IF NOT ende CAND (value no DIV (plot param no + 1)) > 2 THEN + plot one page + FI + +END PROC end of program; + + +BOOL PROC stop request: ende END PROC stop request + + +END PACKET dynamo plotter plus + diff --git a/lang/dynamo/1.8.7/src/dyn.print b/lang/dynamo/1.8.7/src/dyn.print new file mode 100644 index 0000000..36ea279 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.print @@ -0,0 +1,43 @@ +PACKET dynamo printer DEFINES initialize print, new line, print : + +BOOL VAR prt; +TEXT VAR headline; +REAL VAR prtper, nextprint; + +PROC initialize print (TEXT CONST h) : + headline := h; + prtper := get prtper; + nextprint := 0.0 +END PROC initialize print; + +PROC new line (REAL CONST time) : + IF time >= nextprint + THEN do lf + ELSE prt := FALSE + FI; + WHILE time >= nextprint REP + nextprint INCR prtper + PER. + + do lf : + print line; + prt := TRUE; + IF pagefeed necessary OR NOT was print + THEN vdt; + sys page; + print headline + FI; + print (time). + + print headline : + println ("TIME " + headline). +END PROC new line; + +PROC print (REAL CONST r) : + IF prt + THEN print output (text (text (round (r, 5)), 13)) + FI +END PROC print + +END PACKET dynamo printer + diff --git a/lang/dynamo/1.8.7/src/dyn.proc b/lang/dynamo/1.8.7/src/dyn.proc new file mode 100644 index 0000000..a291a48 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.proc @@ -0,0 +1,160 @@ +PACKET dynamo prozeduren DEFINES clip,fifge,switch,fifze,table,tabhl, + sclprd,sum,sumv, + noise,normrn,power, + pulse,step,ramp, + set time : +(***************************************************D.Craemer 16. 2.1983 ***) +(* uses: + type TAB (Tabellen), wert, laenge + abs + random + + globale Variablen simulationtime wird durch das DYNAMO- + Programm gesetzt und in + den Funktionen, die zeit- + lich ausgeloest werden, + benutzt + + lastpulse Zeit des letzten Pulses + + +*) + +REAL VAR simulation time,last pulse:=0.0; + +PROC set time (REAL CONST time) : + simulation time := time +END PROC set time ; + +(************************ ab hier Funktionen *******************************) +(************************ zur Wertauswahl *******************************) + +REAL PROC clip(REAL CONST p,q,r,s): + IF r>=s THEN p ELSE q FI + END PROC clip; + +REAL PROC fifge(REAL CONST p,q,r,s): + clip(p,q,r,s) + END PROC fifge; + +(* clip und fifge machen dasselbe, der Name fifge gibt die Funktion besser +wieder: first if greater or equal + = == = = *) + +REAL PROC switch (REAL CONST p,q,r): + IF r=0.0 THEN p ELSE q FI + END PROC switch; + +REAL PROC fifze (REAL CONST p,q,r): + switch(p,q,r) + END PROC fifze; + +(* Funktion switch oder fifze: first if zero + = == == *) + +(************************ ab hier Funktionen *******************************) +(************************ mit Tabellen *******************************) + +REAL PROC table (TAB CONST t, REAL CONST x, xlow, x high, xincr) : + IF x < x low OR x > x high + THEN putline("TABLE out of range: xlow="+text(xlow)+" x="+text(x)+ + " xhigh="+text(xhigh)+" xincr="+text(xincr));0.0 + ELIF x=xhigh + THEN wert(t,laenge(t)) + ELIF x=xlow + THEN wert(t,1) + ELSE deliver interpolated value + FI. + +deliver interpolated value: + INT VAR index :: int((x-xlow)/xincr)+1; + REAL VAR m :: ((wert (t, index + 1) - wert (t, index)) / x incr), + b :: wert (t, index); + + m * (x-(xlow+real(index-1)*xincr)) + b. +END PROC table; + + +REAL PROC tabhl (TAB CONST t, REAL CONST x, xlow, x high, xincr) : + IF xlow < x AND x < xhigh + THEN table(t,x,xlow,xhigh,xincr) + ELIF x <= xlow + THEN wert(t,1) + ELSE wert(t,laenge(t)) + FI +END PROC tabhl ; + +REAL PROC sclprd(TAB CONST tab1,REAL CONST erstes1,letztes1,TAB CONST tab2, + REAL CONST erstes2): +INT VAR i; +REAL VAR summe:=0.0; +FOR i FROM 0 UPTO int(letztes1-erstes1) REP + summe:=summe + wert(tab1,int(erstes1)+i)*wert(tab2,int(erstes2)+i) +PER; +summe +END PROC sclprd; + +REAL PROC sumv(TAB CONST tab, REAL CONST erstes,letztes): +REAL VAR summe:=0.0; +INT VAR i; +FOR i FROM int(erstes) UPTO int(letztes) REP + summe:=summe+wert(tab,i) +PER; +summe +END PROC sumv; + +REAL PROC sum(TAB CONST tab): + sumv(tab,1.0,real(laenge(tab))) +END PROC sum; + +(************************ ab hier Funktionen *******************************) +(************************ mit Zufallszahlen *******************************) + +REAL PROC noise(REAL CONST dummy): + random-0.5 +END PROC noise; + +REAL PROC normrn(REAL CONST mittelwert,stdvar): +REAL VAR z:=0.0; +INT VAR i; +(* Methode nach NAYLOR et al.: Computer Simulation Technique, Wiley,NY 1966*) +FOR i FROM 1 UPTO 12 REP + z:=z+random +PER; +z:=z-6.0; +mittelwert+z*stdvar +END PROC normrn; + +(************************ ab hier Funktionen *******************************) +(************************ mit Zeitausloesung ******************************) + +REAL PROC pulse(REAL CONST height,first,interval): +IF simulationtime < first THEN lastpulse:=0.0; 0.0 + ELIF abs(simulationtime-first) < smallreal THEN lastpulse:=simulationtime; + height + ELIF abs(simulationtime-(lastpulse+interval)) < smallreal THEN + lastpulse:=simulationtime; + height + ELSE 0.0 +END IF +END PROC pulse; + +REAL PROC step(REAL CONST height,steptime): + IF simulationtime<steptime THEN 0.0 + ELSE height + FI +END PROC step; + +REAL PROC ramp(REAL CONST slope,start): + IF simulationtime<start THEN 0.0 + ELSE slope*(simulationtime-start) + FI +END PROC ramp; + +REAL PROC power(REAL CONST basis,exponent): + basis**int(exponent) +END PROC power + + +END PACKET dynamo prozeduren + diff --git a/lang/dynamo/1.8.7/src/dyn.quadrat b/lang/dynamo/1.8.7/src/dyn.quadrat new file mode 100644 index 0000000..fdd553a --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.quadrat @@ -0,0 +1,13 @@ +NOTE HIER BERECHNEN WIR DAS QUADRAT MITTELS ABLEITUNG ! +L F.K=F.J+2*TIME.J*DT +N F=0 +C DT=0.01 +NOTE DT WIRD EXTRA SO KLEIN GEWAEHLT; DAMIT DIE ANNAEHERUNG GUT IST +NOTE +NOTE DAS GEHT AUF KOSTEN DER RECHENZEITEN !!! +C LENGTH=17 +C PLTPER=1 +PLOT F +C PRTPER=1 +PRINT F + diff --git a/lang/dynamo/1.8.7/src/dyn.rts b/lang/dynamo/1.8.7/src/dyn.rts new file mode 100644 index 0000000..c46684a --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.rts @@ -0,0 +1,376 @@ +PACKET rts + DEFINES constant, vdt, get pltper, get prtper, was print, + println, print output, plot output, print line, + sys page, pagefeed necessary, print suppressed output, asterisk, + protokoll, default, set pagelength, run time system, b stop request, + scroll, run card : + (* Runtime - System *) + (* Autor : R. Keil *) + (* Datum : 12.07.83 Aenderung: 19.06.84 D. Craemer *) + (* 2.Aenderung: 6.05.85 D. Craemer *) + (* Änderung auf 1.8.2: Z. 288, Christian Szymanski, 10.08.88 *) + (* In der 2. Aenderung wurde dyn.const in zzdyn.const umbenannt*) + (* und alle Konstanten-Datenraeume bekommen ".const" angehaengt*) + (* Wird im rts das Kommando run name gegeben, so wird der *) + (* augenblickliche Konstanten-Datenraum gerettet im Datenraum *) + (* mit dem Namen: "name.const" *) + + + + LET esc = ""27"", + max tab size = 50, + bold = 1, + number = 2, + delimiter = 3; + +TYPE CONSTANT = STRUCT (ROW max tab size TEXT name, + ROW max tab size REAL value, + INT tab size); + +BOUND CONSTANT VAR constants; + +FILE VAR sysout; +TEXT VAR print buf, asterisk buffer, sym, const name, + const space name::"zzdyn.const"; +REAL VAR dt, length, prtper, pltper; +INT VAR line no, page no, max pagelength, type; + +BOOL VAR vdt on, print, protocoll, terminal stop, is scroll, + is not first, run specified; + + +default; + +PROC default : + protocoll := FALSE; + max pagelength := 23; + is scroll := TRUE; + run specified := FALSE +END PROC default; + +PROC set pagelength (INT CONST i) : + max pagelength := i +END PROC set pagelength; + +PROC run card (TEXT CONST run name) : + IF exists (actual constants) + THEN constants := old (actual constants) + ELIF run name="zzdyn" + THEN constants := new (actual constants); + CONCR (constants).tab size := 0 + ELSE copy (const space name, actual constants); + constants := old (actual constants) + FI; + const space name := actual constants. + + actual constants: + run name + ".const". + +END PROC run card; + +REAL PROC constant (TEXT CONST name, REAL CONST val) : + REAL VAR value; + INT VAR tab pos; + value := actual value; + set system consts. + + actual value : + search constant (name, tab pos); + IF tab pos > 0 + THEN CONCR (constants).value (tab pos) + ELSE new constant (name, val); + val + FI. + + set system consts : + SELECT pos ("dt length prtper pltper ", name + " ") OF + CASE 1 : dt := value + CASE 4 : length := value + CASE 11 : prtper := value + CASE 18 : pltper := value + END SELECT; + value. +END PROC constant; + +PROC new constant (TEXT CONST name, REAL CONST val) : + CONCR (constants).tab size INCR 1; + IF CONCR (constants).tab size > max tab size + THEN errorstop ("ZUVIELE KONSTANTEN") + FI; + CONCR (constants).name (CONCR (constants).tab size) := name; + CONCR (constants).value (CONCR (constants).tab size) := val +END PROC new constant; + +PROC search constant (TEXT CONST name, INT VAR tab pos) : + INT VAR i; + FOR i FROM 1 UPTO CONCR (constants).tab size REP + IF name = CONCR (constants).name (i) + THEN tab pos := i; + LEAVE search constant + FI + END REP; + tab pos := 0 +END PROC search constant; + +REAL PROC get pltper : (* Reicht 'pltper' (Plotperiode) heraus *) + pltper +END PROC get pltper; + +REAL PROC get prtper : (* Reicht 'prtper' (Printperiode) heraus *) + prtper +END PROC get prtper; + +PROC scroll (BOOL CONST b) : + is scroll := b +END PROC scroll; + +PROC next sym : + next sym (sym, type) +END PROC next sym; + +PROC rts err (TEXT CONST err mess) : + outline ("FEHLER BEI >>>" + sym + "<<< : " + err mess) +END PROC rts err; + +PROC run time system (PROC target program) : + IF protocoll + THEN kill ("dyn.out"); + sysout := sequential file (output, "dyn.out") + FI; + init rts; + REP + get command; + execute command + END REP. + + get command : + TEXT VAR command; + print suppressed output; + line; + putline (" dynamo runtime system :"); + shift; + getline (command); + printline (command). + + execute command : + scanner (command); + next sym; + TEXT VAR start := sym; + skip blanks; + SELECT pos ("run rerun quit help c ? EOL ", start + " ") OF + CASE 1, 5 : run + CASE 11 : quit + CASE 16 : show ("dyn.help") + CASE 21 : const equ + CASE 23 : dump consts + CASE 25 : + OTHERWISE : rts err ("KOMMANDO UNBEKANNT") + END SELECT. + + run : + init rts; + IF type = bold OR type = delimiter + THEN run card (sym) + FI; + target program. + + quit : + IF const space name = "zzdyn.const" + THEN kill (const space name) + FI; + LEAVE runtime system. + + skip blanks : + REP + next sym + UNTIL sym <> " " END REP. + + const equ : + REAL VAR value, dummy; + INT VAR tab pos; + REP + analyze constant equ; + search constant (const name, tab pos); + IF tab pos = 0 + THEN sym := const name; + rts err ("KONSTANTE NICHT DEFINIERT") + ELSE CONCR (constants).value (tab pos) := value + FI + UNTIL end of constants END REP. + + analyze constant equ : + IF type <> bold + THEN rts err ("NAME ERWARTET") + FI; + const name := sym; + next sym; + IF sym <> "=" + THEN rts err ("^=^ ERWARTET") + FI; + get constant. + + end of constants : + next sym; + IF sym = "/" OR sym = "," + THEN next sym; FALSE + ELSE TRUE + FI. + + get constant : + next sym; + value := 1.0; + IF sym = "-" + THEN value := -1.0; next sym + ELIF sym = "+" + THEN next sym + FI; + IF type = number + THEN value := value * real (sym) + ELSE rts err ("ZAHL ERWARTET") + FI. + + dump consts : + INT VAR i; + FOR i FROM 1 UPTO CONCR (constants).tab size REP + IF (i MOD 2) = 1 + THEN line; shift + FI; + out (text (CONCR (constants).name (i), 14), " = ", + text (text (CONCR (constants).value (i)), 13)) + END REP; + line. +END PROC run time system; + +PROC shift : + out (" ") +END PROC shift; + +PROC init rts : + line no := 0; + page no := 0; + asterisk buffer := ""; + print buf := ""; + print := FALSE; + terminal stop := FALSE; + is not first := FALSE; + vdt on := TRUE +END PROC init rts; + +PROC protokoll (BOOL CONST b) : + protocoll := b +END PROC protokoll; + +PROC print line : + BOOL VAR b := print; (* Druckt Ausgabe - Puffer und *) + println (print buf); (* loescht anschliessend den Inhalt *) + print buf := ""; + print := b +END PROC print line; + +PROC print suppressed output : + IF print buf <> "" (* Druckt Ausgabe - Puffer, *) + THEN println (print buf); (* falls gefuellt *) + print buf := "" + FI +END PROC print suppressed output; + +PROC print output (TEXT CONST t) : + print buf CAT t; (* Fuellt Ausgabe - Puffer *) + print buf CAT " " +END PROC print output; + +PROC println (TEXT CONST t) : + print := TRUE; (* Verteilt Ausgabe auf Bildschirm *) + line no INCR 1; (* und Datei *) + outline (t); + IF line no = max page length + THEN line no := 0 + FI; + IF is getcharety (esc) (* bis einschl. 1.8.1: 'is incharety' *) + THEN terminal stop := TRUE + FI. +END PROC println; + +PROC outline (TEXT CONST t) : + printline (t); + putline (actual line). + + actual line : + IF LENGTH (t) > 78 + THEN text (t, 78) + ELSE t + FI. +END PROC outline; + +PROC printline (TEXT CONST t) : + IF protocoll + THEN putline (sysout, t) + FI +END PROC print line; + +PROC sys page : (* Seitenvorschub auf Bildschirm und Datei *) + IF vdt on AND NOT is scroll AND is not first + THEN page + ELSE is not first := TRUE + FI; + IF protocoll + THEN putline (sysout, "#page#") + FI; + IF asterisk buffer <> "" + THEN page no INCR 1; + println ("PAGE " + text (page no, 3) + " : " + asterisk buffer); + FI; + line no := 0 +END PROC sys page; + +BOOL PROC pagefeed necessary : + line no = 0 (* Liefert TRUE, wenn Seitenende erreicht *) +END PROC pagefeed necessary; (* ist *) + +PROC plot output (TEXT CONST t) : + println (t); (* Ausgabeprozedur fuer das Plot - Programm *) + print := FALSE +END PROC plot output; + +BOOL PROC b stop request : (* Liefert TRUE, wenn 'End'-Kommando im VDT *) + terminal stop (* - Modus gegeben wird *) +END PROC b stop request; + +BOOL PROC was print : (* Liefert TRUE, falls Druckerprogramm *) + print. (* vorher eine Zeile gedruckt hat *) +END PROC was print; + +PROC vdt : + IF vdt on AND is not first (* VDT = Video Data Termination *) + THEN do vdt (* Verhindert Scrolling des Bildschirms *) + FI. + + do vdt : + TEXT VAR t; + out ("TIPPEN SIE : '+'; 'o'; 'e' : "); + inchar (t); + out (t); + IF t = "+" (* '+' = Seitenvorschub *) + THEN + ELIF t = "o" (* 'o' = Off; VDT wird abgeschaltet *) + THEN vdt on := FALSE + ELIF t = "e" (* 'e' = End; Programm wird abgebrochen *) + THEN terminal stop := TRUE + ELSE out (""13""); vdt + FI; + line. +END PROC vdt; + +PROC asterisk (TEXT CONST t) : + asterisk buffer := t +END PROC asterisk; + +PROC out(TEXT CONST a,b,c) : + out(a); + out(b); + out(c) +END PROC out; + + +END PACKET rts; + diff --git a/lang/dynamo/1.8.7/src/dyn.ruestungswettlauf b/lang/dynamo/1.8.7/src/dyn.ruestungswettlauf new file mode 100644 index 0000000..7b7c6b1 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.ruestungswettlauf @@ -0,0 +1,32 @@ +note ruestungswettlauf nach richardson +note +note literatur: thiel "quantitaet oder begriff" S. 436 ff +note +l eigenkriegspot.k=eigenkriegspot.j+dt* +x (k*gegenkriegspot.j-a*eigenkriegspot.j+g) +l gegenkriegspot.k=gegenkriegspot.j+dt* +x (l*eigenkriegspot.j-b*gegenkriegspot.j+h) +note +note anfangswerte fuer eigenkriegspotential und gegenkriegspotential +note werden am gleichgewichtspunkt plus etwas mehrpot gegeben +note +n eigenkriegspot=(k*h+b*g)/(a*b-k*l)+mehrpot +n gegenkriegspot=(l*g+a*h)/(a*b-k*l) +note +note konstanten +note +c k=2 verteidigungskoeffizient +c l=1 " des gegners +c a=2 koeffizient fuer aufwand zur kriegsvorbereitung +c b=3 " +c g=7 koeffizient fuer aggressive absichten +c h=9 " +c mehrpot=3 stoerung des gleichgewichts durch mehr potential +plot eigenkriegspot=e,gegenkriegspot=g(unten,oben) +c dt=0.5 +c length=2050 +n time=1985 +c pltper=1 +c unten=-11 +c oben=250 + diff --git a/lang/dynamo/1.8.7/src/dyn.simon b/lang/dynamo/1.8.7/src/dyn.simon new file mode 100644 index 0000000..b911159 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.simon @@ -0,0 +1,28 @@ +NOTE Simons MODELL der sozialen Gruppe Stand: 08.03.1983 +NOTE +A INTERAKT.K=A1*FREUNDLICH.K+A2*AKTIV.K +L FREUNDLICH.K=FREUNDLICH.J+DT*(B1*(INTERAKT.J-beta*FREUNDLICH.J)) +L AKTIV.K=AKTIV.J+DT*(C1*(FREUNDLICH.J-gamma*AKTIV.J)+C2*(EINF-AKTIV.J)) +N INTERAKT=beta*A2*C2*EINF/NENNER +N AKTIV=C2*(beta-A1)*EINF/NENNER +N FREUNDLICH=A2*C2*EINF/NENNER+STOERTERM +N NENNER=-C1*A2+(beta-A1)*(C2+C1*gamma) +C STOERTERM=0.4 +C EINF=2 +NOTE +NOTE Konstanten sind alle positiv vorausgesetzt +NOTE Stabil fuer beta>a1 +C A1=1.0 +C A2=1.5 +C B1=1 +C beta=1.0 +C C1=1.4 +C C2=1.5 +C gamma=1.5 +C DT=0.1 +C LENGTH=60 +C PLTPER=0.5 +PLOT INTERAKT=i,FREUNDLICH=f,AKTIV=a(-10,10) +PRINT INTERAKT,FREUNDLICH,AKTIV +C PRTPER=0.5 + diff --git a/lang/dynamo/1.8.7/src/dyn.std b/lang/dynamo/1.8.7/src/dyn.std new file mode 100644 index 0000000..a87b66d --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.std @@ -0,0 +1,9 @@ +abs r arctan r arctand r cos r cosd r exp r floor r frac r +initializerandom r random r +ln r log2 r log10 r +max rr min rr +power rr round r +sin r sind r sqrt r tan r tand r +clip rrrr fifge rrrr switch rrr fifze rrr noise r normrn rr pulse rrr +ramp rr sclprd trrtr step rr sumv trr sum t table trrrr tabhl trrrr /* + diff --git a/lang/dynamo/1.8.7/src/dyn.steifedgl b/lang/dynamo/1.8.7/src/dyn.steifedgl new file mode 100644 index 0000000..b168fcd --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.steifedgl @@ -0,0 +1,15 @@ +NOTE STIFF EQUATIONS SIEHE: SIMULATION AUGUST 1980, SEITE 38 +L Y1.K=Y1.J+DT*(-21*Y1.J+19*Y2.J-20*Y3.J) +L Y2.K=Y2.J+DT*(+19*Y1.J-21*Y2.J+20*Y3.J) +L Y3.K=Y3.J+DT*(+40*Y1.J-40*Y2.J-40*Y3.J) +N Y1=1 +N Y2=0 +N Y3=-1 +NOTE KONSTANTEN MUESSEN GEEIGNET GEWAEHLT WERDEN: DT SEHR KLEIN +C LENGTH=20 +C DT=.01 +C PRTPER=1 +C PLTPER=1 +PRINT Y1,Y2,Y3 +PLOT Y1,Y2,Y3 + diff --git a/lang/dynamo/1.8.7/src/dyn.tool b/lang/dynamo/1.8.7/src/dyn.tool new file mode 100644 index 0000000..65769d8 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.tool @@ -0,0 +1,217 @@ +PACKET io handling DEFINES error listing, err, message, errors, init errors, + text, kill, trunc, hash, no errors : +(* Autor : R. Keil, Version vom 22.07.83, Änderung: C. Szymanski, 21.07.88 *) + +LET errmax = 67, + max hash size = 300; + +ROW errmax TEXT VAR error; +FILE VAR listfile; (* -> VERSION 3.2 *) +BOOL VAR list; +INT VAR errorno, i; + +PROC init errors (TEXT CONST fname) : + FILE VAR errorfile := sequential file (input, fname); + TEXT VAR buffer; + FOR i FROM 1 UPTO errmax WHILE NOT eof (errorfile) REP + getline (errorfile, buffer); + error (i) := buffer + END REP +END PROC init errors; + +PROC init errors : + errorno := 0 +END PROC init errors; + +PROC error listing (TEXT CONST listname) : + list := listname <> "nolist"; + IF list + THEN kill (listname); + listfile := sequential file (output, listname) + FI +END PROC error listing; + +INT PROC errors : + error no +END PROC errors; + +PROC err (TEXT CONST s, INT CONST m, line no) : + message ("Fehler in Zeile " + text (line no) + " bei >>" + s + "<< : " + + error (m)); + errorno INCR 1 +END PROC err; + +BOOL PROC no errors : + IF errors = 0 + THEN TRUE + ELSE display (text (error no) + " Fehler gefunden"13""10""); FALSE + FI +END PROC no errors; + +PROC message (TEXT CONST m) : + IF list + THEN putline (list file, m); + FI; + note (m); (* C.S. 21.07.88 *) + note line; + display (m); + display (""13""10"") +END PROC message; + +TEXT PROC text (BOOL CONST b) : + IF b + THEN "TRUE" + ELSE "FALSE" + FI +END PROC text; + +PROC kill (TEXT CONST file name) : + command dialogue (FALSE); + forget (file name); + command dialogue (TRUE) +END PROC kill; + +TEXT PROC trunc (TEXT CONST t) : + text (t, length (t) - 2) +END PROC trunc; + +INT PROC hash (TEXT CONST word) : + INT VAR qs := 0; + FOR i FROM 1 UPTO length (word) REP + qs INCR code (word SUB i) + END REP; + (qs MOD max hash size) + 1. +END PROC hash + +END PACKET io handling; + + +(************************* S C A N N E R **************************) + +PACKET scan DEFINES next sym, scanner, scanpos : + + +LET bold = 1, (* Autor : R. Keil, T. Froehlich *) + number = 2, (* Version vom 04.07.83 *) + delimiter = 3, + eol = 4; + +TEXT VAR main buf, sym; +INT VAR position, type, cc, begin pos; + +PROC nextsym (TEXT CONST buf, TEXT VAR scan sym, + INT VAR scan type, pos) : + TEXT VAR char := buf SUB pos; + cc := code (char); + IF (cc >= 97 AND cc <= 122) + THEN process lower case + ELIF cc = 46 OR is int + THEN process real + ELIF (cc >= 65 AND cc <= 90) + THEN process upper case + ELSE process delimiter + FI. + + process upper case : + scan type := bold; + scan sym := low; + next char; + WHILE (cc >= 65 AND cc <= 90) OR is int REP + scan sym CAT low; + next char + END REP. + + process lower case : + scan type := bold; + begin pos := pos; + REP + next char + UNTIL lower case char AND NOT is int END REP; + scan sym := subtext (buf, begin pos, pos - 1). + + lower case char : + cc < 97 OR cc > 122. + + process real : + process base; + process exponent; + scan type := number. + + process base : + IF cc = 46 + THEN next char; + IF is int + THEN scan sym := "0."; + process int + ELSE scan type := delimiter; + scan sym := "."; + LEAVE process real + FI + ELSE scan sym := ""; + process int; + IF cc = 46 + THEN scan sym CAT char; + next char; + IF is int + THEN process int + ELSE scan sym CAT "0" + FI + ELSE scan sym CAT ".0" + FI + FI. + + process exponent : + IF cc = 69 OR cc = 101 + THEN scan sym CAT "e"; + next char; + IF cc = 43 OR cc = 45 + THEN scan sym CAT char; next char + FI; + IF is int + THEN process int + ELSE err (char, 63, 0) + FI + FI. + + process int : + WHILE is int REP + scan sym CAT char; + next char + END REP. + +is int : + cc >= 48 AND cc <= 57. + + process delimiter : + IF cc = -1 + THEN scan sym := "EOL"; scan type := eol + ELSE scan type := delimiter; + scan sym := char + FI; + pos INCR 1. + + next char : + pos INCR 1; char := buf SUB pos; cc := code (char). + + low : + IF cc >= 65 AND cc <= 90 + THEN code (cc + 32) + ELSE char + FI. +END PROC next sym; + +PROC scanner (TEXT CONST buf) : + main buf := buf; position := 1 +END PROC scanner; + +PROC next sym (TEXT VAR sym, INT VAR type) : + next sym (main buf, sym, type, position) +END PROC next sym; + +INT PROC scanpos : + position +END PROC scanpos + +END PACKET scan + + diff --git a/lang/dynamo/1.8.7/src/dyn.vec b/lang/dynamo/1.8.7/src/dyn.vec new file mode 100644 index 0000000..0554215 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.vec @@ -0,0 +1,209 @@ +PACKET vector DEFINES TAB, :=, vector, (* Autor : H.Indenbirken *) + SUB, LENGTH, laenge, norm, (* Stand : 24.09.81 *) + nilvector, replace, =, <>, wert, + +, -, *, /, + get, put : + +LET n = 4000; + +TYPE TAB = STRUCT (INT lng, TEXT elem); +TYPE INITTAB = STRUCT (INT lng, REAL value); + +INT VAR i; +TEXT VAR t :: "12345678"; +TAB VAR v :: nilvector; + + +REAL PROC wert (TAB CONST t, INT CONST i) : + t SUB i +END PROC wert; + +OP := (TAB VAR l, TAB CONST r) : + l.lng := r.lng; + l.elem := r.elem + +END OP :=; + +OP := (TAB VAR l, INITTAB CONST r) : + l.lng := r.lng; + replace (t, 1, r.value); + l.elem := r.lng * t + +END OP :=; + +INITTAB PROC nilvector : + vector (1, 0.0) + +END PROC nilvector; + +INITTAB PROC vector (INT CONST lng, REAL CONST value) : + IF lng <= 0 + THEN errorstop ("PROC vector : lng <= 0") FI; + INITTAB : (lng, value) + +END PROC vector; + +INITTAB PROC vector (INT CONST lng) : + vector (lng, 0.0) + +END PROC vector; + +REAL OP SUB (TAB CONST v, INT CONST i) : + test ("REAL OP SUB : ", v, i); + v.elem RSUB i + +END OP SUB; + +INT OP LENGTH (TAB CONST v) : + v.lng + +END OP LENGTH; + +INT PROC laenge (TAB CONST v) : + v.lng + +END PROC laenge; + +REAL PROC norm (TAB CONST v) : + REAL VAR result :: 0.0; + FOR i FROM 1 UPTO v.lng + REP result INCR ((v.elem RSUB i)**2) PER; + sqrt (result) . + +END PROC norm; + +PROC replace (TAB VAR v, INT CONST i, REAL CONST r) : + test ("PROC replace : ", v, i); + replace (v.elem, i, r) + +END PROC replace; + +BOOL OP = (TAB CONST l, r) : + l.elem = r.elem +END OP =; + +BOOL OP <> (TAB CONST l, r) : + l.elem <> r.elem +END OP <>; + +TAB OP + (TAB CONST v) : + v +END OP +; + +TAB OP + (TAB CONST l, r) : + test ("TAB OP + : ", l, r); + v := l; + FOR i FROM 1 UPTO v.lng + REP replace (v.elem, i, (l.elem RSUB i) + (r.elem RSUB i)) PER; + v + +END OP +; + +TAB OP - (TAB CONST a) : + v := a; + FOR i FROM 1 UPTO v.lng + REP replace (v.elem, i, - (a.elem RSUB i)) PER; + v + +END OP -; + +TAB OP - (TAB CONST l, r) : + test ("TAB OP - : ", l, r); + v := l; + FOR i FROM 1 UPTO v.lng + REP replace (v.elem, i, (l.elem RSUB i) - (r.elem RSUB i)) PER; + v +END OP -; + +REAL OP * (TAB CONST l, r) : + test ("REAL OP * : ", l, r); + REAL VAR x :: 0.0; + FOR i FROM 1 UPTO l.lng + REP x INCR ((l.elem RSUB i) * (r.elem RSUB i)) PER; + x + +END OP *; + +TAB OP * (TAB CONST v, REAL CONST r) : + r*v + +END OP *; + +TAB OP * (REAL CONST r, TAB CONST a) : + v := a; + FOR i FROM 1 UPTO v.lng + REP replace (v.elem, i, r*(a.elem RSUB i)) PER; + v + +END OP *; + +TAB OP / (TAB CONST a, REAL CONST r) : + v := a; + FOR i FROM 1 UPTO v.lng + REP replace (v.elem, i, (a.elem RSUB i)/r) PER; + v + +END OP /; + +TEXT VAR error :: ""; +PROC test (TEXT CONST proc, TAB CONST v, INT CONST i) : + IF i > v.lng + THEN error := proc; + error CAT "subscript overflow (LENGTH v="; + error CAT text (v.lng); + error CAT ", i="; + error CAT text (i); + error CAT ")"; + errorstop (error) + ELIF i < 1 + THEN error := proc; + error CAT "subscript underflow (i = "; + error CAT text (i); + error CAT ")"; + errorstop (error) + FI . + +END PROC test; + +PROC test (TEXT CONST proc, TAB CONST a, b) : + IF a.lng <> b.lng + THEN error := proc; + error CAT "LENGTH a ("; + IF a.lng <= 0 + THEN error CAT "undefined" + ELSE error CAT text (a.lng) FI; + error CAT ") <> LENGTH b ("; + error CAT text (b.lng); + error CAT ")"; + errorstop (error) + FI + +END PROC test; + +PROC get (TAB VAR v, INT CONST lng) : + v.lng := lng; + v.elem := lng * "12345678"; + REAL VAR x; + FOR i FROM 1 UPTO lng + REP get (x); + replace (v.elem, i, x) + PER . + +END PROC get; + +PROC put (TAB CONST v, INT CONST laenge, fracs) : + FOR i FROM 1 UPTO v.lng + REP put (text (v.elem RSUB i, laenge, fracs)) PER + +END PROC put; + +PROC put (TAB CONST v) : + FOR i FROM 1 UPTO v.lng + REP put (text (v.elem RSUB i)) PER + +END PROC put; + +END PACKET vector; + + + diff --git a/lang/dynamo/1.8.7/src/dyn.wachstum b/lang/dynamo/1.8.7/src/dyn.wachstum new file mode 100644 index 0000000..9f97bb9 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.wachstum @@ -0,0 +1,19 @@ +NOTE +NOTE Ein einfaches Modell des Bevoelkerungswachstums +NOTE +L BEVOELKERUNG.K=BEVOELKERUNG.J+DT*GEBURTENRATE.JK +N BEVOELKERUNG=ANFANGSBEVOELKERUNG +C ANFANGSBEVOELKERUNG=1000 +R GEBURTENRATE.KL=BEVOELKERUNG.K*WACHSTUMSFAKTOR +N GEBURTENRATE=10 +C WACHSTUMSFAKTOR=0.03 das heisst: 3 Prozent +NOTE +NOTE Simulationsparameter +NOTE +PLOT BEVOELKERUNG=B(1E3,9E4)/GEBURTENRATE=G(10,9E3) +C DT=1 +C PLTPER=5 +C LENGTH=300 + + + diff --git a/lang/dynamo/1.8.7/src/dyn.wasseröko b/lang/dynamo/1.8.7/src/dyn.wasseröko new file mode 100644 index 0000000..fe05881 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.wasseröko @@ -0,0 +1,64 @@ +n t=15 +note*** wasserökosystem nach abel und reich +note*** in: microextra 4/83 seite 34 ff +note************************************************************************ +note* hilfsgleichung fuer temperatur t +note* die zeit time in wochen + +a t.k=15+4*sin((time.k-10)*2*pi/52) temperatur t; time in wochen +c pi=3.1415 +note gleichung fuer phytoplankton p + +l p.k=p.j+dt*(p.j*(p1*n.j*t.j-p2*z.j)(100-p.j)/100) phytoplankton p +note gleichung fuer zooplankton z + +l z.k=z.j+dt*(z.j*(p3*t.j*p.j+p4*n.j-(p5*f.j+p6*b.j)-1/p.j)(30-z.j)/30) +note gleichung fuer fische f +l f.k=f.j+dt*(f.j*(p7*z.j-p8*b.j-p9/(z.j+p.j))(10-f.j)/10) + +note gleichung fuer raubfisch barsch b + +l b.k=b.j+dt*(b.j*(p10*f.j+p11*z.j-1/(p12*f.j))(0.1-b.j)/0.1) + +note **** gleichung fuer naehrstoffmenge n + +l n.k=n.j+dt*(p13-n.j*(p14*p.j-p15*z.j)) +note **** anfangswerte **************************************************** +n p=p0 +n z=z0 +n f=f0 +n b=b0 +n n=n0 +c p0=10 +c z0=3 +c f0=1 +c b0=0.01 +c n0=30 in kg/volumeneinheit bzw. Stück/volumeneinhe�[ +note ***** konstanten ******************************************************** +c p1=0.006 +c p2=1 +c p3=0.006 +c p4=0.03 +c p5=1 +c p6=100 +c p7=0.33 +c p8=100 +c p9=1E-4 +c p10=1 +c p11=1 +c p12=0.25 +c p13=10 +c p14=0.1 +c p15=0.2 +note **** simulationskonstanten ********************************************* +c dt=0.5 +c length=60 +c pltper=1 +note***** outputvariablen**************************************************** +a lp.k=ln(p.k/p0) +a lz.k=ln(z.k/z0) +a lf.k=ln(f.k/f0) +a lb.k=ln(b.k/b0) +a logn.k=ln(n.k/n0) +plot lp=p,lz=z,lf=f,lb=b,logn=n(-4,4) + diff --git a/lang/dynamo/1.8.7/src/dyn.welt-forrester b/lang/dynamo/1.8.7/src/dyn.welt-forrester new file mode 100644 index 0000000..c3f9789 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.welt-forrester @@ -0,0 +1,124 @@ +note weltmodell in der form fuer eumel dynamo 17.7.1987 +* WORLD DYNAMICS W5 +L p.k=p.j+(dt)*(br.jk-dr.jk) +N p=pi +C pi=1.65e9 +R br.kl=(p.k)*(clip(brn,brn1,swt1,time.k))*(brfm.k)*(brmm.k) +X *(brcm.k)*(brpm.k) +C brn=.04 +C brn1=.04 +C swt1=1970 +A brmm.k=tabhl(brmmt,msl.k,0,5,1) +T brmmt=1.2/1/.85/.75/.77/.7 +A msl.k=ecir.k/(ecirn) +C ecirn=1 +A ecir.k=(cir.k)*(1-ciaf.k)*(nrem.k)/(1-ciafn) +A nrem.k=table(nremt,nrfr.k,0,1,.25) +T nremt=0/.15/.5/.85/1 +A nrfr.k=nr.k/nri +L nr.k=nr.j+(dt)*(-nrur.jk) +N nr=nri +C nri=900e9 +R nrur.kl=(p.k)*(clip(nrun,nrun1,swt2,time.k))*(nrmm.k) +C nrun=1 +C nrun1=1 +C swt2=1970 +NOTE equation 42 connects here from eq. 4 to eq.9 +R dr.kl=(p.k)*(clip(drn,drn1,swt3,time.k))*(drmm.k)*(drpm.k) +X *(drfm.k)*(drcm.k) +C drn=.028 +C drn1=.028 +C swt3=1970 +A drmm.k=tabhl(drmmt,msl.k,0,5,.5) +T drmmt=3/1.8/.8/.7/.6/.53/.5/.5/.5/.5 +A drpm.k=table(drpmt,polr.k,0,60,10) +T drpmt=.92/1.3/2/3.2/4.8/6.8/9.2 +A drfm.k=tabhl(drfmt,fr.k,0,2,.25) +T drfmt=30/3/2/1.4/1/.7/.6/.5/.5 +A drcm.k=table(drcmt,cr.k,0,5,1) +T drcmt=.9/1/1.2/1.5/1.9/3 +A cr.k=(p.k)/(la*pdn) +C la=135e6 +C pdn=26.5 +A brcm.k=table(brcmt,cr.k,0,5,1) +T brcmt=1.05/1/.9/.7/.6/.55 < +A brfm.k=tabhl(brfmt,fr.k,0,4,1) +T brfmt=0/1/1.6/1.9/2 +A brpm.k=table(brpmt,polr.k,0,60,10) +T brpmt=1.02/.9/.7/.4/.25/.15/.1 +A fr.k=(fpci.k)*(fcm.k)*(fpm.k)*(clip(fc,fc1,swt7,time.k))/fn +C fc=1 +C fc1=1 +C fn=1 +C swt7=1970 +A fcm.k=table(fcmt,cr.k,0,5,1) +T fcmt=2.4/.6/.4/.3/.2 +A fpci.k=tabhl(fpcit,cira.k,0,6,1) +T fpcit=.5/1/1.4/1.7/1.9/2.05/2.2 +A cira.k=(cir.k)*(ciaf.k)/ciafn +C ciafn=.3 +A cir.k=(ci.k/p.k) +L ci.k=ci.j+(dt)*(cig.jk-cid.jk) +N ci=cii +C cii=.4e9 +R cig.kl=(p.k)*(cim.k)*(clip(cign,cign1,swt4,time.k)) +C cign=.05 +C cign1=.05 +C swt4=1970 +A cim.k=tabhl(cimt,msl.k,0,5,1) +T cimt=.1/1/1.8/2.4/2.8/3 +R cid.kl=(ci.k)*(clip(cidn,cidn1,swt5,time.k)) +C cidn=.025 +C cidn1=.025 +C swt5=1970 +A fpm.k=table(fpmt,polr.k,0,60,10) +T fpmt=1.02/.9/.65/.35/.2/.1/.05 +A polr.k=pol.k/pols +C pols=3.6e9 +L pol.k=pol.j+(dt)*(polg.jk-pola.jk) +N pol=poli +C poli=.2e9 +R polg.kl=(p.k)*(clip(poln,poln1,swt6,time.k))*(polcm.k) +C poln=1 +C poln1=1 +C swt6=1970 +A polcm.k=tabhl(polcmt,cir.k,0,5,1) +T polcmt=.05/1/3/5.4/7.4/8 +R pola.kl=pol.k/polat.k +A polat.k=table(polatt,polr.k,0,60,10) +T polatt=.6/2.5/8/11.5/15.5/20 +L ciaf.k=ciaf.j+(dt/ciaft)*((cfifr.j*ciqr.j)-ciaf.j) +N ciaf=ciaf1 +C ciaf1=.2 +C ciaft=15 +A cfifr.k=tabhl(cfifrt,fr.k,0,2,.5) +T cfifrt=1/.6/.3/.15/.1 +A ql.k=(qls)*(qlm.k)*(qlc.k)*(qlf.k)*(qlp.k) +C qls=1 +A qlm.k=tabhl(qlmt,msl.k,0,5,1) +T qlmt=.2/1/1.7/2.3/2.7/2.9 +A qlc.k=table(qlct,cr.k,0,5,.5) +T qlct=2/1.3/1/.75/.55/.45/.38/.3/.25/.22/.2 +A qlf.k=tabhl(qlft,fr.k,0,4,1) +T qlft=0/1/1.8/2.4/2.7 +A qlp.k=table(qlpt,polr.k,0,60,10) +T qlpt=1.04/.85/.6/.3/.15/.05/.02 +NOTE equation 42 located between eq. 4 and 9. +A nrmm.k=tabhl(nrmmt,msl.k,0,10,1) +T nrmmt=0/1/1.8/2.4/2.9/3.3/3.6/3.8/3.9/3.95/4 +NOTE input from eqn. 38 and 40 to eqn. 35 +A ciqr.k=tabhl(ciqrt,qlm.k/qlf.k,0,2,.5) +T ciqrt=.7/.8/1/1.5/2 +NOTE +NOTE control cards +NOTE +C dt=.1 +C length=2100 +N time=1900 +C prtper=4 +C pltper=4 +PLOT p=p(0,8e9)/polr=2(0,40)/ci=c(0,20e9)/ql=q(0,2)/nr=n(0,1e12) +note PLOT fr=f,msl=m,qlc=4,qlp=5(0,2)/ciaf=a(.2,.6) +PRINT p,nr,ci,pol,ciaf + + diff --git a/lang/dynamo/1.8.7/src/dyn.wohnen b/lang/dynamo/1.8.7/src/dyn.wohnen new file mode 100644 index 0000000..4e9b8b4 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.wohnen @@ -0,0 +1,105 @@ +note modell des wohnbaus in einer stadt +note +note siehe Goodman: Study Notes in System Dynamics, Seite 332 ff +note +note Bevölkerungs-Sektor +note +L pop.k=pop.j+dt*(imr.jk-omr.jk-ndr.jk) +N pop=popi +C popi=30.3 +note +note pop population (people) +note popi population initial value +note imr immigration rate (people/year) +note omr out-migration rate(people/year) +note +R imr.kl=nim*ammp.k*pop.k +C nim=.145 +note +note nim normal immigration (fraction/year) +note ammp attractiveness for migration multiplier perceived (dimensionless) +note +A ammp.k=smooth(amm.k,mpt) +C mpt=5 +note +note amm attractiveness for migration multiplier (dimensionless) +note mpt migrant perception time (years) +note +A amm.k=table(ammt,hr.k,0,2,.25) +T ammt=.05/.1/.2/.4/1/1.6/1.8/1.9/2 +note +note ammt attractiveness for migration multiplier table +note hr housing ratio (dimensionless) +note +A dmm.k=1/amm.k +note +note dmm departure migration multiplier (dimensionless) +note +R omr.kl=nom*dmm.k*pop.k +C nom=.02 +note +note nom normal out migration (fraction/year) +note +R ndr.kl=pop.k*drf +C drf=.025 +note +note ndr net death rate (people/year) +note drf death rate factor (fraction/year) +note************************************************************************* +note housing sector +note************************************************************************* +note +L h.k=h.j+dt*(hcr.jk-hdr.jk) +N h=hi +c hi=10 +note +note h housing (units) +note hcr housing construction rate (units/year) +note hdr housing demolition rate (units/year) +note hi initial value of houses (units) +note +R hcr.kl=nhc*hcm.k*lam.k*h.k +C nhc=.12 +note +note nhc normal housing construction (fraction/year) +note hcm housing construction multiplier (dimensionless) +note lam land availability multiplier (dimensionless) +note +A hcm.k=table(hcmt,hr.k,0,2,.25) +T hcmt=2.5/2.4/2.3/2/1/.37/.2/.1/.05 +note +A hr.k=h.k/hd.k +note +note hr housing ratio(dimensionless) +note hd housing desired (units) +note +A hd.k=pop.k*upp +C upp=.33 +note +note upp units per person (unit/person) +note +A lam.k=table(lamt,lfo.k,0,1,.25) +T lamt=1/.8/.5/.2/0 +note +note lfo land fraction occupied (dimensionless) +note +A lfo.k=H.k*lpu/land +C lpu=1 +C land=1500 +note +note lpu land per unit(acres/unit) +note land (acres) +note +R hdr.kl=h.k/alth +C alth=50 +note +note alth average lifetime of housing (years) +note*********************************************************************** +note control statements +note*********************************************************************** +note +plot h=h(0,2000)/pop=p(0,8000)/hcr=c,hdr=d(0,100) +C dt=1 +C length=200 +C pltper=2 + diff --git a/lang/dynamo/1.8.7/src/dyn.workfluc b/lang/dynamo/1.8.7/src/dyn.workfluc new file mode 100644 index 0000000..8016449 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.workfluc @@ -0,0 +1,44 @@ +NOTE +NOTE ******************************************************************* +NOTE MODEL OF WORKLOAD FLUCTUATIONS +NOTE ******************************************************************* +NOTE JOHN HENIZE 5.11.81 +NOTE ******************************************************************* +NOTE +L MM.K=MM.J+(DT)*(-MTR.J) MANPOWER IN MARKETING +N MM=4 MEN +L MP.K=MP.J+(DT)*(MTR.J) MANPOWER IN PRODUCTION +N MP=6 MEN +NOTE +L JIP.K=JIP.J+(DT)*(JS.J-JC.J) JOBS_IN_PROCESS +N JIP=6 JOBS +A JM.K=MM.K/MEJ JOBS MARKETED +C MEJ=2 MAN_MONTHS/JOB MARKETING EFFORT PER JOB +L JS.K=JS.J+(DT/SD)*(JM.J-JS.J) JOBS SOLD +N JS=JM +C SD=2 MONTH SALES DELAY +A JC.K=MP.K/AJS JOBS COMPLETED +C AJS=8 MAN_MONTH/JOB +NOTE +A MTR.K=(BA.K+PMA.K)*MTC.K MANPOWER TRANSFER RATE +A BA.K=MMJ*(JIP.K-DJIP) BACKLOG ADJUSTMENT +C DJIP=6 JOBS DESIRED JOBS IN PROCESS +C MMJ=.15 MEN PER MONTH PER JOB MEN REALLOCATED PER MONTH PER +NOTE +A MTC.K=CLIP(MMC.K,PMC.K,BA.K,0) MANPOWER TRANSFER CONSTRAINT +A MMC.K=MMR.K MARKETING MANPOWER CONSTRAINT +A MMR.K=MM.K/(MM.K+MP.K) MARKETING MANPOWER RATIO +A PMC.K=PMR.K*PMR.K PRODUCTION MANPOWER CONSTRAINT +A PMR.K=MP.K/(MM.K+MP.K) PRODUCTION MANPOWER RATIO +NOTE +A PMA.K=SWITCH(0,PMA1.K,SW) PRODUCTION MANPOWER ADJUSTMENT +C SW=0 +A PMA1.K=(DMP.K-MP.K)/MAT +A DMP.K=JS.K*AJS DESIRED MANPOWER IN PRODUCTION +C MAT=10 MONTHS MANPOWER ADJUSTMENT TIME +NOTE +C DT=.2 +C LENGTH=120 +C PLTPER=6 +PLOT MM=M,MP=P(0,10)/JIP=J(0,20) + diff --git a/lang/dynamo/1.8.7/src/dyn.wurzel b/lang/dynamo/1.8.7/src/dyn.wurzel new file mode 100644 index 0000000..7f8e6e0 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.wurzel @@ -0,0 +1,14 @@ +note theon von smyrnas verfahren +note +l uj.k=u.j +l u.k=u.j+2*v.j +l v.k=v.j+uj.j +n uj=1 +n u=1 +n v=1 +a wurzelzwei.k=u.k/v.k +print u,v,wurzelzwei +c dt=1 +c length=20 +c prtper=1 + diff --git a/lang/dynamo/1.8.7/src/out.world b/lang/dynamo/1.8.7/src/out.world new file mode 100644 index 0000000..39859ce --- /dev/null +++ b/lang/dynamo/1.8.7/src/out.world @@ -0,0 +1,43 @@ +PAGE 1 : WORLD DYNAMICS W5 +P=P(0,8E9)/POLR=2(0,40)/CI=C(0,20E9)/QL=Q(0,2)/NR=N(0,1000E9) + 0.0 2.000000e9 4.000000e9 6.000000e9 8.000000e9p + 0.0 10. 20. 30. 40.2 + 0.0 5.000000e9 1.000000e10 1.500000e10 2.000000e10c + 0.0 .5 1. 1.5 2.q + 0.0 2.500000e11 5.000000e11 7.500000e11 1.000000e12n +1900. 2c________p__.__q_________.____________._______n____. +1902. 2c p . q . . n . +1908. 2c p . q . . n . +1914. 2c p . q . . n . +1920. 2 c p. q . . n . +1926. 2_c__________p____________q____________.______n_____. +1932. 2 c .p .q . n . +1938. 2 c . p .q . n . +1944. 2 c . p . q . n . +1950. 2 c . p Ω§Ω§ . n . +1956. 2______c_____.______p_____.q___________.___n________. +1962. 2 c . p q . n . +1968. 2 c . p q. . n . +1974. .2 c . p. .n .q +1980. .2 c. q.p n . +1986. .2___________.c_________q_.__p_______n_.____________. +1992. . 2 . c q . p n . . +1998. . 2 . c q . p n . . +2004. .__2_________.____c_q_____._____np_____.____________. +2010. . 2 . c . n p . .q +2016. . 2 . q c . n p . . +2022. . 2 . q c . n p . . +2028. . 2 . q c n p . . +2034. ._____2______.___q____c_n_._______p____.____________. +2040. . 2 . q cn . p . . +2046. . 2 . q c . p . .n +2052. . 2 . q nc . p . . +2058. . 2 . q n c . p . . +2064. ._____2______.__q_n__c____.__p_________.____________. +2070. . 2 . q n c . p . . +2076. . 2 . qn c .p . . +2082. . 2 . qn c .p . . +2088. . 2 . q c p . .n +2094. .__2_________.qnc________p.____________.____________. +2100. . 2 .qc p . . .n + diff --git a/lang/dynamo/1.8.7/src/ruestungsgleichgewicht.const b/lang/dynamo/1.8.7/src/ruestungsgleichgewicht.const Binary files differnew file mode 100644 index 0000000..d38858b --- /dev/null +++ b/lang/dynamo/1.8.7/src/ruestungsgleichgewicht.const diff --git a/lang/dynamo/1.8.7/src/stabileruestung.const b/lang/dynamo/1.8.7/src/stabileruestung.const Binary files differnew file mode 100644 index 0000000..9d64330 --- /dev/null +++ b/lang/dynamo/1.8.7/src/stabileruestung.const |