key off
on error goto handle
f$=command$
if f$<>"" then jmpe
cls
locate 1,1,0
PRINT "                   ***** Hydro-Chemistry View Utility *****"
print "                      Provided with the compliments of the .."
print "              International Council for the Exploration of the Sea"
Print "                                  (ICES)"
print string$(80,196)
Color 9,0
print spc(55);"*":print:
color 23,0:print spc(30);"*":color 7,0
print:print spc(25);"*";spc(9);"*"
print:print spc(40);"*";spc(6);"*":print:print spc(40);"*     ";
print "*"
print string$(80,196)
Print "                              Pal‘gade 2-4"
print "                              1261 Copenhagen K"
print "                              Denmark"
print "                   Telemail - ICES.DK/Omnet"
print

locate 25,1
color 0,7
print " F5 - Help/Options";tab(40);"Any other key to procede with analysis ";
color 7,0

while not instat
wend
in$=inkey$
if len (in$)=2 and asc(right$(in$,1))=63 then gosub info
jmpe:
if f$="?" then gosub info

key off
dim cs(23),cl(23),cd(23),dsp$(15)
dim pout(3,600),recno(600)
dim ast(20:194,8:100),bst(20:194,101:191)
'set up graphics screen - checks for screen type (not hercules)
min1=-1000:min2=-1000

if ucase$(f$)="H" then

xx2=720:yy2=348:xx1=0:yy1=0
sc=2:screen 2:bl=25

else
xx2=639:xx1=0:yy1=0:bl1=1

sc=12:screen 12:yy2=479:bl=31:exit if
sc11:
sc=11:screen 11:yy2=479:bl=31:exit if
sc10:
sc=10:screen 10:yy2=349:bl=25:exit if
sc09:
sc=9:screen 9:yy2=349:bl=25:exit if
sc08:
sc=8:screen 8:yy2=199:bl=25:exit if
sc07:
sc=7:screen 7:yy2=199:bl=25:exit if
sc02:
sc=2:screen 2:yy2=199:bl=25:exit if
end if

if ucase$(f$)="S" or ucase$(f$)="E" then 'reduce y scaling for point routine
yy3=199
bl1=2
else
yy3=yy2
end if

cls
locate 3,1
Input "Enter Name of Data File (ICES Format) "; B$
OPEN "I",#1,B$

j=instr(b$,".")

if j = 0 then
bind$=b$
else
bind$=left$(b$,j-1)
end if
j=0
bout$=bind$+".SUS"
bstor$=bind$+".STO"
ber$=bind$+".ERR"
dsp$(1)="p  ":dsp$(2)="t  ":dsp$(3)="S  ":dsp$(4)="O2 "
dsp$(5)="PO4":dsp$(6)="TP ":dsp$(7)="SiO":dsp$(8)="NO3"
dsp$(9)="NO2":dsp$(10)="NH4":dsp$(11)="TN ":dsp$(12)="H2S":dsp$(13)="pH "
dsp$(14)="Alk":dsp$(15)="Chl"
if ucase$(f$)="S" then win

minp:
print
print " t / S / O2 only......... enter 3"
input " t / S / O2 + nutrients.. enter 6 (default 3) "; rec$
if rec$="6" then npar=23
if rec$="3" then npar=12
'if rec$="2" then npar=11
if rec$="" then rec$="3":npar=12
if npar=0 then print CHR$(25):print "Pay b.... attention!!":goto minp
print:print "Parameter list:"
'Print" 1- cou/ship, 2 -number 3- lat, 4 - long, 5- quadr, 6 - year, 7 - month"
'Print" 8 - sounding,"
print" <1> - pressure  <2> - temperature     <3> - salinity <4> - 0xygen"
if rec$="6" then
Print" <5> - phosphate <6> - Total Phosphate <7> - silicate <8> - nitrate"
print" <9> - nitrite  <10> - ammonium       <11> - Total Nitrogen"
print"<12> - H2S      <13> - pH             <14> - Alkalinity <15> -chlorophyll"
end if
print

' ICES format - start, field width and No of decimals

