1!$Id:$
2      subroutine histex(wd,clab1,jct,lct,ct,nwd,nlp,nnx,ll,is)
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: Control command language execution by history inputs
11
12!      Inputs:
13!         wd(*)    - List of solution commands
14!         clab1    - Command to execute
15!         nwd      - Number of commands in wd
16!         nlp      - Loop command number
17!         nnx      - Next command number
18!         ll       - Command number to execute
19
20!      Outputs:
21!         jct(ll)  - Command number
22!         lct(ll)  - Command option
23!         lzz(ll)  - Variables for command
24!         ct(3,ll) - Values evaluated from lzz
25!         is       - Error if 0, otherwise 1
26!-----[--.----+----.----+----.-----------------------------------------]
27      implicit  none
28
29      include  'chdata.h'
30      include  'comfil.h'
31      include  'idata1.h'
32
33      logical   pcomp,errck,vinput,cinput
34      integer   nwd,nlp,nnx,ll,i,is,n,nc
35      character clab1*4,lct(*)*15,wd(nwd)*4,y*1
36
37      integer   jct(*)
38      real*8    ct(3,*)
39
40      save
41
42      is = 0
43      if(nn.le.0) then
44        write(*,2000)
45        is = 1
46      else
47        if(clab1(2:2).ne.'!') then
48          nc = 3
49          if(clab1(4:4).eq.' ') nc = 2
50          if(clab1(3:3).eq.' ') nc = 1
51          if(clab1(2:2).eq.' ') nc = 0
52        else
53          nc = 0
54        endif
55        if(nc.gt.0) then
56          do n = nn,1,-1
57            if(pcomp(clab1(2:2+nc),wd(js(n)),nc)) go to 102
58          end do
59          write(*,2001)
60          is = 1
61          return
62        else
63          n = nn
64        endif
65
66102    if(js(n).ne.nlp .and. js(n).ne.nnx) then
67          jct(ll) = js(n)
68          lct(ll) = ljs(n)
69          lzz(ll) = lzs(n)
70          errck   = vinput(lzz(ll),80,ct(1,ll),3)
71!103       write(*,2002) wd(jct(ll)),lct(ll),(ct(i,ll),i=1,3)
72          write(*,2002) wd(jct(ll)),lct(ll),(ct(i,ll),i=1,3)
73!          read(*,1000,err=103,end=900) y
74          if(.not.cinput( )) then
75            goto 900
76          end if
77          y = record(1:1)
78104       if(y.ne.' ' .and. y.ne.'y' .and. y.ne.'Y') is = 1
79          return
80
81!         Eof encountered
82
83900       call  endclr ('PMACIO',y)
84          goto 104
85        else
86          write(*,2003)
87          is = 1
88        endif
89      endif
90
91!     Formats
92
93!1000  format(a1)
94
952000  format(/' *ERROR* No previous instruction of this type.')
96
972001  format(/' *ERROR* No match of this macro name')
98
992002  format(/' Macro to be executed.'/10x,'--> ',a4,1x,a15,1p,3e12.4
100     &       /' Enter y or <CR> to accept.-->',$)
101
1022003  format(/' *ERROR* loop/next execution not permitted')
103
104      end
105