c Initialise the internal variables prior to setting up a screen subroutine NEWSCR() c Assume all fields are character: default include 'SCRLIB.INC' common /newzzz/fresh logical*1 fresh data fresh/.true./ if(fresh)then !Intercept these: call errset(55,.true.,.false.,.true.,.false.,) !'O/P Convsn Error' call errset(56,.true.,.false.,.true.,.false.,) !'I/P Convsn Error' fresh=.false. endif ind=0 maxind=0 changd=.false. do 10 i=1,40 ix(i)=0 iy(i)=0 L(i)=0 LDP(i)=0 nvar(i)=0 fvar(i)=0.0 intf(i)=.false. realf(i)=.false. 10 continue return end c PUTx routines transfer data from the user to the internal screen c manager. The data is displayed and editied by the EDITIT routine c above. The data is retrieved by the MATCHING (in type and order) c GETx routines. c As an extra convenience the user specifies the format to be used c in the display for each variable. subroutine PUTC(ixc,iyc,string,formt) c Character string c formt MUST be of the form '(An)' or '(Ann)', where 0 return 30 call goXY(1,24) type 1000,bel,ind 1000 format('+',A,'GETC-F-Order of GET commands incorrect at ',I2,$) call exit() end subroutine getCD(text) include 'SCRLIB.INC' character*40 text ind=ind+1 if(intf(ind).or.realf(ind))goto 30 j=L(ind) !User supplied length of TEXT text(1:j)=field(ind)(1:j) !Copy over that much text return 30 call goXY(1,24) type 1000,bel,ind 1000 format('+',A,'GETCD-F-Order of GET commands incorrect at ',I2,$) call exit() end subroutine getB(B) c Matches PUTB include 'SCRLIB.INC' integer*4 J byte B ind=ind+1 if(.not.intf(ind))goto 10 J=nvar(ind) J=J.and."377 B=J return 10 call goXY(1,24) type 1000,bel,ind 1000 format('+',A,'GETB-F-Order of GET commands incorrect at ',I2,$) call exit() end subroutine getI(I) c Matches PUTI include 'SCRLIB.INC' integer*4 J integer*2 I ind=ind+1 if(.not.intf(ind))goto 10 J=nvar(ind) J=J.and."177777 I=J return 10 call goXY(1,24) type 1000,bel,ind 1000 format('+',A,'GETI-F-Order of GET commands incorrect at ',I2,$) call exit() end subroutine getJ(J) c Matches PUTJ include 'SCRLIB.INC' integer*4 J ind=ind+1 if(.not.intf(ind))goto 10 J=nvar(ind) return 10 call goXY(1,24) type 1000,bel,ind 1000 format('+',A,'GETJ-F-Order of GET commands incorrect at ',I2,$) call exit() end subroutine getF(F) c Matches PUTF include 'SCRLIB.INC' ind=ind+1 if(.not.realf(ind))goto 10 F=fvar(ind) return 10 call goXY(1,24) type 1000,bel,ind 1000 format('+',A,'GETF-F-Order of GET commands incorrect at ',I2,$) call exit() end subroutine GetLF(flag) c Matches PUTLF include 'SCRLIB.INC' logical*1 flag character*1 fred ind=ind+1 if(intf(ind).or.realf(ind))goto 10 fred=field(ind)(1:1) if(fred.eq.'t'.or.fred.eq.'T')then flag=.true. else flag=.false. endif return 10 call goXY(1,24) type 1000,bel,ind 1000 format('+',A,'GETLF-F-Order of GET commands incorrect at ',I2,$) call exit() end c Special format Date routines subroutine PutDat(ix,iy,day,month,year) c Put up the date in editable format integer*2 ix,iy,day,month,year call putI(ix,iy,day,'(I2)') type 1000 1000 format('+','/',$) call putI(ix+3,iy,month,'(I2)') type 1000 call putI(ix+6,iy,year,'(I2)') return end subroutine GetDat(day,month,year) c Matches PUTDAT integer*2 day,month,year call getI(day) call getI(month) call getI(year) return end subroutine EraseS(x,y) c Go to (x,y) and erase rest of screen integer*2 x,y include 'SCRLIB.INC' call goxy(x,y) type 1000,esc 1000 format(x,A,'[0J',$) return end subroutine EraseR(x,y) c Go to (x,y) and erase rest of Row include 'SCRLIB.INC' integer*2 x,y call goXY(x,y) type 1000,esc 1000 format(x,A,'[0K',$) return end