1!$Id:$
2      subroutine evalex(xs,v,val,ns,error)
3
4!      * * F E A P * * A Finite Element Analysis Program
5
6!....  Copyright (c) 1984-2017: Regents of the University of California
7!                               All rights reserved
8
9!-----[--.----+----.----+----.-----------------------------------------]
10!      Purpose: Identify expression in character string and evaluate
11
12!      Inputs:
13!         xs(*) - Character string of input data
14!         v(*)  - Array of real values
15!         ns    - Length of character string
16
17!      Outputs:
18!         val   - Value of expression
19!         error - Error indicator if true
20!-----[--.----+----.----+----.-----------------------------------------]
21      implicit  none
22
23      include  'corfil.h'
24      include  'iofile.h'
25
26      logical   error
27      character xs*(*),x*256,y*1,op(25)*1
28      integer   i,j,k,ns,num
29      real*8    val, v(*)
30
31      save
32
33!     Pack expression by removing any ' ' characters
34
35      num = 0
36      do i = 1,ns
37        if(xs(i:i).ne.' ') then
38          num        = num + 1
39          x(num:num) = xs(i:i)
40        endif
41      end do ! i
42
43!     Evaluate an expression: (+) add, (-) subtract, (*) multiply,
44!                             (/) divide, (^) power.
45
46      k  = 0
47      do i = 1,num
48        if(k.eq.0 .and. x(i:i).eq.' ') go to 100
49        if((x(i:i).eq.'+') .or. (x(i:i).eq.'-')) then
50          if(i.gt.2) then
51            y = x(i-1:i-1)
52            if(y.eq.'e'.or.y.eq.'d'.or.y.eq.'E'.or.y.eq.'D') then
53              if((x(i-2:i-2).ge.'0'.and.x(i-2:i-2).le.'9').or.
54     &            x(i-2:i-2).eq.'.') go to 100
55            endif
56          endif
57          k      = k + 1
58          op(k)  = x(i:i)
59          x(i:i) = ','
60        endif
61        if((x(i:i).eq.'*').or.(x(i:i).eq.'/').or.(x(i:i).eq.'^')) then
62          k      = k + 1
63          op(k)  = x(i:i)
64          x(i:i) = ','
65        endif
66100     continue
67      end do ! i
68
69      call dcheck(x,v,num,error)
70
71      if(error) return
72
73!     Compute value of expression
74
75      val = v(1)
76      if(k.ge.1) then
77
78!      1. Evaluate all exponentiations
79
80        i = 1
81110     if(op(i).eq.'^') then
82          v(i) = v(i) ** v(i+1)
83          k = k - 1
84          do j = i,k
85            v(j+1) = v(j+2)
86            op(j) = op(j+1)
87          end do ! j
88        endif
89        i = i + 1
90        if(i.le.k) go to 110
91
92!      2. Evaluate all multiplications and divisions
93
94        i = 1
95120     if(op(i).eq.'*' .or. op(i).eq.'/') then
96          if(op(i).eq.'*') then
97            v(i) = v(i) * v(i+1)
98          else
99            if(v(i+1).eq.0.0d0) then
100              write(iow,3000) let
101              if(v(i).ne.0.0d0) then
102                v(i) = sign(1.d20,v(i))
103              else
104                v(i) = 0.0d0
105              endif
106            else
107              v(i) = v(i) / v(i+1)
108            endif
109          endif
110          k = k - 1
111          do j = i,k
112            v(j+1) = v(j+2)
113            op(j) = op(j+1)
114          end do ! j
115        else
116          i = i + 1
117        endif
118        if(i.le.k) go to 120
119
120!      3. Evaluate all additions and subractions
121
122        val = v(1)
123        if(k.gt.0) then
124          do i = 1,k
125            if(op(i).eq.'+') val = val + v(i+1)
126            if(op(i).eq.'-') val = val - v(i+1)
127          end do ! i
128        endif
129      endif
130
131!     Format
132
1333000  format(' *ERROR* Dividing by zero in expression for: ',a)
134
135      end
136