data 1,4,0,5,4,0,9,4,0,13,5,0,18,1,0,20,2,0,22,2,0
data 28,4,0,28,4,0,32,4,2,36,4,2,40,3,2,43,3,2
data 46,3,2,49,3,1,52,3,1,55,3,2,58,3,1,61,3,1
data 64,3,1,67,3,2,70,4,3,74,3,1

for i = 1 to npar
  read cs(i),cl(i),cd(i)
next i

if rec$="3" then cs(npar)=58:cl(npar)=3:cd(npar)=2
input "1st parameter no - y-axis (default 2):";par1(1)
par1(1)=par1(1)+8
if par1(1)=8 or par1(1)>npar then par1(1)=10
input "2nd parameter no - x-axis (default 3):";par1(2)
par1(2)=par1(2)+8
if par1(2)=8 or par1(2)>npar then par1(2)=11
Print "(3rd parameter is 1 (depth) - y-axis)":par1(3)=9
print:
'max coordinates
input "1st parameter - value at top of y-axis (default 20)    ";max$
if max$="" then y1top(1)=20:y1top$(1)="20" else y1top(1)=val(max$):y1top$(1)=max$
input "1st parameter - value at bottom of y-axis (default -1) ";max$
if max$="" then y1bot(1)=-1:y1bot$(1)="-1" else y1bot(1)=val(max$):y1bot$(1)=max$
input "2nd parameter - value at left of x-axis (default 30)   ";max$
if max$="" then xleft(1)=30:xleft$(1)="30" else xleft(1)=val(max$):xleft$(1)=max$
input "2nd parameter - value at right of x-axis (default 36)  ";max$
if max$="" then xright(1)=36:xright$(1)="36" else xright(1)=val(max$):xright$(1)=max$
print:
input "Depth parameter - value at top (default -1) ";max$
if max$="" then y1top(2)=-1:y1top$(2)="-1" else y1top(2)=val(max$):y1top$(2)=max$
Input "Depth parameter - value at bottom (default 100) ";max$
if max$="" then y1bot(2)=100:y1bot$(2)="100" else y1bot(2)=val(max$):y1bot$(2)=max$

xleft(2)=y1bot(1):xleft$(2)=y1bot$(1)
xright(2)=y1top(1):xright$(2)=y1top$(1)
xleft(3)=xleft(1):xleft$(3)=xleft$(1)
xright(3)=xright(1):xright$(3)=xright$(1)

y1top(3)=y1top(2):y1top$(3)=y1top$(2)
y1bot(3)=y1bot(2):y1bot$(3)=y1bot$(2)
cls

 ' divides screen into three equal portions, with 10% gaps between
win:
grsc=sc:sc=0
winfr=xx2/3
wixa(1)=winfr-90*winfr/100
wixb(1)=winfr-10*winfr/100
wixa(2)=2*winfr-90*winfr/100
wixb(2)=2*winfr-10*winfr/100
wixa(3)=3*winfr-90*winfr/100
wixb(3)=3*winfr-10*winfr/100
wixa(4)=0:wixb(4)=xx2
ycomp=yy3/20 ' suppressses vericla width 5%
window screen (xx1,yy3) - (xx2,yy1)

if ucase$(f$)="S" then
fds=1
open "I",#3,bstor$
fds=0
cls
fram=1:gosub vew:gosub box

input #3,par1(1),par1(2),par1(3),npar
input #3,y1top(1),y1top$(1),y1bot(1),y1bot$(1)
input #3,xleft(1),xleft$(1),xright(1),xright$(1)
input #3,y1top(2),y1top$(2),y1bot(2),y1bot$(2)



col=2:yw=1:gosub dspcol
locate 1+bl*(yy3-ycomp)/yy3,14:print dsp$(par1(2)-8);
locate 1+(bl-10)*(ycomp)/(yy3),1:print y1top$(1);
locate 1+(bl-bl1)*(yy3-ycomp)/yy3,1:print y1bot$(1);
locate 1+bl*(yy3-ycomp)/yy3,2:print xleft$(1);
locate ,23:print xright$(1);
while not eof(3)
input #3,x,y,recno
if y>100 then bst(x,y)=recno else ast(x,y)=recno
pset (x,y)
wend

