Line data Source code
1 : !------------------------------------------------------------------------------
2 : ! Harmonized Emissions Component (HEMCO) !
3 : !------------------------------------------------------------------------------
4 : !BOP
5 : !
6 : ! !MODULE: interpreter
7 : !
8 : ! !DESCRIPTION: Module interpreter is a third-party module that parses and
9 : ! evaluates mathematical functions, e.g. 2*sin(MM).
10 : ! downloaded on May 12, 2017 from http://zeus.df.ufcg.edu.br/labfit/functionparser.htm
11 : !\\
12 : !\\
13 : !
14 : ! !REVISION HISTORY:
15 : ! 12 May 2017 - C. Keller - Modified for use in HEMCO: use hp instead of realkind.
16 : ! See https://github.com/geoschem/hemco for complete history
17 : !EOP
18 : !------------------------------------------------------------------------------
19 :
20 : !module functp_precision
21 : ! !Precision:
22 : ! !All real variables defaulted to double precision
23 : ! integer, parameter :: realkind = selected_real_kind(p=13,r=200)
24 : !end module functp_precision
25 :
26 : module interpreter
27 : !
28 : ! This module interprets the function, builds it to be evaluated
29 : ! next
30 : !
31 : !use functp_precision
32 : use hco_error_mod
33 :
34 : implicit none
35 :
36 : public :: init
37 : public :: evaluate
38 : public :: destroyfunc
39 :
40 : character(len=10), dimension(:), allocatable, private :: varnames
41 : character(len=255), dimension(:), allocatable, private :: stokens
42 : integer, dimension(:), allocatable, private :: operations
43 : integer, private :: n
44 : integer, private :: ntokens = 0
45 : character, dimension(:), pointer, private :: opaddsub !Operador
46 : integer, private :: isaddsub = 1
47 : character, dimension(:), pointer, private :: opmuldiv !Operador
48 : integer, private :: ismuldiv = 1
49 : character(len=255), private :: toke
50 : integer, private :: itoke = 1
51 : integer, private :: ioperations = 1
52 : integer, private :: numberk = 1
53 : real(kind=hp), dimension(:), pointer, private :: pdata
54 : real(kind=hp), dimension(:), pointer, private :: number
55 : character(len=5), public :: statusflagparser = 'ok'
56 :
57 : ! Need this to convert degrees to radians, because SIND, COSD, etc
58 : ! functions are not supported in GNU Fortran (bmy, 5/16/17)
59 : real(kind=hp), parameter, private :: PI_180 = 3.14159265358979323e+0
60 :
61 : contains
62 :
63 0 : subroutine init (func, variablenames, statusflag)
64 : !
65 : ! This subroutine shifts all characters of the function
66 : ! expression to lowercase and converts exponents signals ** to ^
67 : !
68 : character(len=*), intent(inout) :: func
69 : character(len=10), dimension(:), intent(inout) :: variablenames
70 : character(len=26) :: lower = 'abcdefghijklmnopqrstuvwxyz'
71 : character(len=26) :: upper = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
72 : integer :: i, k, funclen
73 : character(len=5), intent(out) :: statusflag
74 :
75 : !detects errors
76 0 : call identifica(func)
77 0 : call convert_b(func)
78 :
79 :
80 : !Shift all characters to lowercase and converts ** to ^
81 0 : funclen = len_trim(func)
82 0 : do i = 1, funclen
83 0 : k = index(upper,func(i:i))
84 0 : if ( k /= 0) then
85 0 : func(i:i) = lower(k:k)
86 : end if
87 0 : k = index(func,'**')
88 0 : if (k /= 0) then
89 0 : func = func(:k-1) // '^' // func(k+2:)
90 : end if
91 : end do
92 0 : call blanks(func)
93 0 : call recog_variables (func, variablenames)
94 0 : statusflag = statusflagparser
95 :
96 :
97 0 : end subroutine init
98 :
99 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
100 :
101 0 : subroutine recog_variables (func, variablenames)
102 : !
103 : ! This subroutine recognizes the variables and set their values
104 : !
105 : character(len=10), dimension(:), intent(in) :: variablenames
106 : character(len=*), intent(inout) :: func
107 :
108 0 : n = size(variablenames)
109 0 : allocate(varnames(n))
110 0 : varnames = variablenames
111 0 : call tokens_analyzer (func)
112 :
113 0 : end subroutine recog_variables
114 :
115 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
116 :
117 0 : subroutine tokens_analyzer (func)
118 : !
119 : ! This subroutine scans the func string storing its basic elements
120 : !
121 : character(len=*), intent(in) :: func
122 : character(len=11) :: numbers = '.0123456789'
123 : character(len=26) :: chars = 'abcdefghijklmnopqrstuvwxyz'
124 : character(len=7) :: operators = '+-*/^()'
125 : integer :: k = 1, i = 1
126 : integer :: irightbrackets = 1, ileftbrackets = 1
127 : logical :: status = .true.
128 :
129 0 : k = 1
130 0 : i = 1
131 0 : irightbrackets = 1
132 0 : ileftbrackets = 1
133 0 : ntokens = 0
134 0 : status = .true.
135 :
136 0 : do while (k <= len_trim(func))
137 : !It's a variable, or function name
138 0 : if (index(chars,func(k:k)) /= 0) then
139 0 : status = .true.
140 0 : do while (status)
141 0 : if (index(operators, func(k+1:k+1)) == 0 .and. func(k+1:k+1) /= ' ') then
142 0 : k = k + 1
143 : else
144 0 : status = .false.
145 0 : k = k + 1
146 : end if
147 : end do
148 0 : ntokens = ntokens + 1
149 :
150 : !It's a number
151 0 : else if (index(numbers,func(k:k)) /= 0) then
152 0 : status = .true.
153 0 : do while (status)
154 0 : if ((index(operators, func(k+1:k+1)) == 0 .and. func(k+1:k+1) /= ' ') .or. func(k+1:k+1) == 'e' .or. func(k+1:k+1) == 'd') then
155 0 : k = k + 1
156 : else
157 0 : if(func(k:k) == 'e' .or. func(k:k) == 'd') then
158 0 : k = k + 1
159 : else
160 0 : status = .false.
161 0 : k = k + 1
162 : end if
163 : end if
164 : end do
165 0 : ntokens = ntokens + 1
166 :
167 : !It's an operator or delimitator
168 : else
169 0 : k = k + 1
170 0 : ntokens = ntokens + 1
171 : end if
172 : end do
173 :
174 0 : allocate(stokens(ntokens))
175 :
176 0 : k = 1
177 : i = 1
178 :
179 0 : do while (k <= len_trim(func))
180 : !It's a variable, or function name
181 0 : if (index(chars,func(k:k)) /= 0) then
182 0 : stokens(i) = func(k:k)
183 0 : status = .true.
184 0 : do while (status)
185 0 : if (index(operators, func(k+1:k+1)) == 0 .and. func(k+1:k+1) /= ' ') then
186 0 : stokens(i) = trim(stokens(i)) // func(k+1:k+1)
187 0 : k = k + 1
188 : else
189 0 : status = .false.
190 0 : k = k + 1
191 0 : i = i + 1
192 : end if
193 : end do
194 :
195 : !It's a number
196 0 : else if (index(numbers,func(k:k)) /= 0) then
197 0 : stokens(i) = func(k:k)
198 0 : status = .true.
199 0 : do while (status)
200 0 : if ((index(operators, func(k+1:k+1)) == 0 .and. func(k+1:k+1) /= ' ') .or. func(k+1:k+1) == 'e' .or. func(k+1:k+1) == 'd') then
201 0 : stokens(i) = trim(stokens(i)) // func(k+1:k+1)
202 0 : k = k + 1
203 : else
204 0 : if(func(k:k) == 'e' .or. func(k:k) == 'd') then
205 0 : stokens(i) = trim(stokens(i)) // func(k+1:k+1)
206 0 : k = k + 1
207 : else
208 0 : status = .false.
209 0 : i = i + 1
210 0 : k = k + 1
211 : end if
212 : end if
213 : end do
214 :
215 : !It's an operator or delimitator
216 : else
217 0 : stokens(i) = func(k:k)
218 0 : if(stokens(i) == '(')then
219 0 : irightbrackets = irightbrackets + 1
220 0 : else if(stokens(i) == ')') then
221 0 : ileftbrackets = ileftbrackets + 1
222 : end if
223 0 : i = i + 1
224 0 : k = k + 1
225 : end if
226 : end do
227 :
228 0 : if (irightbrackets /= ileftbrackets) then
229 0 : statusflagparser = 'error'
230 0 : return
231 : end if
232 :
233 0 : itoke = 1
234 0 : isaddsub = 1
235 0 : ismuldiv = 1
236 0 : ioperations = 1
237 0 : numberk = 1
238 0 : toke = stokens(itoke)
239 0 : allocate(opaddsub(2))
240 0 : allocate(opmuldiv(2))
241 0 : allocate(number(ntokens))
242 0 : allocate(pdata(ntokens))
243 0 : allocate(operations(ntokens))
244 :
245 0 : call add_sub()
246 0 : ioperations = ioperations - 1
247 :
248 : end subroutine tokens_analyzer
249 :
250 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
251 : !The following subroutines call themselves recursively
252 : !to build the expression to be parsed based on an algorithm
253 : !called Recursive Descendent Parsing
254 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
255 :
256 0 : subroutine add_sub ()
257 : !
258 : ! Enter description here
259 : !
260 :
261 0 : call mul_div ()
262 :
263 0 : do while (trim(toke) == '+' .or. trim(toke) == '-')
264 0 : opaddsub(isaddsub) = trim(toke)
265 0 : isaddsub = isaddsub + 1
266 0 : itoke = itoke + 1
267 0 : toke = stokens(itoke)
268 0 : call mul_div()
269 :
270 0 : selectcase(opaddsub(isaddsub-1))
271 : case('+')
272 0 : isaddsub = isaddsub - 1
273 0 : operations(ioperations) = 3
274 0 : ioperations = ioperations + 1
275 :
276 : case('-')
277 0 : isaddsub = isaddsub - 1
278 0 : operations(ioperations) = 4
279 0 : ioperations = ioperations + 1
280 : end select
281 : end do
282 :
283 0 : end subroutine add_sub
284 :
285 0 : subroutine mul_div ()
286 : !
287 : ! Enter description here
288 : !
289 :
290 0 : call unary()
291 :
292 0 : do while (trim(toke) == '*' .or. trim(toke) == '/')
293 0 : opmuldiv(ismuldiv) = trim(toke)
294 0 : ismuldiv = ismuldiv + 1
295 0 : itoke = itoke + 1
296 0 : toke = stokens(itoke)
297 0 : call unary()
298 :
299 0 : selectcase(opmuldiv(ismuldiv-1))
300 : case('*')
301 0 : ismuldiv = ismuldiv - 1
302 0 : operations(ioperations) = 5
303 0 : ioperations = ioperations + 1
304 : case('/')
305 0 : ismuldiv = ismuldiv - 1
306 0 : operations(ioperations) = 6
307 0 : ioperations = ioperations + 1
308 : end select
309 : end do
310 :
311 0 : end subroutine mul_div
312 :
313 0 : subroutine unary()
314 : !
315 : ! Enter description here
316 : !
317 :
318 0 : if (trim(toke) == '-') then
319 0 : itoke = itoke + 1
320 0 : toke = stokens(itoke)
321 0 : call pow()
322 0 : operations(ioperations) = 2
323 0 : ioperations = ioperations + 1
324 0 : else if (trim(toke) == '+') then
325 0 : itoke = itoke + 1
326 0 : toke = stokens(itoke)
327 0 : call pow()
328 : else
329 0 : call pow()
330 : end if
331 :
332 0 : end subroutine unary
333 :
334 0 : subroutine pow ()
335 : !
336 : ! Enter description here
337 : !
338 :
339 0 : call functions()
340 :
341 0 : if (trim(toke) == '^') then
342 0 : itoke = itoke + 1
343 0 : toke = stokens(itoke)
344 0 : call functions()
345 0 : operations(ioperations) = 7
346 0 : ioperations = ioperations + 1
347 : end if
348 :
349 0 : end subroutine pow
350 :
351 0 : subroutine functions ()
352 : !
353 : ! Enter description here
354 : !
355 0 : if (trim(toke) == 'sin') then
356 0 : itoke = itoke + 1
357 0 : toke = stokens(itoke)
358 0 : call brackets()
359 0 : operations(ioperations) = 8
360 0 : ioperations = ioperations + 1
361 :
362 0 : else if(trim(toke) == 'cos') then
363 0 : itoke = itoke + 1
364 0 : toke = stokens(itoke)
365 0 : call brackets()
366 0 : operations(ioperations) = 9
367 0 : ioperations = ioperations + 1
368 :
369 0 : else if(trim(toke) == 'tan') then
370 0 : itoke = itoke + 1
371 0 : toke = stokens(itoke)
372 0 : call brackets()
373 0 : operations(ioperations) = 10
374 0 : ioperations = ioperations + 1
375 :
376 0 : else if(trim(toke) == 'asin') then
377 0 : itoke = itoke + 1
378 0 : toke = stokens(itoke)
379 0 : call brackets()
380 0 : operations(ioperations) = 11
381 0 : ioperations = ioperations + 1
382 :
383 0 : else if(trim(toke) == 'acos') then
384 0 : itoke = itoke + 1
385 0 : toke = stokens(itoke)
386 0 : call brackets()
387 0 : operations(ioperations) = 12
388 0 : ioperations = ioperations + 1
389 :
390 0 : else if(trim(toke) == 'atan') then
391 0 : itoke = itoke + 1
392 0 : toke = stokens(itoke)
393 0 : call brackets()
394 0 : operations(ioperations) = 13
395 0 : ioperations = ioperations + 1
396 :
397 0 : else if(trim(toke) == 'sinh') then
398 0 : itoke = itoke + 1
399 0 : toke = stokens(itoke)
400 0 : call brackets()
401 0 : operations(ioperations) = 14
402 0 : ioperations = ioperations + 1
403 :
404 0 : else if(trim(toke) == 'cosh') then
405 0 : itoke = itoke + 1
406 0 : toke = stokens(itoke)
407 0 : call brackets()
408 0 : operations(ioperations) = 15
409 0 : ioperations = ioperations + 1
410 :
411 0 : else if(trim(toke) == 'tanh') then
412 0 : itoke = itoke + 1
413 0 : toke = stokens(itoke)
414 0 : call brackets()
415 0 : operations(ioperations) = 16
416 0 : ioperations = ioperations + 1
417 :
418 0 : else if(trim(toke) == 'sind') then
419 0 : itoke = itoke + 1
420 0 : toke = stokens(itoke)
421 0 : call brackets()
422 0 : operations(ioperations) = 17
423 0 : ioperations = ioperations + 1
424 :
425 0 : else if(trim(toke) == 'cosd') then
426 0 : itoke = itoke + 1
427 0 : toke = stokens(itoke)
428 0 : call brackets()
429 0 : operations(ioperations) = 18
430 0 : ioperations = ioperations + 1
431 :
432 0 : else if(trim(toke) == 'tand') then
433 0 : itoke = itoke + 1
434 0 : toke = stokens(itoke)
435 0 : call brackets()
436 0 : operations(ioperations) = 19
437 0 : ioperations = ioperations + 1
438 :
439 0 : else if (trim(toke) == 'log') then
440 0 : itoke = itoke + 1
441 0 : toke = stokens(itoke)
442 0 : call brackets()
443 0 : operations(ioperations) = 20
444 0 : ioperations = ioperations + 1
445 :
446 0 : else if (trim(toke) == 'log10') then
447 0 : itoke = itoke + 1
448 0 : toke = stokens(itoke)
449 0 : call brackets()
450 0 : operations(ioperations) = 21
451 0 : ioperations = ioperations + 1
452 :
453 0 : else if (trim(toke) == 'nint') then
454 0 : itoke = itoke + 1
455 0 : toke = stokens(itoke)
456 0 : call brackets()
457 0 : operations(ioperations) = 22
458 0 : ioperations = ioperations + 1
459 :
460 0 : else if (trim(toke) == 'anint') then
461 0 : itoke = itoke + 1
462 0 : toke = stokens(itoke)
463 0 : call brackets()
464 0 : operations(ioperations) = 23
465 0 : ioperations = ioperations + 1
466 :
467 0 : else if (trim(toke) == 'aint') then
468 0 : itoke = itoke + 1
469 0 : toke = stokens(itoke)
470 0 : call brackets()
471 0 : operations(ioperations) = 24
472 0 : ioperations = ioperations + 1
473 :
474 0 : else if (trim(toke) == 'exp') then
475 0 : itoke = itoke + 1
476 0 : toke = stokens(itoke)
477 0 : call brackets()
478 0 : operations(ioperations) = 25
479 0 : ioperations = ioperations + 1
480 :
481 0 : else if (trim(toke) == 'sqrt') then
482 0 : itoke = itoke + 1
483 0 : toke = stokens(itoke)
484 0 : call brackets()
485 0 : operations(ioperations) = 26
486 0 : ioperations = ioperations + 1
487 :
488 0 : else if (trim(toke) == 'abs') then
489 0 : itoke = itoke + 1
490 0 : toke = stokens(itoke)
491 0 : call brackets()
492 0 : operations(ioperations) = 27
493 0 : ioperations = ioperations + 1
494 :
495 0 : else if (trim(toke) == 'floor') then
496 0 : itoke = itoke + 1
497 0 : toke = stokens(itoke)
498 0 : call brackets()
499 0 : operations(ioperations) = 28
500 0 : ioperations = ioperations + 1
501 :
502 : else
503 0 : call brackets()
504 :
505 : end if
506 :
507 0 : end subroutine functions
508 :
509 0 : subroutine brackets()
510 : !
511 : ! Enter description here
512 : !
513 0 : if (trim(toke) == '(') then
514 0 : itoke = itoke + 1
515 0 : toke = stokens(itoke)
516 0 : call add_sub()
517 0 : if (trim(toke) /= ')') then
518 0 : statusflagparser = 'error'
519 0 : return
520 : end if
521 0 : if (itoke < ntokens) then
522 0 : itoke = itoke + 1
523 0 : toke = stokens(itoke)
524 : end if
525 0 : if (trim(toke) == '(') then
526 0 : statusflagparser = 'error'
527 0 : return
528 : end if
529 : else
530 0 : call recog_vars ()
531 : end if
532 :
533 : end subroutine brackets
534 :
535 0 : subroutine recog_vars ()
536 : !
537 : ! Enter description here
538 : !
539 :
540 : integer :: i
541 : integer :: ierror
542 : character(len=7) :: operators = '+-*/^()'
543 :
544 : !Expression has an error
545 0 : if (index(operators, trim(toke)) /= 0) then
546 0 : statusflagparser = 'error'
547 0 : return
548 : end if
549 :
550 0 : do i = 1, n
551 : !It's a variable
552 0 : if (trim(toke) == varnames(i)) then
553 0 : operations(ioperations) = 28+i
554 0 : ioperations = ioperations + 1
555 0 : if (itoke < ntokens) then
556 0 : itoke = itoke + 1
557 0 : toke = stokens(itoke)
558 : end if
559 0 : return
560 : end if
561 : end do
562 :
563 : !It's a number
564 0 : toke = trim(toke)
565 0 : read(toke, *, iostat = ierror) number(numberk)
566 0 : if (ierror /= 0) then
567 0 : statusflagparser = 'error'
568 0 : return
569 : else
570 0 : operations(ioperations) = 1
571 0 : ioperations = ioperations + 1
572 0 : if (itoke < ntokens) then
573 0 : itoke = itoke + 1
574 0 : toke = stokens(itoke)
575 : end if
576 0 : numberk = numberk + 1
577 : end if
578 :
579 : end subroutine recog_vars
580 :
581 :
582 0 : function evaluate (vars) result (answer)
583 :
584 : !
585 : ! This function will evaluate the expression supplied
586 : !
587 :
588 : real(kind = hp), dimension(:), intent(in) :: vars
589 : real(kind = hp) :: answer
590 : integer :: st = 0
591 : integer :: dt = 1
592 : integer :: i
593 :
594 0 : st = 0
595 0 : dt = 1
596 :
597 0 : do i = 1, ioperations
598 0 : select case(operations(i))
599 : case (1)
600 0 : st = st + 1
601 0 : pdata(st) = number(dt)
602 0 : dt = dt + 1
603 : case (2)
604 0 : pdata(st) = - pdata(st)
605 : case (3)
606 0 : pdata(st-1) = pdata(st-1) + pdata(st)
607 0 : st = st - 1
608 : case (4)
609 0 : pdata(st-1) = pdata(st-1) - pdata(st)
610 0 : st = st - 1
611 : case (5)
612 0 : pdata(st-1) = pdata(st-1) * pdata(st)
613 0 : st = st - 1
614 : case (6)
615 0 : pdata(st-1) = pdata(st-1) / pdata(st)
616 0 : st = st - 1
617 : case (7)
618 0 : pdata(st-1) = pdata(st-1) ** pdata(st)
619 0 : st = st - 1
620 : case (8)
621 0 : pdata(st) = sin(pdata(st))
622 : case (9)
623 0 : pdata(st) = cos(pdata(st))
624 : case (10)
625 0 : pdata(st) = tan(pdata(st))
626 : case (11)
627 0 : pdata(st) = asin(pdata(st))
628 : case (12)
629 0 : pdata(st) = acos(pdata(st))
630 : case (13)
631 0 : pdata(st) = atan(pdata(st))
632 : case (14)
633 0 : pdata(st) = sinh(pdata(st))
634 : case (15)
635 0 : pdata(st) = cosh(pdata(st))
636 : case (16)
637 0 : pdata(st) = tanh(pdata(st))
638 : case (17)
639 0 : pdata(st) = sin(pdata(st)*PI_180) ! Equivalent to SIND (bmy, 5/16/17)
640 : case (18)
641 0 : pdata(st) = cos(pdata(st)*PI_180) ! Equivalent to COSD (bmy, 5/16/17)
642 : case (19)
643 0 : pdata(st) = tan(pdata(st)*PI_180) ! Equivalent to TAND (bmy, 5/16/17)
644 : case (20)
645 0 : pdata(st) = log(pdata(st))
646 : case (21)
647 0 : pdata(st) = log10(pdata(st))
648 : case (22)
649 0 : pdata(st) = nint(pdata(st))
650 : case (23)
651 0 : pdata(st) = anint(pdata(st))
652 : case (24)
653 0 : pdata(st) = aint(pdata(st))
654 : case (25)
655 0 : pdata(st) = exp(pdata(st))
656 : case (26)
657 0 : pdata(st) = sqrt(pdata(st))
658 : case (27)
659 0 : pdata(st) = abs(pdata(st))
660 : case (28)
661 0 : pdata(st) = floor(pdata(st))
662 : case default
663 0 : st = st + 1
664 0 : pdata(st) = vars(operations(i)-28)
665 : end select
666 : end do
667 :
668 0 : answer = pdata(1)
669 :
670 0 : end function evaluate
671 :
672 :
673 0 : function evaluate_detalhes (vars) result (answer)
674 : !
675 : ! This function will evaluate the expression supplied
676 : !
677 :
678 : real(kind = hp), dimension(:), intent(in) :: vars
679 : real(kind = hp) :: answer
680 : integer :: st = 0
681 : integer :: dt = 1
682 : integer :: i
683 :
684 0 : st = 0
685 0 : dt = 1
686 :
687 0 : do i = 1, ioperations
688 0 : select case(operations(i))
689 :
690 : case (1)
691 0 : st = st + 1
692 0 : pdata(st) = number(dt)
693 0 : dt = dt + 1
694 :
695 : case (2)
696 0 : pdata(st) = - pdata(st)
697 :
698 : case (3)
699 0 : pdata(st-1) = pdata(st-1) + pdata(st)
700 0 : st = st - 1
701 :
702 : case (4)
703 0 : pdata(st-1) = pdata(st-1) - pdata(st)
704 0 : st = st - 1
705 :
706 : case (5)
707 0 : pdata(st-1) = pdata(st-1) * pdata(st)
708 0 : st = st - 1
709 :
710 : case (6)
711 0 : if(abs(pdata(st)) < 1.0e-30) then
712 0 : answer = -7.093987e-35
713 : return
714 : end if
715 0 : pdata(st-1) = pdata(st-1) / pdata(st)
716 0 : st = st - 1
717 :
718 : case (7)
719 0 : if(pdata(st-1) < 0.0 .AND. (pdata(st)-int(pdata(st))) /= 0.0) then
720 0 : answer = -7.093987e-35
721 : return
722 : end if
723 0 : if(pdata(st)*log(abs(pdata(st-1)+1.0E-15)) > 65.0) then
724 0 : answer = -7.093987e-35
725 : return
726 : end if
727 0 : pdata(st-1) = pdata(st-1) ** pdata(st)
728 0 : st = st - 1
729 :
730 : case (8)
731 0 : pdata(st) = sin(pdata(st))
732 :
733 : case (9)
734 0 : pdata(st) = cos(pdata(st))
735 :
736 : case (10)
737 0 : if((abs(pdata(st)) > 89.99*3.141593/180. .and. abs(pdata(st)) < 90.01*3.141593/180)&
738 0 : .or. (abs(pdata(st)) > 269.99*3.141593/180. .and. abs(pdata(st)) < 270.01*3.141593/180)) then
739 0 : answer = -7.093987e-35
740 : return
741 : end if
742 0 : pdata(st) = tan(pdata(st))
743 :
744 : case (11)
745 0 : if(abs(pdata(st)) > 1.0) then
746 0 : answer = -7.093987e-35
747 : return
748 : end if
749 0 : pdata(st) = asin(pdata(st))
750 :
751 : case (12)
752 0 : if(abs(pdata(st)) > 1.0) then
753 0 : answer = -7.093987e-35
754 : return
755 : end if
756 0 : pdata(st) = acos(pdata(st))
757 :
758 : case (13)
759 0 : if(abs(pdata(st)) > 1.0e+10) then
760 0 : answer = -7.093987e-35
761 : return
762 : end if
763 0 : pdata(st) = atan(pdata(st))
764 :
765 : case (14)
766 0 : if(pdata(st) > 60) then
767 0 : answer = -7.093987e-35
768 : return
769 : end if
770 0 : pdata(st) = sinh(pdata(st))
771 :
772 : case (15)
773 0 : if(pdata(st) > 60) then
774 0 : answer = -7.093987e-35
775 : return
776 : end if
777 0 : pdata(st) = cosh(pdata(st))
778 :
779 : case (16)
780 0 : pdata(st) = tanh(pdata(st))
781 :
782 : case (17)
783 0 : pdata(st) = sin(pdata(st)*PI_180) ! Equivalent to SIND (bmy, 5/16/17)
784 :
785 : case (18)
786 0 : pdata(st) = cos(pdata(st)*PI_180) ! Equivalent to COSD (bmy, 5/16/17)
787 :
788 : case (19)
789 0 : pdata(st) = tan(pdata(st)*PI_180) ! Equivalent to TAND (bmy, 5/16/17)
790 :
791 : case (20)
792 0 : if(pdata(st) <= 1.0e-15) then
793 0 : answer = -7.093987e-35
794 : return
795 : end if
796 0 : pdata(st) = log(pdata(st))
797 :
798 : case (21)
799 0 : if(pdata(st) <= 1.0e-15) then
800 0 : answer = -7.093987e-35
801 : return
802 : end if
803 0 : pdata(st) = log10(pdata(st))
804 :
805 : case (22)
806 0 : pdata(st) = nint(pdata(st))
807 :
808 : case (23)
809 0 : pdata(st) = anint(pdata(st))
810 :
811 : case (24)
812 0 : pdata(st) = aint(pdata(st))
813 :
814 : case (25)
815 0 : if(pdata(st) > 55) then
816 0 : answer = -7.093987e-35
817 : return
818 : end if
819 0 : pdata(st) = exp(pdata(st))
820 :
821 : case (26)
822 0 : if(pdata(st) < 0) then
823 0 : answer = -7.093987e-35
824 : return
825 : end if
826 0 : pdata(st) = sqrt(pdata(st))
827 :
828 : case (27)
829 0 : pdata(st) = abs(pdata(st))
830 :
831 : case (28)
832 0 : pdata(st) = floor(pdata(st))
833 :
834 : case default
835 0 : st = st + 1
836 0 : pdata(st) = vars(operations(i)-28)
837 :
838 : end select
839 :
840 0 : if(abs(pdata(st)) > 1.0d+60) then
841 0 : answer = -7.093987e-35
842 : return
843 : end if
844 :
845 : end do
846 :
847 0 : answer = pdata(1)
848 :
849 0 : end function evaluate_detalhes
850 :
851 :
852 0 : subroutine destroyfunc()
853 :
854 0 : if (allocated(stokens)) then
855 0 : deallocate(stokens)
856 : end if
857 0 : if (associated(opaddsub)) then
858 0 : deallocate(opaddsub)
859 : end if
860 0 : if (associated(opmuldiv)) then
861 0 : deallocate(opmuldiv)
862 : end if
863 0 : if (associated(number)) then
864 0 : deallocate(number)
865 : end if
866 0 : if (associated(pdata)) then
867 0 : deallocate(pdata)
868 : end if
869 0 : if (allocated(operations)) then
870 0 : deallocate(operations)
871 : end if
872 0 : if (allocated(varnames)) then
873 0 : deallocate(varnames)
874 : end if
875 0 : statusflagparser = 'ok'
876 :
877 0 : end subroutine destroyfunc
878 :
879 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
880 :
881 0 : recursive subroutine blanks(func)
882 : !
883 : ! This subroutine removes unnecessary blank spaces
884 : !
885 : character(len=*), intent(inout) :: func
886 : integer :: k
887 :
888 0 : func = adjustl(func)
889 0 : k = index(trim(func), ' ')
890 0 : if (k /= 0) then
891 0 : func = func(:k-1) // func(k+1:)
892 0 : call blanks(func)
893 : end if
894 :
895 0 : end subroutine blanks
896 :
897 : end module interpreter
898 :
899 :
900 :
901 :
902 :
903 0 : subroutine identifica(funcao)
904 : character (255) funcao
905 : character (36) variav
906 :
907 0 : variav = '0123456789abcdefghijklmnopqrstuvwxyz'
908 :
909 0 : nchar = len(trim(funcao))
910 :
911 0 : do i = 1,nchar
912 0 : if(funcao(i:i) == 'A')funcao(i:i) = 'a'
913 0 : if(funcao(i:i) == 'B')funcao(i:i) = 'b'
914 0 : if(funcao(i:i) == 'C')funcao(i:i) = 'c'
915 0 : if(funcao(i:i) == 'D')funcao(i:i) = 'd'
916 0 : if(funcao(i:i) == 'E')funcao(i:i) = 'e'
917 0 : if(funcao(i:i) == 'F')funcao(i:i) = 'f'
918 0 : if(funcao(i:i) == 'G')funcao(i:i) = 'g'
919 0 : if(funcao(i:i) == 'H')funcao(i:i) = 'h'
920 0 : if(funcao(i:i) == 'I')funcao(i:i) = 'i'
921 0 : if(funcao(i:i) == 'J')funcao(i:i) = 'j'
922 0 : if(funcao(i:i) == 'K')funcao(i:i) = 'k'
923 0 : if(funcao(i:i) == 'L')funcao(i:i) = 'l'
924 0 : if(funcao(i:i) == 'M')funcao(i:i) = 'm'
925 0 : if(funcao(i:i) == 'N')funcao(i:i) = 'n'
926 0 : if(funcao(i:i) == 'O')funcao(i:i) = 'o'
927 0 : if(funcao(i:i) == 'P')funcao(i:i) = 'p'
928 0 : if(funcao(i:i) == 'Q')funcao(i:i) = 'q'
929 0 : if(funcao(i:i) == 'R')funcao(i:i) = 'r'
930 0 : if(funcao(i:i) == 'S')funcao(i:i) = 's'
931 0 : if(funcao(i:i) == 'T')funcao(i:i) = 't'
932 0 : if(funcao(i:i) == 'U')funcao(i:i) = 'u'
933 0 : if(funcao(i:i) == 'V')funcao(i:i) = 'v'
934 0 : if(funcao(i:i) == 'W')funcao(i:i) = 'w'
935 0 : if(funcao(i:i) == 'X')funcao(i:i) = 'x'
936 0 : if(funcao(i:i) == 'Y')funcao(i:i) = 'y'
937 0 : if(funcao(i:i) == 'Z')funcao(i:i) = 'z'
938 : end do
939 :
940 :
941 :
942 0 : if(funcao(nchar:nchar) == '-' .or. funcao(nchar:nchar) == '+' .or. funcao(nchar:nchar) == '/' .or. funcao(nchar:nchar) == '*') then
943 0 : funcao = 'erro'
944 0 : return
945 : end if
946 :
947 0 : if(funcao(1:1) == '*' .or. funcao(1:1) == '/') then
948 0 : funcao = 'erro'
949 0 : return
950 : end if
951 :
952 0 : do i = 1, nchar-1
953 0 : if(funcao(i:i+1) == '--' .or. funcao(i:i+1) == '-+' .or. funcao(i:i+1) == '-/' .or. funcao(i:i+1) == '-*') funcao = 'erro'
954 0 : if(funcao(i:i+1) == '+-' .or. funcao(i:i+1) == '++' .or. funcao(i:i+1) == '+/' .or. funcao(i:i+1) == '+*') funcao = 'erro'
955 0 : if(funcao(i:i+1) == '*-' .or. funcao(i:i+1) == '*+' .or. funcao(i:i+1) == '*/') funcao = 'erro'
956 0 : if(funcao(i:i+1) == '/-' .or. funcao(i:i+1) == '/+' .or. funcao(i:i+1) == '//' .or. funcao(i:i+1) == '/*') funcao = 'erro'
957 : end do
958 0 : if(trim(funcao) == 'erro') return
959 :
960 0 : do i = 1, nchar-1
961 0 : do j = 1, 36
962 0 : if(funcao(i:i+1) == ')'//variav(j:j)) funcao = 'erro'
963 : end do
964 : end do
965 0 : if(trim(funcao) == 'erro') return
966 :
967 0 : do i = 1, nchar-1
968 0 : do j = 1, 36
969 0 : if(funcao(i:i) == '0' .or. funcao(i:i) == 'n' .or. funcao(i:i) == 's' .or. funcao(i:i) == 'h' .or. funcao(i:i) == 'd' .or. funcao(i:i) == 'g' .or. funcao(i:i) == 't' .or. funcao(i:i) == 'p' .or. funcao(i:i) == 'r') then
970 : !não testa, pode ser uma das funções definidas
971 : else
972 0 : if(funcao(i:i+1) == variav(j:j)//'(') funcao = 'erro'
973 : end if
974 : end do
975 : end do
976 0 : if(trim(funcao) == 'erro') return
977 :
978 :
979 0 : if(nchar >= 5) then
980 0 : do i = 1,nchar-4
981 :
982 0 : if(funcao(i:i+4) == 'log10') then
983 0 : j = i+5
984 : 19 continue
985 0 : if(j >= nchar) then
986 0 : funcao = 'erro'
987 0 : return
988 : end if
989 0 : if(funcao(j:j) == ' ') then
990 0 : j = j + 1
991 0 : goto 19
992 : end if
993 0 : if(funcao(j:j) /= '(') then
994 0 : funcao = 'erro'
995 0 : return
996 : end if
997 : end if
998 :
999 0 : if(funcao(i:i+4) == 'anint') then
1000 0 : j = i+5
1001 : 20 continue
1002 0 : if(j >= nchar) then
1003 0 : funcao = 'erro'
1004 0 : return
1005 : end if
1006 0 : if(funcao(j:j) == ' ') then
1007 0 : j = j + 1
1008 0 : goto 20
1009 : end if
1010 0 : if(funcao(j:j) /= '(') then
1011 0 : funcao = 'erro'
1012 0 : return
1013 : end if
1014 : end if
1015 :
1016 0 : if(funcao(i:i+4) == 'floor') then
1017 0 : j = i+5
1018 : 21 continue
1019 0 : if(j >= nchar) then
1020 0 : funcao = 'erro'
1021 0 : return
1022 : end if
1023 0 : if(funcao(j:j) == ' ') then
1024 0 : j = j + 1
1025 0 : goto 21
1026 : end if
1027 0 : if(funcao(j:j) /= '(') then
1028 0 : funcao = 'erro'
1029 0 : return
1030 : end if
1031 : end if
1032 :
1033 : end do
1034 : end if
1035 :
1036 :
1037 :
1038 :
1039 0 : if(nchar >= 4) then
1040 0 : do i = 1,nchar-3
1041 :
1042 0 : if(funcao(i:i+3) == 'asin') then
1043 0 : j = i+4
1044 : 7 continue
1045 0 : if(j >= nchar) then
1046 0 : funcao = 'erro'
1047 0 : return
1048 : end if
1049 0 : if(funcao(j:j) == ' ') then
1050 0 : j = j + 1
1051 0 : goto 7
1052 : end if
1053 0 : if(funcao(j:j) /= '(') then
1054 0 : funcao = 'erro'
1055 0 : return
1056 : end if
1057 : end if
1058 :
1059 0 : if(funcao(i:i+3) == 'acos') then
1060 0 : j = i+4
1061 : 8 continue
1062 0 : if(j >= nchar) then
1063 0 : funcao = 'erro'
1064 0 : return
1065 : end if
1066 0 : if(funcao(j:j) == ' ') then
1067 0 : j = j + 1
1068 0 : goto 8
1069 : end if
1070 0 : if(funcao(j:j) /= '(') then
1071 0 : funcao = 'erro'
1072 0 : return
1073 : end if
1074 : end if
1075 :
1076 0 : if(funcao(i:i+3) == 'atan') then
1077 0 : j = i+4
1078 : 9 continue
1079 0 : if(j >= nchar) then
1080 0 : funcao = 'erro'
1081 0 : return
1082 : end if
1083 0 : if(funcao(j:j) == ' ') then
1084 0 : j = j + 1
1085 0 : goto 9
1086 : end if
1087 0 : if(funcao(j:j) /= '(') then
1088 0 : funcao = 'erro'
1089 0 : return
1090 : end if
1091 : end if
1092 :
1093 0 : if(funcao(i:i+3) == 'sinh') then
1094 0 : j = i+4
1095 : 10 continue
1096 0 : if(j >= nchar) then
1097 0 : funcao = 'erro'
1098 0 : return
1099 : end if
1100 0 : if(funcao(j:j) == ' ') then
1101 0 : j = j + 1
1102 0 : goto 10
1103 : end if
1104 0 : if(funcao(j:j) /= '(') then
1105 0 : funcao = 'erro'
1106 0 : return
1107 : end if
1108 : end if
1109 :
1110 0 : if(funcao(i:i+3) == 'cosh') then
1111 0 : j = i+4
1112 : 11 continue
1113 0 : if(j >= nchar) then
1114 0 : funcao = 'erro'
1115 0 : return
1116 : end if
1117 0 : if(funcao(j:j) == ' ') then
1118 0 : j = j + 1
1119 0 : goto 11
1120 : end if
1121 0 : if(funcao(j:j) /= '(') then
1122 0 : funcao = 'erro'
1123 0 : return
1124 : end if
1125 : end if
1126 :
1127 0 : if(funcao(i:i+3) == 'tanh') then
1128 0 : j = i+4
1129 : 12 continue
1130 0 : if(j >= nchar) then
1131 0 : funcao = 'erro'
1132 0 : return
1133 : end if
1134 0 : if(funcao(j:j) == ' ') then
1135 0 : j = j + 1
1136 0 : goto 12
1137 : end if
1138 0 : if(funcao(j:j) /= '(') then
1139 0 : funcao = 'erro'
1140 0 : return
1141 : end if
1142 : end if
1143 :
1144 0 : if(funcao(i:i+3) == 'sind') then
1145 0 : j = i+4
1146 : 13 continue
1147 0 : if(j >= nchar) then
1148 0 : funcao = 'erro'
1149 0 : return
1150 : end if
1151 0 : if(funcao(j:j) == ' ') then
1152 0 : j = j + 1
1153 0 : goto 13
1154 : end if
1155 0 : if(funcao(j:j) /= '(') then
1156 0 : funcao = 'erro'
1157 0 : return
1158 : end if
1159 : end if
1160 :
1161 0 : if(funcao(i:i+3) == 'cosd') then
1162 0 : j = i+4
1163 : 14 continue
1164 0 : if(j >= nchar) then
1165 0 : funcao = 'erro'
1166 0 : return
1167 : end if
1168 0 : if(funcao(j:j) == ' ') then
1169 0 : j = j + 1
1170 0 : goto 14
1171 : end if
1172 0 : if(funcao(j:j) /= '(') then
1173 0 : funcao = 'erro'
1174 0 : return
1175 : end if
1176 : end if
1177 :
1178 0 : if(funcao(i:i+3) == 'tand') then
1179 0 : j = i+4
1180 : 15 continue
1181 0 : if(j >= nchar) then
1182 0 : funcao = 'erro'
1183 0 : return
1184 : end if
1185 0 : if(funcao(j:j) == ' ') then
1186 0 : j = j + 1
1187 0 : goto 15
1188 : end if
1189 0 : if(funcao(j:j) /= '(') then
1190 0 : funcao = 'erro'
1191 0 : return
1192 : end if
1193 : end if
1194 :
1195 0 : if(funcao(i:i+3) == 'nint') then
1196 0 : j = i+4
1197 : 16 continue
1198 0 : if(j >= nchar) then
1199 0 : funcao = 'erro'
1200 0 : return
1201 : end if
1202 0 : if(funcao(j:j) == ' ') then
1203 0 : j = j + 1
1204 0 : goto 16
1205 : end if
1206 0 : if(funcao(j:j) /= '(') then
1207 0 : funcao = 'erro'
1208 0 : return
1209 : end if
1210 : end if
1211 :
1212 0 : if(funcao(i:i+3) == 'aint') then
1213 0 : j = i+4
1214 : 17 continue
1215 0 : if(j >= nchar) then
1216 0 : funcao = 'erro'
1217 0 : return
1218 : end if
1219 0 : if(funcao(j:j) == ' ') then
1220 0 : j = j + 1
1221 0 : goto 17
1222 : end if
1223 0 : if(funcao(j:j) /= '(') then
1224 0 : funcao = 'erro'
1225 0 : return
1226 : end if
1227 : end if
1228 :
1229 0 : if(funcao(i:i+3) == 'sqrt') then
1230 0 : j = i+4
1231 : 18 continue
1232 0 : if(j >= nchar) then
1233 0 : funcao = 'erro'
1234 0 : return
1235 : end if
1236 0 : if(funcao(j:j) == ' ') then
1237 0 : j = j + 1
1238 0 : goto 18
1239 : end if
1240 0 : if(funcao(j:j) /= '(') then
1241 0 : funcao = 'erro'
1242 0 : return
1243 : end if
1244 : end if
1245 :
1246 : end do
1247 : end if
1248 :
1249 :
1250 :
1251 :
1252 0 : if(nchar >= 3) then
1253 0 : do i = 1,nchar-2
1254 :
1255 0 : if(funcao(i:i+2) == 'sin') then
1256 0 : j = i+3
1257 : 1 continue
1258 0 : if(j >= nchar) then
1259 0 : funcao = 'erro'
1260 0 : return
1261 : end if
1262 0 : if(funcao(j:j) == ' ') then
1263 0 : j = j + 1
1264 0 : goto 1
1265 : end if
1266 0 : if(funcao(j:j) == 'd' .or. funcao(j:j) == 'h') goto 51
1267 0 : if(funcao(j:j) /= '(') then
1268 0 : funcao = 'erro'
1269 0 : return
1270 : end if
1271 : 51 continue
1272 : end if
1273 :
1274 0 : if(funcao(i:i+2) == 'cos') then
1275 0 : j = i+3
1276 : 2 continue
1277 0 : if(j >= nchar) then
1278 0 : funcao = 'erro'
1279 0 : return
1280 : end if
1281 0 : if(funcao(j:j) == ' ') then
1282 0 : j = j + 1
1283 0 : goto 2
1284 : end if
1285 0 : if(funcao(j:j) == 'd' .or. funcao(j:j) == 'h') goto 52
1286 0 : if(funcao(j:j) /= '(') then
1287 0 : funcao = 'erro'
1288 0 : return
1289 : end if
1290 : 52 continue
1291 : end if
1292 :
1293 0 : if(funcao(i:i+2) == 'tan') then
1294 0 : j = i+3
1295 : 3 continue
1296 0 : if(j >= nchar) then
1297 0 : funcao = 'erro'
1298 0 : return
1299 : end if
1300 0 : if(funcao(j:j) == ' ') then
1301 0 : j = j + 1
1302 0 : goto 3
1303 : end if
1304 0 : if(funcao(j:j) == 'd' .or. funcao(j:j) == 'h') goto 53
1305 0 : if(funcao(j:j) /= '(') then
1306 0 : funcao = 'erro'
1307 0 : return
1308 : end if
1309 : 53 continue
1310 : end if
1311 :
1312 0 : if(funcao(i:i+2) == 'log') then
1313 0 : j = i+3
1314 : 4 continue
1315 0 : if(j >= nchar) then
1316 0 : funcao = 'erro'
1317 0 : return
1318 : end if
1319 0 : if(funcao(j:j) == ' ') then
1320 0 : j = j + 1
1321 0 : goto 4
1322 : end if
1323 0 : if(j < (nchar-1) .and. funcao(j:j+1) == '10') goto 54
1324 0 : if(funcao(j:j) /= '(') then
1325 0 : funcao = 'erro'
1326 0 : return
1327 : end if
1328 : 54 continue
1329 : end if
1330 :
1331 0 : if(funcao(i:i+2) == 'exp') then
1332 0 : j = i+3
1333 : 5 continue
1334 0 : if(j >= nchar) then
1335 0 : funcao = 'erro'
1336 0 : return
1337 : end if
1338 0 : if(funcao(j:j) == ' ') then
1339 0 : j = j + 1
1340 0 : goto 5
1341 : end if
1342 0 : if(funcao(j:j) /= '(') then
1343 0 : funcao = 'erro'
1344 0 : return
1345 : end if
1346 : end if
1347 :
1348 0 : if(funcao(i:i+2) == 'abs') then
1349 0 : j = i+3
1350 : 6 continue
1351 0 : if(j >= nchar) then
1352 0 : funcao = 'erro'
1353 0 : return
1354 : end if
1355 0 : if(funcao(j:j) == ' ') then
1356 0 : j = j + 1
1357 0 : goto 6
1358 : end if
1359 0 : if(funcao(j:j) /= '(') then
1360 0 : funcao = 'erro'
1361 0 : return
1362 : end if
1363 : end if
1364 :
1365 : end do
1366 : endif
1367 :
1368 :
1369 : return
1370 : end subroutine identifica
1371 :
1372 :
1373 :
1374 0 : subroutine convert_b(text)
1375 : character (255) text
1376 : INTENT(INOUT)::text
1377 :
1378 :
1379 0 : ilength = len(trim(text))
1380 :
1381 0 : do k = 1,ilength
1382 0 : if(text(k:k) == '[' .or. text(k:k) == '{') text(k:k)='('
1383 0 : if(text(k:k) == ']' .or. text(k:k) == '}') text(k:k)=')'
1384 : end do
1385 :
1386 :
1387 : 10 continue
1388 0 : item = 0
1389 0 : ilength = len(trim(text))
1390 :
1391 0 : if(ilength > 1) then
1392 :
1393 0 : do k = 1,(ilength-1)
1394 :
1395 : !converte ^ em **, caso o usuário digite ^
1396 0 : if(text(k:k) == '^') then
1397 0 : text = text(1:k-1)//'**'//text(k+1:ilength)
1398 0 : ilength = ilength + 1
1399 0 : item = 1
1400 : end if
1401 :
1402 : !converte ln em log
1403 0 : if(text(k:k+1) == 'ln' .or. text(k:k+1) == 'Ln' .or.text(k:k+1) == 'lN' .or.text(k:k+1) == 'LN') then
1404 0 : text = text(1:k-1)//'log'//text(k+2:ilength)
1405 0 : ilength = ilength + 1
1406 0 : item = 1
1407 : end if
1408 :
1409 : !converte pi em 3.14159
1410 0 : if(text(k:k+1) == 'pi' .or. text(k:k+1) == 'Pi' .or. text(k:k+1) == 'pI' .or. text(k:k+1) == 'PI') then
1411 0 : text = text(1:k-1)//'3.14159'//text(k+2:ilength)
1412 0 : ilength = ilength + 5
1413 0 : item = 1
1414 : end if
1415 :
1416 : !converte vírgula em ponto, caso o usuário digite vírgula
1417 0 : if(text(k:k) == ',') then
1418 0 : text = text(1:k-1)//'.'//text(k+1:ilength)
1419 0 : item = 1
1420 : end if
1421 :
1422 : end do
1423 :
1424 : end if
1425 :
1426 :
1427 :
1428 0 : if(ilength > 2) then
1429 :
1430 : !penúltimo
1431 0 : if(text((ilength-1):(ilength-1)) == '^') then
1432 0 : text = text(1:ilength-2)//'**'//text(ilength:ilength)
1433 0 : item = 1
1434 : end if
1435 :
1436 : !penúltimo
1437 0 : if(text((ilength-1):(ilength-1)) == ',') then
1438 0 : text = text(1:ilength-2)//'.'//text(ilength:ilength)
1439 0 : item = 1
1440 : end if
1441 :
1442 : end if
1443 :
1444 :
1445 0 : if(ilength > 1) then
1446 :
1447 : !último
1448 0 : if(text((ilength):(ilength)) == ',') then
1449 0 : text = text(1:ilength-1)//'.'
1450 0 : item = 1
1451 : end if
1452 :
1453 : end if
1454 :
1455 0 : if(item == 1) goto 10
1456 :
1457 0 : return
1458 :
1459 : end subroutine
|
