mat_expr Subroutine

public subroutine mat_expr()

Arguments

None

Contents

Source Code


Variables

Type Visibility Attributes Name Initial
integer, public, parameter :: eye(GG_MAX_NAME_LENGTH) = [iachar(['e', 'y', 'e', ' ', ' ', ' ', ' ']), GG_PAD(8:)]
integer, public :: kount
integer, public :: ls
integer, public :: op
integer, public :: r
integer, public :: sign

Source Code

subroutine mat_expr()
integer           :: r
integer           :: sign
integer,parameter :: eye(GG_MAX_NAME_LENGTH) =  [iachar(['e','y','e',' ',' ',' ',' ']),GG_PAD(8:)]
integer           :: kount
integer           :: ls
integer           :: op

   r = G_RSTK(G_pt)
!===================================================================================================================================
!        1  2  3  4  5  6  7  8  9  10 11 12 13 14 15 16 16 18 19 20
   goto (01,01,01,01,01,05,25,99,99,01,01,99,99,99,99,99,99,01,01,01),R
!  what about drop-though???
!===================================================================================================================================
01 continue
   if (G_SYM .eq. colon) call mat_copyid(G_SYN,eye)
   if (G_SYM .eq. colon) G_SYM = isname
   kount = 1
02 continue
   sign = plus
   if (G_SYM .eq. minus) sign = minus
   if (G_SYM.eq.plus .or. G_SYM.eq.minus) call mat_getsym()
   G_pt = G_pt+1
   if (G_pt .gt. G_PSIZE-1) then
      call mat_err(26) ! too complicated (stack overflow)
      return
   endif
   G_PSTK(G_pt) = sign + 256*kount
   G_RSTK(G_pt) = 6
   ! *call* term
   return
!===================================================================================================================================
05 continue
   sign = mod(G_PSTK(G_pt),256)
   kount = G_PSTK(G_pt)/256
   G_pt = G_pt-1
   if (sign .eq. minus) call mat_stack1(minus)
   if (G_err .gt. 0) return
10 continue
   if (G_SYM.eq.plus .or. G_SYM.eq.minus) goto 20
   goto 50
!===================================================================================================================================
20 continue
   if (G_RSTK(G_pt) .eq. 10) then
      ! blank is delimiter inside angle brackets
      ls = G_LINE_POINTER(3) - 2
      if (G_LIN(ls) .eq. blank) goto 50
   endif
   op = G_SYM
   call mat_getsym()
   G_PT = G_PT+1
   G_PSTK(G_PT) = op + 256*kount
   G_RSTK(G_PT) = 7
!     *call* term
   return
!===================================================================================================================================
25 continue
   op = mod(G_PSTK(G_pt),256)
   kount = G_PSTK(G_pt)/256
   G_PT = G_PT-1
   call mat_stack2(op)
   if (G_ERR .gt. 0) return
   goto 10
!===================================================================================================================================
50 continue
   if (G_SYM .ne. colon) goto 60
   call mat_getsym()
   kount = kount+1
   goto 02
!===================================================================================================================================
60 continue
   if (kount .gt. 3) then
      call mat_err(33)  ! too many colons
      return
   endif
   G_RHS = kount
   if (kount .gt. 1) call mat_stack2(colon)
   if (G_err .gt. 0) return
   return
!===================================================================================================================================
99 continue
   call mat_err(22)     ! recursion difficulties
   return
!===================================================================================================================================
end subroutine mat_expr