locate 1,3

numb$="    ":lat$="    ":hem$=" ":long$="     ":qua$=" ":hr$="      "
ship$="    "
print "Station: ";numb$; " Position: ";lat$;hem$;" ";long$;qua$;" ";" Date: ";hr$;
print " Ship: ";ship$;" Profile: ";stn;


close #3
open "A",#2,bout$
goto locn
end if

for ii = 1 to 3
fram=ii:gosub vew:gosub box
next ii

col=2:yw=1:gosub dspcol
col=28:yw=3:gosub dspcol
col=55:gosub dspcol:goto dsprow

dspcol:

locate bl/2,col
for ii= 1 to 3
print mid$(dsp$(par1(yw)-8),ii,1)
locate ,col
next ii

return

dsprow:

locate 1+bl*(yy3-ycomp)/yy3,14:print dsp$(par1(2)-8);
locate ,40:print dsp$(par1(1)-8);
locate ,67:print dsp$(par1(2)-8);
locate 1+(bl-10)*(ycomp)/(yy3),1:print y1top$(1);
locate ,27:print y1top$(2);:locate ,54:print y1top$(3);
locate 1+(bl-bl1)*(yy3-ycomp)/yy3,1:print y1bot$(1);
locate ,27:print y1bot$(2);:locate,54:print y1bot$(3);
locate 1+bl*(yy3-ycomp)/yy3,2:print xleft$(1);
locate ,23:print xright$(1);
locate ,29:print xleft$(2);:locate ,50:print xright$(2);
locate ,56:print xleft$(3);:locate ,76:print xright$(3);

while not eof(1)
Line input #1,A$
gosub cycl
wend
gosub drawing:goto lst
cycl:

incr recn
COD$=mid$(A$,79%,2%):cd$=mid$(a$,80%,1%)
if cod$="0J" or cod$="01" then
if first = 1 then gosub drawing
numb$=mid$(a$,5,4):Lat$=mid$(a$,9,4):long$=mid$(a$,13,5)
quad$=mid$(a$,18,1):hr$=mid$(a$,20,6):ship$=mid$(a$,1,4)
if quad$="1" or quad$="3" then qua$="W" else qua$="E"
if quad$="0" or quad$="1" then hem$="N" else hem$="S"
if first =0 then gosub drawing:first=1
prof=0:erase pout
snd$=mid$(a$,28,4):goto nxt
end if

if COD$="P6" then de=1
if CD$="3" or cd$="2" then hd=1
if cd$=REC$ then
 incr prof:gosub make:de=0
 recno(prof)=recn
end if

nxt:
return

lst:
do until s=27
while not instat
wend
s$=inkey$
s=asc(s$)
wend
open "O",#2,bout$
if maxrec1>0 then
print #2,dsp$(par1(1)-8);" record no: ";maxrec1;tab(35);" maximum = ";max1
print #2,dsp$(par1(1)-8);" record no: ";minrec1;tab(35);" minimum = ";min1
end if
if maxrec2>0 then

print #2,dsp$(par1(2)-8);" record no: ";maxrec2;tab(35);" maximum = ";max2
print #2,dsp$(par1(2)-8);" record no: ";minrec2;tab(35);" minimum = ";min2
end if
if maxrec3>0 then
print #2,dsp$(par1(3)-8);" record no: ";maxrec3;tab(35);" maximum = ";max3
end if

if ucase$(f$)="E" then locn

end

drawing:
if prof=0 then return

fram=4
gosub vew

locate 1,3
incr stn
print "Station: ";numb$; " Position: ";lat$;hem$;" ";long$;qua$;" ";" Date: ";hr$;
print " Ship: ";ship$;" Profile: ";stn;

fram=1 'frame 1
for ii= 1 to prof
if pout(1,ii)<-7 then sk1

