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