summaryrefslogtreecommitdiff
path: root/lang/dynamo/1.8.7/src/dyn.proc
blob: a291a48679f1e7410bf694c614007ba6597a2a0f (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
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