par=pout(1,ii)
if par>max1 then max1=par:maxrec1=recno(ii)
if min1=-1000 then min1=par:minrec1=recno(ii)
if par<min1 then min1=par:minrec1=recno(ii)
gosub ypos
if pout(2,ii)<-7 then sk1
par=pout(2,ii)
if par>max2 then max2=par:maxrec2=recno(ii)
if min2=-1000 then min2=par:minrec2=recno(ii)
if par<min2 then min2=par:minrec2=recno(ii)
gosub xpos
if ucase$(f$)="E" then
 if x<wixa(1) or x>wixb(1) then exit if
 if y>yy3-ycomp or y<yy1+ycomp then exit if
 if y>100 then
  bst(x,y)=recno(ii)

 else
  ast(x,y)=recno(ii)
 end if
end if
gosub vew

pset (x,y)
sk1:
next ii
fram=2
for ii = 1 to prof
'if pout(3,ii)<7 or pout(1,ii)<7 then sk2
par=pout(3,ii)
if par>max3 then max3=par:maxrec3=recno(ii)
gosub ypos
par=pout(1,ii)
gosub xpos
gosub vew
pset (x,y)
sk2:
next ii

fram=3
for ii = 1 to prof
'if pout(3,ii)<7 or pout(2,ii)<7 then sk3
par=pout(3,ii)
gosub ypos
par=pout(2,ii)
gosub xpos
gosub vew
pset (x,y)
sk3:
next ii

if inkey$=" " then
 while not instat
 wend
end if
return

vew:
view screen (wixa(fram),yy1+ycomp) - (wixb(fram),yy2-ycomp)
return

box:
line (wixa(fram),yy1+ycomp) - (wixb(fram),yy1+ycomp)
line -(wixb(fram),yy3-ycomp)
line -(wixa(fram),yy3-ycomp)
line -(wixa(fram),yy1+ycomp)
return

ypos: ' position y component
her1=1
y=((yy1+ycomp-yy3+ycomp)/(y1top(fram)-y1bot(fram)))*par
y=y+((yy3-ycomp)*y1top(fram)-(yy1+ycomp)*y1bot(fram))/(y1top(fram)-y1bot(fram))
y=clng(y)
her1=0
return

xpos:
her2=1
x=((wixa(fram)-wixb(fram))/(xleft(fram)-xright(fram)))*par
x=x+(wixb(fram)*xleft(fram)-wixa(fram)*xright(fram))/(xleft(fram)-xright(fram))
x=clng(x)
her2=0
return

make: 'sub to prepare output

for ird= 1 to 3
i=par1(ird)
po=cs(i):ln=cl(i)
if i>12 then dec=cd(i)-de else dec=cd(i)
if i = 11 and cd$="3" then
 dec=cd(i)+hd:ln=ln+1:
end if
if i = 8 then
  pr$=SND$
  else
  pr$=mid$(a$,po,ln)
end if
for t= 1 to len(pr$)
 if mid$(pr$,t,1)<>" " then po1
next t
no=-90:dec=1:goto po2

po1:

 if po<8 then ' don't check overpunch
 pout(ird,prof)=val(pr$)
 goto po3
 end if
 call opunch(pr$,ln-1,po,no,tp,cd$)
 if tp=1 then end
po2:
 no=no/10^dec:

 pout(ird,prof)=no
po3:
 rem print #2:tab(j);no;

'print pout(ird,prof);
if pout(ird,prof)<-8 then exit for
next ird

RETURN

info:
cls
locate 3,5:
print "TSLOOK functions only on station data files in the ICES format"
locate ,5
print "This must be available in your current directory":print
locate ,5
print "The following screen types are supported:"
print:locate ,25:Print "CGA/EGA/MCGA/VGA"
print
locate ,5:Print "If you have a HERCULES card, press 'H' on leaving this screen"
locate ,5:
print "You may also implement the Hercules option by returning to DOS"
locate ,5:print "and typing TSLOOK H - be warned though, the Hercules option
locate ,5:print "has not yet been fully tested - contact ICES if you wish"
locate ,5:print "a functional version to be developed"
print:locate ,5
print "When running the program, you will notice that progress through"
locate ,5
print "the data file is continuous. To stop on each station press the space"
locate ,5
print "bar; press any other key to return to the default mode. "
locate ,5
print:print:print

