c c subroutine getmsg (instr) c c PROG NAME: GETMSG.rat c c DATE OF FIRST VERSION: 31-Mar-80 c DATE OF CURRENT VERSION: 21-Jun-83 c c PURPOSE: PLTFIL routine to obtain message lines c c USAGE: call GETMSG (INSTR) c c Where INSTR = Byte array with first message line c c SUBROUTINES REQUIRED: RT-11 string functions c c PROGRAMMER: Mike Collins / Eric Javel / Matt Prucka c 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 byteinstr(1) logical*1err,term external len,index 1 format ('$Enter message line. Terminate with blank line: ') 2 format (1x,72a1) 3 format (' *** Message Buffer Full ***') c c------------------------------------------------------------- c c ... Clear the message buffer c for i=1 23000 if(.not.(i.le.256))goto 23002 msg(i) = 0 i=i+1 goto 23000 c endfor 23002 continue c Get the first line of the message and copy it into the message buffer, c eliminating the leading quotation mark term = .false. lunit = lunin call trim (instr) call scopy (instr(2),instr) if(.not.(instr(1).eq.'*'))goto 23003 term = .true. call ittour (7) write (5,1) lunit = 5 call getstr (5,instr,72,err) call trim (instr) if(.not.(len(instr) .eq. 0))goto 23005 return 23005 continue 23003 continue nc = len (instr) + 1 call scopy (instr,msg) c Get more lines until a delimiting quotation mark is found, c separating the lines with special control character 21 if(.not.(index(msg,'"') .eq. 0))goto 23007 c repeat 23009 continue msg(nc) = 21 nc = min0 (nc+1,256) if(.not.(term))goto 23012 call ittour (7) write (5,1) 23012 continue call getstr (lunit,instr,72,ierr) if(.not.(ierr.lt.0))goto 23014 goto 23011 23014 continue call trim (instr) lenlin = len (instr) if(.not.(lenlin.eq.0 .and. term))goto 23016 goto 23011 23016 continue if(.not.(.not.term .and. ecflg))goto 23018 write (5,2) (instr(i),i=1,lenlin) 23018 continue if(.not.(nc+lenlin .le. 256))goto 23020 if(.not.(lenlin .gt. 0))goto 23022 call scopy(instr,msg(nc),lenlin) goto 23023 c else 23022 continue if(.not.(nc .lt. 256))goto 23024 call scopy (instr,msg(nc),257-nc) 23024 continue write (5,3) 23023 continue 23020 continue nc = min0 (nc+lenlin,256) 23010 if(.not.(index (instr,'"') .ne. 0))goto 23009 23011 continue 23007 continue msg(nc-1) = 21 return end