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