"SfR Fresh" - the SfR Freeware/Shareware Archive 
Member "eas3pkg/eas3pkg/eas3/eas3scalaropmod.F90" of archive eas3pkg_v1.6.3.tar.gz:
As a special service "SfR Fresh" has tried to format the requested source page into HTML format using (guessed) Fortran 90 source code syntax highlighting with prefixed line numbers.
Alternatively you can here view or download the uninterpreted source code file.
That can be also achieved for any archive member file by clicking within an archive contents listing on the first character of the file(path) respectively on the according byte size field.
1 !-------------------------------------------------------------------------------------------------------!
2 ! EAS3 License !
3 ! !
4 ! Copyright (c) 2006 Institut fuer Aerodynamik und Gasdynamik, Universitaet Stuttgart !
5 ! !
6 ! Permission is hereby granted, free of charge, to any person obtaining a copy of this software and !
7 ! associated documentation files (the "Software"), to deal in the Software without restriction, !
8 ! including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, !
9 ! and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, !
10 ! subject to the following conditions: !
11 ! !
12 ! The above copyright notice and this permission notice shall be included in all copies or substantial !
13 ! portions of the Software. !
14 ! !
15 ! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT !
16 ! LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. !
17 ! IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER !
18 ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION !
19 ! WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. !
20 !-------------------------------------------------------------------------------------------------------!
21 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
22 ! skalare Operationen auf einer Datei unter Beruecksichtigung eines Eingabefensters.
23 !
24 ! KOPIEREN, ABS, LOG, LN, SCALETRANS, EXP, POW10, SQR, SQRT, CLIP, FT_SCALERE,
25 ! ATAN
26 !
27 ! Optionen:
28 ! - Beruecksichtigung von Eingabefenster
29 ! - Schreibformat unterstuetzt
30 ! - verschiedene skalare Operationen die (abgesehen vom Fenster) die Anzahl der
31 ! Elemente des Ausgabeparameters nicht veraendern
32 !
33 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
34 !
35 ! Daniel Meyer 07 + 10/99 + 01/00, David Eller 07/99 + 09/99, Giuseppe Bonfigli 04/2000
36
37 module eas3scalaropmod
38
39 ! baselib
40 use kinddef
41 use iso_varying_string
42 use messagemod
43 ! eas3
44 use eas3constdef
45 use eas3typedef
46 use parsermod
47 use eas3rwmod
48 use eas3toolmod
49 use eas3fttoolmod, only:edit_ft, editop_ft, editopreorder_ft, update_ft, &
50 &getft_ft, setskip_ft, &
51 &testftinfo_ft, testgfin_ft, testwin_ft
52
53 implicit none
54
55 private
56
57 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
58 ! Typdefinition zur Verwendung in scalarop_prg (KOPIEREN, ABS, LOG, LN, SCALETRANS,
59 ! FT_SCALERE)
60 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
61
62 type scalarop_t
63
64 type (varying_string) :: operation ! Operation die durchgefuehrt werden soll
65 ! (KOPIEREN, ABS, LN, LOG, SCALETRANS,
66 ! EXP, POW10, SQR, SQRT, CLIP,ATAN)
67 logical(lk) :: nonlin_allowed ! .false. -> Nichtlineare Operationen four Fourier
68 ! Koeffizienten nicht zugelassen
69 ! .true. -> Nichtlineare Operationen four Fourier
70 ! Koeffizienten zugelassen
71 real(rk) :: fact ! Skalierfaktor fuer SCALETRANS
72 real(rk) :: offset ! Offset fuer SCALETRANS
73 real(rk) :: eps ! Epsilon fuer LN/LOG-Operationen
74 integer(ik) :: scalere ! Index fuer den Scalierungsfaktor in FT_SCALERE
75 ! 1 -> 1/RE, 2 -> RE, 3 -> SQRT(1/RE),
76 ! 4 -> SQRT(RE)
77 real(rk) :: lowerbound ! untere Grenze fuer Clipping
78 real(rk) :: upperbound ! obere Grenze fuer Clipping
79
80 end type scalarop_t
81
82
83 ! Fehlerstrings
84 character(LEN=*), parameter :: kopieren_cmd_msg=&
85 "$S$ kopieren_cmd&
86 &$E$ Genau ein Argument (EIN|AUS) erwartet.&
87 &$E$ Nur ein ausfuehrbares Programm innerhalb eines AUSFUEHREN-Blockes erlaubt."
88
89 character(LEN=*), parameter :: abs_cmd_msg=&
90 "$S$ abs_cmd&
91 &$E$ Kein Argument erwartet.&
92 &$E$ Nur ein ausfuehrbares Programm innerhalb eines AUSFUEHREN-Blockes erlaubt."
93
94 character(LEN=*), parameter :: ln_cmd_msg=&
95 "$S$ ln_cmd&
96 &$E$ Genau ein Argument (EPS) erwartet.&
97 &$E$ Nur ein ausfuehrbares Programm innerhalb eines AUSFUEHREN-Blockes erlaubt."
98
99 character(LEN=*), parameter :: log_cmd_msg=&
100 "$S$ log_cmd&
101 &$E$ Genau ein Argument (EPS) erwartet.&
102 &$E$ Nur ein ausfuehrbares Programm innerhalb eines AUSFUEHREN-Blockes erlaubt."
103
104 character(LEN=*), parameter :: scalere_cmd_msg=&
105 "$S$ scalere_cmd&
106 &$E$ Genau ain Argument erwartet.&
107 &$E$ Nur ein ausfuehrbares Programm innerhalb eines AUSFUEHREN-Blockes erlaubt."
108
109 character(LEN=*), parameter :: scaletrans_cmd_msg=&
110 "$S$ scaletrans_cmd&
111 &$E$ Genau zwei Argumente (FACT, OFFSET) erwartet.&
112 &$E$ Nur ein ausfuehrbares Programm innerhalb eines AUSFUEHREN-Blockes erlaubt."
113
114 character(LEN=*), parameter :: scalarop_prg_msg=&
115 "$S$ scalarop_prg&
116 &$E$ Es ist genau eine Eingabedatei und eine Ausgabedatei erforderlich.&
117 &$E$ Nicht genug freier Speicher fuer die Allokierung der Parameterfelder.&
118 &$E$ Unbekannte Skalaroperation.&
119 &$E$ Fehler beim Deallokieren des Speichers fuer die Parameterfelder.&
120 &$E$ Bei FT_SCALERE muss ftinfo%re definiert und >= 1.E-6 sein.&
121 &$E$ Argument von SQRT < 0. nicht erlaubt."
122
123 character(LEN=*), parameter :: exp_cmd_msg=&
124 "$S$ exp_cmd&
125 &$E$ Kein Argument erwartet.&
126 &$E$ Nur ein ausfuehrbares Programm innerhalb eines AUSFUEHREN-Blockes erlaubt."
127
128 character(LEN=*), parameter :: pow10_cmd_msg=&
129 "$S$ pow10_cmd&
130 &$E$ Kein Argument erwartet.&
131 &$E$ Nur ein ausfuehrbares Programm innerhalb eines AUSFUEHREN-Blockes erlaubt."
132
133 character(LEN=*), parameter :: sqr_cmd_msg=&
134 "$S$ sqr_cmd&
135 &$E$ Kein oder ein Argument erwartet.&
136 &$E$ Nur ein ausfuehrbares Programm innerhalb eines AUSFUEHREN-Blockes erlaubt."
137
138 character(LEN=*), parameter :: sqrt_cmd_msg=&
139 "$S$ sqrt_cmd&
140 &$E$ Kein oder ein Argument erwartet.&
141 &$E$ Nur ein ausfuehrbares Programm innerhalb eines AUSFUEHREN-Blockes erlaubt."
142
143 character(LEN=*), parameter :: clip_cmd_msg=&
144 "$S$ clip_cmd&
145 &$E$ Zwei oder drei Argumente erwartet.&
146 &$E$ LBOUND <= UBOUND erwartet.&
147 &$E$ Nur ein ausfuehrbares Programm innerhalb eines AUSFUEHREN-Blockes erlaubt."
148
149 character(LEN=*), parameter :: atan_cmd_msg=&
150 "$S$ atan_cmd&
151 &$E$ Kein Argument erwartet.&
152 &$E$ Nur ein ausfuehrbares Programm innerhalb eines AUSFUEHREN-Blockes erlaubt."
153
154 character(LEN=*), parameter :: transks_scalarop_msg=&
155 "$S$ transks_scalarop&
156 &$E$ Nichtlineare Operationen fuer nur fuer Amplituden von Fourier-Koeff zugelassen."
157
158
159 character(LEN=*), parameter :: eas3scalaropmod_msg = kopieren_cmd_msg // abs_cmd_msg // &
160 ln_cmd_msg // log_cmd_msg // scalere_cmd_msg // scaletrans_cmd_msg // &
161 scalarop_prg_msg // exp_cmd_msg // &
162 pow10_cmd_msg // sqr_cmd_msg // sqrt_cmd_msg // clip_cmd_msg // atan_cmd_msg // &
163 transks_scalarop_msg
164
165 ! exportierte Symbole
166 public :: scalarop_t, eas3scalaropmod_msg, kopieren_cmd, abs_cmd, ln_cmd, log_cmd, &
167 scalere_cmd, scaletrans_cmd, exp_cmd, pow10_cmd, sqr_cmd, sqrt_cmd, &
168 clip_cmd, atan_cmd, scalarop_prg, scalarop_init, scalarop_print
169
170 contains
171
172 subroutine scalarop_init(scalarop)
173 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
174 ! Zweck: Initial the default value of SCALAROP
175 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
176 type (scalarop_t), intent(out) :: scalarop
177
178 scalarop%operation=''
179 scalarop%nonlin_allowed=.false.
180 scalarop%fact=1.0
181 scalarop%offset=0.0
182 scalarop%eps=0.0
183 scalarop%scalere = 0
184 scalarop%lowerbound=0.0
185 scalarop%upperbound=0.0
186
187 end subroutine scalarop_init
188
189 subroutine scalarop_print(scalarop)
190 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
191 ! Zweck: Initial the default value of SCALAROP
192 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
193 type (scalarop_t), intent(in) :: scalarop
194
195 write(*,*) "scalarop%operation=",char(scalarop%operation)
196 write(*,*) "scalarop%fact=",scalarop%fact
197 write(*,*) "scalarop%offset=",scalarop%offset
198 write(*,*) "scalarop%eps=",scalarop%eps
199 write(*,*) "scalarop%scalere=",scalarop%scalere
200 write(*,*) "scalarop%lowerbound=",scalarop%lowerbound
201 write(*,*) "scalarop%upperbound=",scalarop%upperbound
202 write(*,*)
203
204 end subroutine scalarop_print
205
206
207 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
208 subroutine kopieren_cmd(prg,scalarop,arglist,line,interaktiv,status)
209 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
210 ! Kommando: KOPIEREN, EIN | AUS schaltet Kopierprogramm ein oder aus
211 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
212 type (prg_t), intent(inout) :: prg ! Progammzaehler/Zwischenspeicher fuer ausfuehrbare
213 ! Programme
214 type (scalarop_t), intent(inout) :: scalarop ! Flag und Parameter fuer Skalaroperation
215 type (varying_string), intent(in) :: arglist ! Argumentliste
216 integer(ik), intent(in) :: line ! Zeilennummer der aktuell verarbeiten Zeile
217 logical(lk), intent(in) :: interaktiv ! Flag fuer Interaktivbetrieb
218 integer(ik), intent(out) :: status ! Status-Flag
219 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
220
221 integer(ik) :: pos, lstat, anzargs, argnr
222 type(varying_string) :: token
223 type(varying_string) :: args
224
225
226 ! Argumentliste auf args Kopieren
227 args=arglist
228
229 ! Anzahl der Argumente bestimmen
230 anzargs=counttoken(args)
231 if (anzargs/=1) then ! genau ein Argument (EIN|AUS) erwartet
232 status=-1
233 return
234 endif
235
236 ! Schluesselwort ueberpruefen und ggfalls Modus umschalten
237 argnr=1
238 call get_token(args,token)
239 pos=get_key(token,"EIN,AUS",lstat)
240 call message_check("get_key",lstat,interaktiv,line,argnr)
241 if (pos==1) then
242 ! Kopieren wird nur bei Option EIN aktiviert
243 prg%nprg=prg%nprg+1
244 prg%prgname="KOPIEREN"
245 scalarop%operation="KOPIEREN"
246 endif
247
248 if (prg%nprg>1) then
249 ! nur ein ausfuehrbares Programm innerhalb eines AUSFUEHREN-Blockes erlaubt
250 status=-2
251 return
252 endif
253
254 ! keine Fehler
255 status=0
256
257 end subroutine kopieren_cmd
258
259 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
260 subroutine abs_cmd(prg,scalarop,arglist,line,interaktiv,status)
261 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
262 ! Kommando: ABS schaltet Betrag bilden ein
263 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
264 type (prg_t), intent(inout) :: prg ! Progammzaehler/Zwischenspeicher fuer ausfuehrbare
265 ! Programme
266 type (scalarop_t), intent(inout) :: scalarop ! Flag und Parameter fuer Skalaroperation
267 type (varying_string), intent(in) :: arglist ! Argumentliste
268 integer(ik), intent(in) :: line ! Zeilennummer der aktuell verarbeiten Zeile
269 logical(lk), intent(in) :: interaktiv ! Flag fuer Interaktivbetrieb
270 integer(ik), intent(out) :: status ! Status-Flag
271 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
272
273 integer(ik) :: anzargs
274 type(varying_string) :: args
275
276 ! Argumentliste auf args Kopieren
277 args=arglist
278
279 ! Anzahl der Argumente bestimmen
280 anzargs=counttoken(args)
281 if (anzargs/=0) then ! kein Argument erwartet
282 status=-1
283 return
284 endif
285
286 ! ABS aktivieren
287 prg%nprg=prg%nprg+1
288 prg%prgname="ABS"
289 scalarop%operation="ABS"
290
291 if (prg%nprg>1) then
292 ! nur ein ausfuehrbares Programm innerhalb eines AUSFUEHREN-Blockes erlaubt
293 status=-2
294 return
295 endif
296
297 ! keine Fehler
298 status=0
299
300 end subroutine abs_cmd
301
302
303
304 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
305 subroutine ln_cmd(prg,scalarop,arglist,line,interaktiv,status)
306 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
307 ! Kommando: LN, EPS schaltet Programm zum Logarithmieren ein
308 ! berechnet wird log(abs(f)+eps)
309 ! eps wird dazuaddiert, um ev. vorandene Nullen zu umgehen
310 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
311 type (prg_t), intent(inout) :: prg ! Progammzaehler/Zwischenspeicher fuer ausfuehrbare
312 ! Programme
313 type (scalarop_t), intent(inout) :: scalarop ! Flag und Parameter fuer Skalaroperation
314 type (varying_string), intent(in) :: arglist ! Argumentliste
315 integer(ik), intent(in) :: line ! Zeilennummer der aktuell verarbeiten Zeile
316 logical(lk), intent(in) :: interaktiv ! Flag fuer Interaktivbetrieb
317 integer(ik), intent(out) :: status ! Status-Flag
318 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
319
320 integer(ik) :: lstat, anzargs, argnr
321 type(varying_string) :: token
322 type(varying_string) :: args
323
324
325 ! Argumentliste auf args Kopieren
326 args=arglist
327
328 ! Anzahl der Argumente bestimmen
329 anzargs=counttoken(args)
330 if (anzargs/=1) then ! genau ein Argument EPS erwartet
331 status=-1
332 return
333 endif
334
335 ! EPS einlesen
336 argnr=1
337 call get_token(args,token)
338 scalarop%eps=get_real(token,lstat)
339 call message_check("get_real",lstat,interaktiv,line,argnr)
340 ! Ln aktivieren
341 prg%nprg=prg%nprg+1
342 prg%prgname="LN"
343 scalarop%operation="LN"
344
345 if (prg%nprg>1) then
346 ! nur ein ausfuehrbares Programm innerhalb eines AUSFUEHREN-Blockes erlaubt
347 status=-2
348 return
349 endif
350
351 ! keine Fehler
352 status=0
353
354 end subroutine ln_cmd
355
356
357 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
358 subroutine log_cmd(prg,scalarop,arglist,line,interaktiv,status)
359 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
360 ! Kommando: LOG, EPS schaltet Programm zum Logarithmieren ein
361 ! berechnet wird log10(abs(f)+eps)
362 ! eps wird dazuaddiert, um ev. vorandene Nullen zu umgehen
363 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
364 type (prg_t), intent(inout) :: prg ! Progammzaehler/Zwischenspeicher fuer ausfuehrbare
365 ! Programme
366 type (scalarop_t), intent(inout) :: scalarop ! Flag und Parameter fuer Skalaroperation
367 type (varying_string), intent(in) :: arglist ! Argumentliste
368 integer(ik), intent(in) :: line ! Zeilennummer der aktuell verarbeiten Zeile
369 logical(lk), intent(in) :: interaktiv ! Flag fuer Interaktivbetrieb
370 integer(ik), intent(out) :: status ! Status-Flag
371 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
372
373 integer(ik) :: lstat, anzargs, argnr
374 type(varying_string) :: token
375 type(varying_string) :: args
376
377
378 ! Argumentliste auf args Kopieren
379 args=arglist
380
381 ! Anzahl der Argumente bestimmen
382 anzargs=counttoken(args)
383 if (anzargs/=1) then ! genau ein Argument EPS erwartet
384 status=-1
385 return
386 endif
387
388 ! EPS einlesen
389 argnr=1
390 call get_token(args,token)
391 scalarop%eps=get_real(token,lstat)
392 call message_check("get_real",lstat,interaktiv,line,argnr)
393 ! Log aktivieren
394 prg%nprg=prg%nprg+1
395 prg%prgname="LOG"
396 scalarop%operation="LOG"
397
398 if (prg%nprg>1) then
399 ! nur ein ausfuehrbares Programm innerhalb eines AUSFUEHREN-Blockes erlaubt
400 status=-2
401 return
402 endif
403
404 ! keine Fehler
405 status=0
406
407 end subroutine log_cmd
408
409 subroutine scalere_cmd(prg,scalarop,arglist,line,interaktiv,status)
410 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
411 ! Kommando: FT_SCALERE [,1/RE|RE|SQRT(1/RE)|SQRT(RE)] schaltet Programm zum Skalieren
412 ! mit der Reynoldszahl aus dem Inputfile
413 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
414 type (prg_t), intent(inout) :: prg ! Progammzaehler/Zwischenspeicher fuer ausfuehrbare
415 ! Programme
416 type (scalarop_t), intent(inout) :: scalarop ! Flag und Parameter fuer Skalaroperation
417 type (varying_string), intent(in) :: arglist ! Argumentliste
418 integer(ik), intent(in) :: line ! Zeilennummer der aktuell verarbeiten Zeile
419 logical(lk), intent(in) :: interaktiv ! Flag fuer Interaktivbetrieb
420 integer(ik), intent(out) :: status ! Status-Flag
421 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
422
423 integer(ik) :: lstat, anzargs, argnr
424 type(varying_string) :: token
425 type(varying_string) :: args
426
427
428 ! Argumentliste auf args Kopieren
429 args=arglist
430
431 ! Anzahl der Argumente bestimmen
432 anzargs=counttoken(args)
433 if (anzargs/=1) then ! genau ein Argument erwaerten
434 status=-1
435 return
436 endif
437
438 ! Skalierungsfaktor einlesen
439 argnr=1
440 call get_token(args,token)
441 scalarop%scalere=get_key(token,"1/RE,RE,SQRT(1/RE),SQRT(RE)",lstat)
442 call message_check("get_key",lstat,interaktiv,line,argnr)
443
444 ! Scalere aktivieren
445 prg%nprg=prg%nprg+1
446 prg%prgname="FT_SCALERE"
447 scalarop%operation="FT_SCALERE"
448
449 if (prg%nprg>1) then
450 ! nur ein ausfuehrbares Programm innerhalb eines AUSFUEHREN-Blockes erlaubt
451 status=-2
452 return
453 endif
454
455 ! keine Fehler
456 status=0
457
458 end subroutine scalere_cmd
459
460
461 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
462 subroutine scaletrans_cmd(prg,scalarop,arglist,line,interaktiv,status)
463 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
464 ! Kommando: SCALETRANS, FACT, OFFSET schaltet Programm zum Skalieren und Offset addieren
465 ! berechnet wird fact*f+offset
466 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
467 type (prg_t), intent(inout) :: prg ! Progammzaehler/Zwischenspeicher fuer ausfuehrbare
468 ! Programme
469 type (scalarop_t), intent(inout) :: scalarop ! Flag und Parameter fuer Skalaroperation
470 type (varying_string), intent(in) :: arglist ! Argumentliste
471 integer(ik), intent(in) :: line ! Zeilennummer der aktuell verarbeiten Zeile
472 logical(lk), intent(in) :: interaktiv ! Flag fuer Interaktivbetrieb
473 integer(ik), intent(out) :: status ! Status-Flag
474 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
475
476 integer(ik) :: lstat, anzargs, argnr
477 type(varying_string) :: token
478 type(varying_string) :: args
479
480
481 ! Argumentliste auf args Kopieren
482 args=arglist
483
484 ! Anzahl der Argumente bestimmen
485 anzargs=counttoken(args)
486 if (anzargs/=2) then ! genau zwei Argumente FACT, OFFSET erwartet
487 status=-1
488 return
489 endif
490
491 ! FACT einlesen
492 argnr=1
493 call get_token(args,token)
494 scalarop%fact=get_real(token,lstat)
495 call message_check("get_real",lstat,interaktiv,line,argnr)
496
497 ! OFFSET einlesen
498 argnr=1
499 call get_token(args,token)
500 scalarop%offset=get_real(token,lstat)
501 call message_check("get_real",lstat,interaktiv,line,argnr)
502
503 ! Scaletrans aktivieren
504 prg%nprg=prg%nprg+1
505 prg%prgname="SCALETRANS"
506 scalarop%operation="SCALETRANS"
507
508 if (prg%nprg>1) then
509 ! nur ein ausfuehrbares Programm innerhalb eines AUSFUEHREN-Blockes erlaubt
510 status=-2
511 return
512 endif
513
514 ! keine Fehler
515 status=0
516
517 end subroutine scaletrans_cmd
518
519
520 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
521 subroutine exp_cmd(prg,scalarop,arglist,line,interaktiv,status)
522 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
523 ! Kommando: EXP schaltet e-Funktion ein
524 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
525 type (prg_t), intent(inout) :: prg ! Progammzaehler/Zwischenspeicher fuer ausfuehrbare
526 ! Programme
527 type (scalarop_t), intent(inout) :: scalarop ! Flag und Parameter fuer Skalaroperation
528 type (varying_string), intent(in) :: arglist ! Argumentliste
529 integer(ik), intent(in) :: line ! Zeilennummer der aktuell verarbeiten Zeile
530 logical(lk), intent(in) :: interaktiv ! Flag fuer Interaktivbetrieb
531 integer(ik), intent(out) :: status ! Status-Flag
532 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
533
534 integer(ik) :: anzargs
535 type(varying_string) :: args
536
537 ! Argumentliste auf args Kopieren
538 args=arglist
539
540 ! Anzahl der Argumente bestimmen
541 anzargs=counttoken(args)
542 if (anzargs/=0) then ! kein Argument erwartet
543 status=-1
544 return
545 endif
546
547 ! EXP aktivieren
548 prg%nprg=prg%nprg+1
549 prg%prgname="EXP"
550 scalarop%operation="EXP"
551
552 if (prg%nprg>1) then
553 ! nur ein ausfuehrbares Programm innerhalb eines AUSFUEHREN-Blockes erlaubt
554 status=-2
555 return
556 endif
557
558 ! keine Fehler
559 status=0
560
561 end subroutine exp_cmd
562
563
564 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
565 subroutine pow10_cmd(prg,scalarop,arglist,line,interaktiv,status)
566 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
567 ! Kommando: POW10 schaltet Potenzierung von 10 ein
568 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
569 type (prg_t), intent(inout) :: prg ! Progammzaehler/Zwischenspeicher fuer ausfuehrbare
570 ! Programme
571 type (scalarop_t), intent(inout) :: scalarop ! Flag und Parameter fuer Skalaroperation
572 type (varying_string), intent(in) :: arglist ! Argumentliste
573 integer(ik), intent(in) :: line ! Zeilennummer der aktuell verarbeiten Zeile
574 logical(lk), intent(in) :: interaktiv ! Flag fuer Interaktivbetrieb
575 integer(ik), intent(out) :: status ! Status-Flag
576 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
577
578 integer(ik) :: anzargs
579 type(varying_string) :: args
580
581 ! Argumentliste auf args Kopieren
582 args=arglist
583
584 ! Anzahl der Argumente bestimmen
585 anzargs=counttoken(args)
586 if (anzargs/=0) then ! kein Argument erwartet
587 status=-1
588 return
589 endif
590
591 ! POW10 aktivieren
592 prg%nprg=prg%nprg+1
593 prg%prgname="POW10"
594 scalarop%operation="POW10"
595
596 if (prg%nprg>1) then
597 ! nur ein ausfuehrbares Programm innerhalb eines AUSFUEHREN-Blockes erlaubt
598 status=-2
599 return
600 endif
601
602 ! keine Fehler
603 status=0
604
605 end subroutine pow10_cmd
606
607
608 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
609 subroutine sqr_cmd(prg,scalarop,arglist,line,interaktiv,status)
610 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
611 ! Kommando: SQR [,NONLIN_ALLOWED] schaltet Quadrierung ein
612 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
613 type (prg_t), intent(inout) :: prg ! Progammzaehler/Zwischenspeicher fuer ausfuehrbare
614 ! Programme
615 type (scalarop_t), intent(inout) :: scalarop ! Flag und Parameter fuer Skalaroperation
616 type (varying_string), intent(in) :: arglist ! Argumentliste
617 integer(ik), intent(in) :: line ! Zeilennummer der aktuell verarbeiten Zeile
618 logical(lk), intent(in) :: interaktiv ! Flag fuer Interaktivbetrieb
619 integer(ik), intent(out) :: status ! Status-Flag
620 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
621
622 integer(ik) :: anzargs,argnr,dummy
623 integer(ik) :: lstat
624 type(varying_string) :: args,token
625
626 ! Argumentliste auf args Kopieren
627 args=arglist
628
629 ! Anzahl der Argumente bestimmen
630 anzargs=counttoken(args)
631 if (anzargs>1) then ! 0 oder 1 Argument erwartet
632 status=-1
633 return
634 endif
635
636 !Optional: Nichtlineare Operation auch fuer fourier Koeffizienten zulassen
637 if (anzargs>0) then
638
639 argnr=1
640 call get_token(args,token)
641 dummy=get_key(token,"NONLIN_ALLOWED",lstat)
642 call message_check("get_key",lstat,interaktiv,line,argnr)
643 scalarop%nonlin_allowed=.true.
644
645 endif
646
647 ! SQR aktivieren
648 prg%nprg=prg%nprg+1
649 prg%prgname="SQR"
650 scalarop%operation="SQR"
651
652 if (prg%nprg>1) then
653 ! nur ein ausfuehrbares Programm innerhalb eines AUSFUEHREN-Blockes erlaubt
654 status=-2
655 return
656 endif
657
658 ! keine Fehler
659 status=0
660
661 end subroutine sqr_cmd
662
663
664 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
665 subroutine sqrt_cmd(prg,scalarop,arglist,line,interaktiv,status)
666 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
667 ! Kommando: SQRT [, NONLIN_ALLOWED] schaltet Quadratwurzel ein
668 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
669 type (prg_t), intent(inout) :: prg ! Progammzaehler/Zwischenspeicher fuer ausfuehrbare
670 ! Programme
671 type (scalarop_t), intent(inout) :: scalarop ! Flag und Parameter fuer Skalaroperation
672 type (varying_string), intent(in) :: arglist ! Argumentliste
673 integer(ik), intent(in) :: line ! Zeilennummer der aktuell verarbeiten Zeile
674 logical(lk), intent(in) :: interaktiv ! Flag fuer Interaktivbetrieb
675 integer(ik), intent(out) :: status ! Status-Flag
676 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
677
678 integer(ik) :: anzargs,argnr,dummy
679 integer(ik) :: lstat
680 type(varying_string) :: args,token
681
682 ! Argumentliste auf args Kopieren
683 args=arglist
684
685 ! Anzahl der Argumente bestimmen
686 anzargs=counttoken(args)
687 if (anzargs>1) then ! 0 oder 1 Argument erwartet
688 status=-1
689 return
690 endif
691
692 !Optional: Nichtlineare Operation auch fuer fourier Koeffizienten zulassen
693 if (anzargs>0) then
694
695 argnr=1
696 call get_token(args,token)
697 dummy=get_key(token,"NONLIN_ALLOWED",lstat)
698 call message_check("get_key",lstat,interaktiv,line,argnr)
699 scalarop%nonlin_allowed=.true.
700
701 endif
702
703 ! SQRT aktivieren
704 prg%nprg=prg%nprg+1
705 prg%prgname="SQRT"
706 scalarop%operation="SQRT"
707
708 if (prg%nprg>1) then
709 ! nur ein ausfuehrbares Programm innerhalb eines AUSFUEHREN-Blockes erlaubt
710 status=-2
711 return
712 endif
713
714 ! keine Fehler
715 status=0
716
717 end subroutine sqrt_cmd
718
719
720 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
721 subroutine clip_cmd(prg,scalarop,arglist,line,interaktiv,status)
722 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
723 ! Kommando: CLIP, LBOUND, UBOUND [, NONLIN_ALLOWED]
724 ! schaltet Programm zum Clipping des Wertebereichs ein
725 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
726 type (prg_t), intent(inout) :: prg ! Progammzaehler/Zwischenspeicher fuer ausfuehrbare
727 ! Programme
728 type (scalarop_t), intent(inout) :: scalarop ! Flag und Parameter fuer Skalaroperation
729 type (varying_string), intent(in) :: arglist ! Argumentliste
730 integer(ik), intent(in) :: line ! Zeilennummer der aktuell verarbeiten Zeile
731 logical(lk), intent(in) :: interaktiv ! Flag fuer Interaktivbetrieb
732 integer(ik), intent(out) :: status ! Status-Flag
733 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
734
735 integer(ik) :: lstat, anzargs, argnr
736 integer(ik) :: dummy
737 type(varying_string) :: token
738 type(varying_string) :: args
739
740 ! Argumentliste auf args Kopieren
741 args=arglist
742
743 ! Anzahl der Argumente bestimmen
744 anzargs=counttoken(args)
745 if (anzargs/=2 .and. anzargs /=3) then ! zwei oder drei Argumente erwartet
746 status=-1
747 return
748 endif
749
750 ! LBOUND einlesen
751 argnr=1
752 call get_token(args,token)
753 scalarop%lowerbound=get_real(token,lstat)
754 call message_check("get_real",lstat,interaktiv,line,argnr)
755
756 ! UBOUND einlesen
757 argnr=1
758 call get_token(args,token)
759 scalarop%upperbound=get_real(token,lstat)
760 call message_check("get_real",lstat,interaktiv,line,argnr)
761
762 ! LBOUND<=UBOUND erwartet
763 if (scalarop%lowerbound>scalarop%upperbound) then
764 status=-2
765 return
766 endif
767
768 !Optional: Nichtlineare Operation auch fuer fourier Koeffizienten zulassen
769 if (anzargs==3) then
770
771 argnr=3
772 call get_token(args,token)
773 dummy=get_key(token,"NONLIN_ALLOWED",lstat)
774 call message_check("get_key",lstat,interaktiv,line,argnr)
775 scalarop%nonlin_allowed=.true.
776
777 endif
778
779 ! Clip aktivieren
780 prg%nprg=prg%nprg+1
781 prg%prgname="CLIP"
782 scalarop%operation="CLIP"
783
784 if (prg%nprg>1) then
785 ! nur ein ausfuehrbares Programm innerhalb eines AUSFUEHREN-Blockes erlaubt
786 status=-3
787 return
788 endif
789
790 ! keine Fehler
791 status=0
792
793 end subroutine clip_cmd
794
795 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
796 subroutine atan_cmd(prg,scalarop,arglist,line,interaktiv,status)
797 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
798 ! Kommando: ATAN Berechnung von atan(inputdata)
799 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
800 type (prg_t), intent(inout) :: prg ! Progammzaehler/Zwischenspeicher fuer ausfuehrbare
801 ! Programme
802 type (scalarop_t), intent(inout) :: scalarop ! Flag und Parameter fuer Skalaroperation
803 type (varying_string), intent(in) :: arglist ! Argumentliste
804 integer(ik), intent(in) :: line ! Zeilennummer der aktuell verarbeiten Zeile
805 logical(lk), intent(in) :: interaktiv ! Flag fuer Interaktivbetrieb
806 integer(ik), intent(out) :: status ! Status-Flag
807 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
808
809 integer(ik) :: anzargs
810 type(varying_string) :: args
811
812 ! Argumentliste auf args Kopieren
813 args=arglist
814
815 ! Anzahl der Argumente bestimmen
816 anzargs=counttoken(args)
817 if (anzargs/=0) then ! kein Argument erwartet
818 status=-1
819 return
820 endif
821
822 ! ATAN aktivieren
823 prg%nprg=prg%nprg+1
824 prg%prgname="ATAN"
825 scalarop%operation="ATAN"
826
827 if (prg%nprg>1) then
828 ! nur ein ausfuehrbares Programm innerhalb eines AUSFUEHREN-Blockes erlaubt
829 status=-2
830 return
831 endif
832
833 ! keine Fehler
834 status=0
835
836 end subroutine atan_cmd
837
838
839 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
840 subroutine scalarop_prg(flist,infile,outfile,ifw,bform,scalarop,ftinfo,status)
841 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
842 ! Zweck: skalare Operation auf einer EAS-Eingabedatei unter Beruecksichtigung des
843 ! Eingabefilters (KOPIEREN, ABS, LN, LOG, FT_SCALERE, SCALETRANS,
844 ! EXP, POW10, SQR, SQRT, CLIP, ATAN)
845 ! Der Wert "DRUCKEN" fuer scalarop%operation wird errkant. "DRUCKEN" wird nur von der
846 ! bei Aufruf von scalarop_prg von der Module eas3printmod bei ausfuehrung des Befehls
847 ! DRUCKEN uebergen. Es werden die Gleiche Operationen wie in KOPIEREN durchgefuehrt, nur
848 ! wird die Routine testwin_ft zum Testen der Konsisten des Eingabefenster fuer Richtungen
849 ! im Fourier-Raum nicht aufgerufen.
850 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
851 type (flist_t), dimension(1:EAS3ALLFILES), intent(inout) :: flist
852 type (filecmd_t), intent(in) :: infile, outfile
853 type (filewindow_t), intent(inout) :: ifw
854 type (bform_t), intent(in) :: bform
855 type (scalarop_t), intent(in) :: scalarop
856 type (ft_t), intent(inout) :: ftinfo !Informationen aus dem Benutzer-Def Feld
857 integer(ik), intent(out) :: status
858 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
859
860 ! lokale Variablen
861 integer(ik) :: infnr, outfnr ! Ein-/Ausgabedateinummer
862 integer(ik) :: inpardim, outpardim ! Dimensionen Ein-/Ausgabeparameter
863 integer(ik) :: lstat ! lokales Statusflag
864 integer(ik) :: iz, nz, ip, np, onz, onp ! Zaehler fuer Filterung
865 integer(ik) :: i ! Hilfszaehler
866 real(rk) :: faktscalere ! Hilfsvar fuer scalere
867 real(rk), dimension(:), allocatable :: data, fdata ! Felder fuer Ein-/Ausgabeparameter
868
869 character(LEN=80) :: ctmp
870
871 ! Anzahl Ein-/Ausgabefiles pruefen (jeweils genau eine Datei erforderlich)
872 if ( ((.not.(infile%set)).or.(infile%nfiles/=1)).or.&
873 ((.not.(outfile%set)).or.(outfile%nfiles/=1)) ) then
874 status=-1
875 return
876 endif
877
878 infnr=infile%fileind(1) ! Eingabedateinummer
879 outfnr=outfile%fileind(1) ! Ausgabedateinummer
880
881 ! Datenstruktur ifw vervollstaendigen (oeffnen der Eingabedatei, Kennsatz einlesen,
882 ! ifw vollstaendig belegen und Eingabedatei wieder schliessen)
883
884 call fwfill(flist, infnr, ifw)
885
886 ! Eingabekennsatz lesen (wird in flist abgelegt)
887 call ereadks(flist,infnr)
888
889 !Informationen aus dem Kensatzes des Inputfile (udef Feld)
890 call getft_ft(flist(infnr)%eas3ks,ftinfo)
891
892 ! Speicher fuer Eingabeparameter und reduzierten Ausgabeparameter allokieren
893 inpardim=flist(infnr)%eas3ks%ndim1*flist(infnr)%eas3ks%ndim2*flist(infnr)%eas3ks%ndim3
894 outpardim=ifw%ndim1*ifw%ndim2*ifw%ndim3
895
896 allocate(data(inpardim),fdata(outpardim),stat=lstat)
897
898 if (lst