cls
on error goto handle
Print"                         **********ICELIST*************"
locate 3,12:print "(provides formatted listing of ICES station files)"
locate 5,10:input "ICES File name ";b$
open b$ for input as #1
j=instr(b$,".")

if j = 0 then
bind$=b$
else
bind$=left$(b$,j-1)
end if
bout$=bind$+".LST"

open bout$ for output as #2
Print #2,tab(20) "Data set: ";b$;" - listing created ";date$
print #2,
dim o3st(4),o3ln(4),o3dc(4)
dim chst(15),chln(15),chdc(15)

data 28,4,0,32,4,2,36,5,3,58,3,2 '03 record
for i = 1 to 4
read o3st(i),o3ln(i),o3dc(i)
next i
data 28,4,0,32,4,2,36,4,2,40,3,2,43,3,2,46,3,2,49,3,1 '76 record
data 52,3,1,55,3,2,58,3,1,61,3,1,64,3,1,74,3,1
for i = 1 to 13
read chst(i),chln(i),chdc(i)
next i

dim opu$(0:9) ' overpunches
data "}","J","K","L","M","N","O","P","Q","R"
for i = 0 to 9
read opu$(i)
next i

while not eof(1)
line input #1,a$
rec$=mid$(a$,80,1)

select case rec$
case "J"
if stn<>0 then
print #2,
print #2,string$(80,"_");
print #2,
end if
gosub mast
print #2,:print #2,
print #2,"Cou/     Stat             Position               Date       Time    Sounding"
print #2,"ship      No         Lat           Long                               (m)"
print #2,
print #2,mas$
print #2,
print #2," p      T     S    O2    PO4    TP   SIL   NO3   NO2   NH4   TN     H2S  CHL"
print #2,"(m)    (C)       (ML/L)                      (uM)                       (MG/L)"
print #2,
stn=stn+1
locate 20,20:print "Station ";stn;"      being listed"
case "3"
gosub o3
print #2,o3$
case "6"
gosub chem
print #2,ch$
end select
wend
print:print "               job done.... your listing is in file: ";bout$

end
mast:

mas$=""
mas$=mas$+mid$(a$,1,4)+"     "
par$=mid$(a$,5,4)
opu1=asc(right$(par$,1))
if opu1>58 then
gosub opu1
i$=right$(str$(i),1)
if i$=" " then i$="0"
mid$(par$,4)=i$
end if

mas$=mas$+par$+"     " 'sts num

if mid$(a$,18,1)="0" then qn$="N":qe$="E"
if mid$(a$,18,1)="1" then qn$="N":qe$="W"
if mid$(a$,18,1)="2" then qn$="S":qe$="E"
if mid$(a$,18,1)="3" then qn$="S":qe$="W"
if mid$(a$,18,1)>"3" or mid$(a$,18,1)=" " then qn$="?":qe$="?"

'position
mas$=mas$+mid$(a$,9,2)+" "+mid$(a$,11,2)+"."+mid$(a$,65,2)+qn$+"     "
mas$=mas$+mid$(a$,13,3)+" "+mid$(a$,16,2)+"."+mid$(a$,67,2)+qe$+"     "
'data/time
mas$=mas$+mid$(a$,24,2)+"/"+mid$(a$,22,2)+"/"+mid$(a$,20,2)+"     "
mas$=mas$+mid$(a$,26,2)+":"+mid$(a$,69,2)+"     "
'sounding
mas$=mas$+mid$(a$,28,4)

return

o3: ' layout 03 records
o3$=""
par$=mid$(a$,o3st(1),o3ln(1)) ' depth
opu1=asc(right$(par$,1))
if opu1>58 then
gosub opu1
i$=right$(str$(i),1)
if i$=" " then i$="0"
mid$(par$,4)=i$
end if
o3$=o3$+par$+" "
par$=mid$(a$,o3st(2),o3ln(2)) 'temp
if left$(par$,1)="}" then mid$(par$,1)="-"
if par$<>string$(o3ln(2),32) then
 o3$=o3$+left$(par$,o3ln(2)-o3dc(2))+"."+right$(par$,o3dc(2))+" "
 else
 o3$=o3$+par$+"  "
end if
par$=mid$(a$,o3st(3),o3ln(3)) ' salinity
if par$<>string$(o3ln(3),32) then
o3$=o3$+left$(par$,o3ln(3)-o3dc(3))+"."+right$(par$,o3dc(3))+" "
else
o3$=o3$+par$+"  "
end if
par$=mid$(a$,o3st(4),o3ln(4)) 'oxygen
wid=o3ln(4)
gosub overflow
wid=wid+1
if par$<>string$(wid,32) then
o3$=o3$+left$(par$,wid-o3dc(4))+"."+right$(par$,o3dc(4))
end if
return

chem: 'layout chemistry records
ch$=""
par$=mid$(a$,chst(1),chln(1)) ' depth
opu1=asc(right$(par$,1))
if opu1>58 then
gosub opu1
i$=right$(str$(i),1)
if i$=" " then i$="0"
mid$(par$,4)=i$
end if
ch$=ch$+par$+" "
par$=mid$(a$,chst(2),chln(2)) 'temp
if left$(par$,1)="}" then mid$(par$,1)="-"
if par$<>string$(chln(2),32) then
 ch$=ch$+left$(par$,chln(2)-chdc(2))+"."+right$(par$,chdc(2))+" "
 else
 ch$=ch$+par$+"  "
end if
par$=mid$(a$,chst(3),chln(3)) ' salinity
if par$<>string$(chln(3),32) then
ch$=ch$+left$(par$,chln(3)-chdc(3))+"."+right$(par$,chdc(3))+"  "
else
ch$=ch$+par$+"   "
end if

for ii= 4 to 13 ' oxygen-nutrients-chlroophyll
if (ii>4 and ii<13) and mid$(A$,79,1)="P" then
chdcn=chdc(ii)-1
else
chdcn=chdc(ii)
end if
par$=mid$(a$,chst(ii),chln(ii))
wid=chln(ii)
gosub overflow
wid=wid+1
if par$<>string$(wid,32) then
ch$=ch$+left$(par$,wid-chdcn)+"."+right$(par$,chdcn)+" "
else
ch$=ch$+par$+"  "
end if
next ii
return

opu1: 'transforming opunch to number
for i = 0 to 9
if asc(opu$(i))=opu1 then fd
next i
fd:
if i=10 then print "Illegal character":end
return

overflow: ' allows for overpunch in field
opu1=asc(left$(par$,1))
if opu1>58 then
gosub opu1
i$=right$(str$(i),1)
if i$=" " then i$="0"
par$="1"+i$+right$(par$,wid-1)
else
par$=" "+par$
end if
return
handle:
print "error ";err
end