locate ,15:
print "Press any key for more information"
while not instat
wend
s$=inkey$
s$=""
cls
locate ,5
print "The program produces three plots - x/y; pressure/x; and pressure/y"
locate ,5
print "where x and y are a hydrochemistry pair eg t or S or PO4 or SIO3 etc"
print:locate ,5
locate ,33:Print "OPTIONS"
locate ,5:Print "Three options to running this program are available"
print "1:";:locate ,5
print "The default option provides a view facility only. On start up just"
locate,5:print "type TSLOOK (or leave this page by pressing 'any other key'."
print "2:";:locate ,5
print "When you start up by typing TSLOOK E (or leave this page by pressing 'E')"
locate,5:
print "then, when plotting is completed, and <Esc> is pressed, a '+' appears on"
locate,5
print "on the left hand x/y picture.  This enables you, by means of the cursor"
locate ,5
print "keys, to locate the actual record and station pertaining to any particular"
locate ,5
print "plotted '.'  By pressing return, the record will then be stored in a file"
locate ,5:
print "with a .SUS extension. Pressing TAB stores the whole station"
print "3:";
locate ,5
print "When you start up by typing TSLOOK S (or leave this page by pressing 'S')"
locate ,5
print "the x,y page is immediately re-drawn. This enables you to re-examine the "
locate,5
print "the plotted '.'s as in option 2.  To run this option requires a .STO file"
locate ,5
print "produced by option 2."
print
locate ,35:print "NOTE!!"
locate ,5
print "When exercising options 2 or 3 (TSLOOK E or TSLOOK S) memory limitations"
locate ,5
print "dictate that the vertical resolution is reduced (to that of CGA)."
locate ,5
print ".... Sorry, but good luck.  We hope you enjoy using this program"
print
locate ,5
print "Press 'E', 'S' or any key to continue - but <Esc> aborts!";
do until s$<>""
while not instat
wend
s$=inkey$
s=asc(s$)
wend
cls
If s=27 then end
if ucase$(s$)="S" or ucase$(s$)="E" or ucase$(s$)="H" then f$=ucase$(s$)

return

locn: '- edit with cursor/mouse
close #1
open "R",#1,b$,82
field #1, 82 as a$

locate 1,65:print "   POINT      ";

fram=1:gosub vew
wixa(1)=30:wixb(1)=180

stp=1
y=int(yy3/2)
x=100
if ucase$(f$)="S" then
   for i = 1 to npar
    read cs(i),cl(i),cd(i)
    next i
end if
if npar=12 then cl(11)=cl(11)+1
if npar=12 then cs(npar)=58:cl(npar)=3:cd(npar)=2
gosub plce
s=0

while s<>27
s$=inkey$
if s$<>"" then

s=asc(right$(s$,1))

gosub dir
end if

wend

if ucase$(f$)="E" then


fram=4:gosub vew
screen 0
cls
LOCATE 9,5
print "Do you wish the ";dsp$(par1(1)-8);"/";dsp$(par1(2)-8);" picture";
print " to be stored in file ";bstor$;" ";:input s$

if ucase$(left$(s$,1))="Y" then
open "O",#3,bstor$
write #3,par1(1),par1(2),par1(3),npar
write #3,y1top(1),y1top$(1),y1bot(1),y1bot$(1)
write #3,xleft(1),xleft$(1),xright(1),xright$(1)
write #3,y1top(2),y1top$(2),y1bot(2),y1bot$(2)

locate 11,5
Print "Saving Picture.";
for i = 20 to 194
for j = 8 to 100
incr ut
if ut/600=int(ut/600) then print ".";
if ast(i,j)>0 then write #3,i,j,ast(i,j)
next j
next i
for i = 20 to 194
for j = 101 to 191
if bst (i,j)>0 then write #3,i,j,bst(i,j)
incr ut
if ut/600=int(ut/600) then print ".";
next j
next i

end if
end if
cls

end

dir:
if s=13 or s=9 then

