1!$Id:$ 2 subroutine parexp(x,xs,v,nex,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 parenthetical expressions and evaluate 11 12! Inputs: 13! x*(*) - String containing expression to evaluate 14 15! Scratch: 16! xs*(*) - Array used to temporarily store expression 17! v(*) - Array to hold values 18 19! Outputs: 20! x*(*) - Expression replaced by upper case letter 21! nex - Number of upper case letters used 22! error - Flag, true if error occurs 23 24! Common returns: 25! www(*) - Upper case letters with values assigned 26!-----[--.----+----.----+----.-----------------------------------------] 27 28 implicit none 29 30 include 'conval.h' 31 32 logical error 33 character x*(*),xs*(*) 34 integer i,j,k,l, i1,i2,nex 35 real*8 val, v(*) 36 37 save 38 39! Find parenthetical expressions and remove 40 41 do i = 1,75 42 if(x(i:i).eq.'(') then 43 i1 = i + 1 44 do j = i1,75 45 if(x(j:j).eq.'(') then 46 call errclr('PAREXP') 47 call plstop(.true.) 48 elseif(x(j:j).eq.')') then 49 do l = 1,j-i+1 50 xs(l:l) = ' ' 51 end do ! l 52 i2 = j - 1 53 if(i2.lt.i1) then 54 call errclr('PAREXP') 55 call plstop(.true.) 56 else 57 k = 0 58 do l = i1,i2 59 k = k + 1 60 xs(k:k) = x(l:l) 61 x(l:l) = ' ' 62 end do ! l 63 x(i2+1:i2+1) = ' ' 64 65! Evaluate expression in parenthesis 66 67 call evalex(xs,v,val,k,error) 68 if(error) return 69 nex = nex + 1 70 www(nex) = val 71 72! Put upper case letter in expression and close up remainder 73 74 x(i:i) = char(nex +64) 75 i2 = i2 -i1 + 2 76 do l = i1,75 77 x(l:l) = ' ' 78 if(l+i2.le.75) then 79 x(l:l) = x(l+i2:l+i2) 80 endif 81 end do ! l 82 endif 83 go to 100 84 endif 85 end do ! j 86100 continue 87 endif 88 end do ! i 89 90 end 91