c c subroutine setprm (instr) c c c PROGRAM NAME: SETPRM.rat c c DATE OF FIRST VERSION: 5-Aug-79 c DATE OF CURRENT VERSION: 21-Jun-83 c c PURPOSE: To assign values to the parameters for PLTFIL c c USAGE: call SETPRM (INSTR) c c Where INSTR -- input string (contains parameter c name, "=", and the parameter value) c c NOTES FOR PROGRAMMERS: Certain parameters can accept text values. c Any parameter can accept input from c keyboard if an asterisk is supplied. c c PROGRAMMER: Mike Collins / Eric Javel / Matt Prucka c c******************************************************* c c Common block for PLT parameters c real*8prmnam,txtnam,keywrd bytexlabel,ylabel,rlabel,xfmt,yfmt,rfmt,msg,filonm(14) bytefilinm(40) logical*1dataon,pltfnd,msgflg,finflg,modflg,conton,axflg,newpag, & ecflg,typerr,dbflg c common /params/xmin,xmax,xint,xcycle,xpct,xlen,xllc,ymin,ymax, & yint,ycycle,ypct,ylen,yllc,rmin,rmax,rint,rcycle,rpct,pltype, & typlin,pltlin,symnum,sizsym,solid,sizann,wtlnan,xanlab,yanlab, & ranlab,yhor,grid,sizlab,wtlnlb,ticmrk,shade,echo,wtlnax,openax, & sizmsg,wtlnms,xmsg,ymsg,angmsg,datmsg,sizfac,smooth,header,sort, & unused(1) common /flags/dataon,pltfnd,msgflg,finflg,modflg,conton,axflg, & newpag,ecflg,typerr,dbflg common /names/prmnam(50),txtnam(6),keywrd(25),filinm,filonm common /text/xlabel(52),ylabel(52),rlabel(52),xfmt(6),yfmt(6), & rfmt(6),msg(256) common /misc/ifrom,ito,inow,ipage,model,lunin,lunout c common /axes/rxmin,rxmax,rymin,rymax,rxlen,rylen,rxllc,ryllc, & pxmin,pxmax,pymin,pymax,pxlen,pylen,pxllc,pyllc common /size/tiklen,hitann,hitlab,hitsym,hitmsg,iaxlnw,igrlnw, & ianlnw,ilblnw,ipllnw,imslnw,avgaxl common /msks/ msk1,msk2,msk3,msk4,msk5 bytechar,instr(80),prmstr(8),pname(8) real*4param(1) real*8name logical*1err externallen,index equivalence(param(1),xmin),(pname(1),name) 1 format ('$Enter value for ',8a1,': ') 2 format (f10.0) 3 format (' Invalid Parameter: ',50a1) c c----------------------------------------------------------------- c c Isolate the parameter name and put it into PRMSTR k = index(instr,'=') call scopy (instr,prmstr,min0(k-1,8)) prmstr(k) = 0 k = k + 1 c Check the parameter list to see if it's an arithmetic parameter. j = iscan (prmnam,50,prmstr) if(.not.(j .ne. 0))goto 23000 c It is. Check to see if we need to get the value from the keyboard if(.not.(index(instr(k),'*') .ne. 0))goto 23002 name = prmnam(j) 5 call ittour (7) write (5,1) (pname(i),i=1,8) call getstr (5,instr(k),79-k,err) ihere = 5 c Change lower-case first character to upper-case 23002 continue char = instr(k) .and. "337 c Accept YES and NO as parameter entries if(.not.(char .eq. 'Y'))goto 23004 param(j) = 1.0 goto 23005 c else 23004 continue if(.not.(char .eq. 'N'))goto 23006 param(j) = 0.0 c Accept SYMBOL, LINE, BOTH, and HISTO as entries for PLTYPE goto 23007 c else 23006 continue if(.not.(j .eq. 20 .and. char .eq. 'S'))goto 23008 param(j) = 1.0 goto 23009 c else 23008 continue if(.not.(j .eq. 20 .and. char .eq. 'L'))goto 23010 param(j) = 2.0 goto 23011 c else 23010 continue if(.not.(j .eq. 20 .and. char .eq. 'B'))goto 23012 param(j) = 3.0 goto 23013 c else 23012 continue if(.not.(j .eq. 20 .and. char .eq. 'H'))goto 230 & 14 param(j) = 4.0 c Accept INWARD and OUTWARD as entries for TICMRK goto 23015 c else 23014 continue if(.not.(j .eq. 35 .and. char .eq. 'O')) & goto 23016 param(j) = 0.0 goto 23017 c else 23016 continue if(.not.(j .eq. 35 .and. char .eq. 'I')) & goto 23018 param(j) = 1.0 c Otherwise, decode the parameter value goto 23019 c else 23018 continue instr(len(instr)+1) = ',' decode (10,2,instr(k),err=15) param(j) 23019 continue 23017 continue 23015 continue 23013 continue 23011 continue 23009 continue 23007 continue 23005 continue return c Entry was not an arithmetic parameter, so see if it's a text parameter 23000 continue j = iscan (txtnam,6,prmstr) if(.not.(j .ne. 0))goto 23020 c Check to see if input from keyboard is desired if(.not.(index(instr(k),'*') .ne. 0))goto 23022 name = txtnam(j) 10 call ittour (7) write (5,1) (pname(i),i=1,8) call getstr (5,instr(k),79-k,err) ihere = 10 c Allow 5 characters for format text, 50 characters for label text 23022 continue if(.not.(j .le. 3))goto 23024 instr(k+ 5) = 0 goto 23025 c else 23024 continue instr(k+50) = 0 23025 continue c Copy the string into the appropriate place if(.not.(j .eq. 1))goto 23026 call scopy (instr(k),xfmt) goto 23027 c else 23026 continue if(.not.(j .eq. 2))goto 23028 call scopy (instr(k),yfmt) goto 23029 c else 23028 continue if(.not.(j .eq. 3))goto 23030 call scopy (instr(k),rfmt) goto 23031 c else 23030 continue if(.not.(j .eq. 4))goto 23032 call scopy (instr(k),xlabel) goto 23033 c else 23032 continue if(.not.(j .eq. 5))goto 23034 call scopy (instr(k),ylabel) goto 23035 c else 23034 continue if(.not.(j .eq. 6))goto 23036 call scopy (instr(k),rlabel) 23036 continue 23035 continue 23033 continue 23031 continue 23029 continue 23027 continue return c It's not arithmetic and it's not text, so it must be an error. 23020 continue 15 j = len(instr) if(.not.(instr(j) .eq. ','))goto 23038 j = j - 1 23038 continue write (5,3) (instr(i),i=1,j) if(.not.(ihere .eq. 5))goto 23040 goto 5 goto 23041 c else 23040 continue if(.not.(ihere .eq. 10))goto 23042 goto 10 23042 continue 23041 continue 20 return end