if store>=1 then
beep:beep
 if s = 13 then
  if ber=0 then
  ber=1
  open "O",#4,ber$
 end if
  print #4,"record:";
  print #4,using "#######";store;
  print #4," /      outlier      ";
  print #4,dsp$(par1(1)-8);" - ";dsp$(par1(2)-8)
else
gosub outst
end if
locate 1,68:print " SAVED"
end if
end if
if s=82 then
 if stp=1 then
 stp=10
 else
 stp=1
 end if
end if

if s=77 then
gosub rst
if x+stp<193 then x=x+stp
end if
if s=75 then
gosub rst
if x-stp>21 then x=x-stp
end if
if s=72 then
gosub rst
if y-stp>9 then y=y-stp
end if
if s=80 then
gosub rst
if y+stp<190 then y=y+stp
end if
gosub plce
ii=0:ij=0:gosub whch
if store >0 then
flg=1
get #1,store
if ucase$(f$)="E" then
locate 1+bl*(yy3-ycomp)/yy3,1:print string$(80,32);
locate 1+bl*(yy3-ycomp)/yy3,2
print " Record Number ";store;"       ";
locate ,32:print dsp$(1); " ";mid$(a$,cs(9),cl(9));"   ";
print dsp$(par1(1)-8);" ";mid$(a$,cs(par1(1)),cl(par1(1)));"   ";
print dsp$(par1(2)-8);" ";mid$(a$,cs(par1(2)),cl(par1(2)));

else

'locate 10,35:print "Record Number ";store;"         ":print
'locate ,35:print dsp$(1); " ";mid$(a$,cs(9),cl(9));"   ";
'print dsp$(par1(1)-8);" ";mid$(a$,cs(par1(1)),cl(par1(1)));"   ";
'print dsp$(par1(2)-8);" ";mid$(a$,cs(par1(2)),cl(par1(2)))

locate 3,35:print "Record Number ";store;"         ":print
locate ,35:print dsp$(1);"   ";dsp$(par1(1)-8);"    ";dsp$(par1(2)-8);
print "    ";"Rec No."

gosub lisst

end if
locate 1,60:Print mid$(a$,1,4);
locate 1,47:print mid$(a$,20,6);
hem$="W"
if mid$(a$,18,1)="0" or mid$(a$,18,1)="2" then hem$="E"
locate 1,33:print mid$(a$,13,5)+hem$;
hem$="N"
if mid$(a$,18,1)>"1" then hem$="S"
locate 1,27:print mid$(a$,9,4)+hem$;
locate 1,12:print mid$(a$,5,4);

else
  if flg=1 then
   locate 1,65:print "   POINT       ";
    if ucase$(f$)="E" then
     locate 1+bl*(yy3-ycomp)/yy3,1:print string$(80,32);
     locate 1+bl*(yy3-ycomp)/yy3,14:print dsp$(par1(2)-8);
     locate ,40:print dsp$(par1(1)-8);
     locate ,67:print dsp$(par1(2)-8);
     locate 1+(bl-bl1)*(yy3-ycomp)/yy3,1:print y1bot$(1);
     locate ,27:print y1bot$(2);:locate,54:print y1bot$(3);
     locate 1+bl*(yy3-ycomp)/yy3,2:print xleft$(1);
     locate ,23:print xright$(1);
     locate ,29:print xleft$(2);:locate ,50:print xright$(2);
     locate ,56:print xleft$(3);:locate ,76:print xright$(3);
     flg=0
    end if
  end if
end if
return

whch: 'divides array into 64k units

select case y+ij
case <101
store=ast(x+ii,y+ij)
case <201
store=bst(x+ii,y+ij)
end select
return

plce:
for ii = -2 to 2

pset(x+ii,y)
next ii
for ij = -2 to 2
pset (x,y+ij)
next ij
return

rst:
ij=0
for ii=-2 to 2
if x+ii>=0 and y>=0 then
gosub whch
if store=0 then
pset (x+ii,y),0
end if
end if
next ii
ii=0
for ij = -2 to 2
if y+ij>=0 and x>=0 then
gosub whch
if store=0 then
pset (x,y+ij),0
end if
end if
next ij
return

outst: ' to store whole station
outst1:
decr store
get #1,store
if mid$(a$,80,1)="J" then
print #2,mid$(a$,1,80)
outst2:
incr store
if store>lof(1)/82 then return
get #1,store
if mid$(a$,80,1)="J" then return
print #2,mid$(a$,1,80)
goto outst2
else
goto outst1
end if
return

lisst:
if npar>12 then rec$="6" else rec$="3"
locate 6,33
for i = 1 to 20
locate ,33:print string$(40,32)
next i
locate 6,33
store1=store:lisout=0
lisst1:
decr store1
get #1,store1
if mid$(a$,80,1)="J" or (store-store1)>10 then

lisst2:
incr store1:incr lisout
if lisout=20 then return
if store1>lof(1)/82 then return
get #1,store1
if mid$(a$,80,1)="J" then return
if mid$(a$,80,1)=rec$ then
locate,33:print mid$(a$,cs(9),cl(9));"    ";
print mid$(a$,cs(par1(1)),cl(par1(1)));"    ";
print mid$(a$,cs(par1(2)),cl(par1(2)));"   ";store1
end if
goto lisst2
else
goto lisst1
end if
return

handle:
if err=5 and sc>0 then
 if sc=12 then resume sc11
 if sc=11 then resume sc10
 if sc=10 then resume sc09
 if sc=9 then resume sc08
 if sc=8 then resume sc07
 if sc=7 then resume sc02
 if sc=2 then
  cls:locate 5,5
  print "Sorry, graphics screen type not supported - run aborted"
  end
 end if
end if
if err= 53 then
 cls
screen 0
locate 10,1
 if fds=1 then
 print "Option 'S' requires file ";bstor$;" to be available....it isn't so run aborted"
 goto nd
 else
 print "Data file ";b$;" not available ... run aborted"
 goto nd
 end if
 end if
screen 0
cls:print "error is ";err;" screen ";grsc
nd:
while not instat
wend
s$=inkey$
end



SUB OPUNCH(SH$,YT,YU,NO,TP,RE$)
REM TO SUBSTITUTE OPUNCHES TO REAL VALUES
REM :SH$/NUMBER:YT/LENGTH OF NUMBER:YU/START FIELD IN ICES FORMAT
REM :NO/NUMBER WITH OPUNCH REMOVED:TP/FLAG FOR ILLEGAL NO:RE$/RECORD TYPE

for i = 1 to yt+1
h%=asc(mid$(sh$,i,1))
if h%=32% then mid$(sh$,i)="0":goto ntop
if h%<48% or h%>57% then yesgo=1
ntop:
next i
if yesgo=0 then no=val(sh$):exit sub
yesgo=0

FOR I = 1 TO YT+1
 GG$=mid$(SH$,I,1):H%=ASC(GG$)
 IF H%=125% OR H%=45% OR H%=33% THEN H%=48%:NE=1:GOTO pro
 IF H%=123% OR H%=32% THEN H%=48%:GOTO pro
 IF H%>73% THEN H%=H%-25%:NE=1:GOTO pro
 IF H%>64% THEN H%=H%-16%
 IF H%>47% AND H%<58% THEN pro
 PRINT "ILLEGAL CHARACTER - ";mid$(SH$,I,1):CLOSE #1:CLOSE #2:TP=1:end
pro:

IF I=1 AND NE=1 AND YU=32 THEN SI=1:goto sh
IF I=1 AND NE=1 AND RE$="6" THEN
 if yu=40 or yu=43 or yu=49 or yu=52 or yu=58 or yu=74 then sj=1
 if yu=61 or yu=64 then sj=1
goto sh

end if
IF I=1 AND NE=1 AND YU=58 AND RE$="3" THEN SJ=1
sh:
mid$(sh$,i)=chr$(h%)

NEXT I
no=val(SH$)
IF SI=1 THEN NO=-NO:GOTO pro1
IF SJ=1 THEN NO=NO+1000

pro1:
SI=0:SJ=0:NE=0
END sub
