on error goto handle

dim mast$(19),b$(13)
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,67,3,2,70,4,3,74,3,1
for i = 1 to 15
read chst(i),chln(i),chdc(i)
next i


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

ma$="                                                                              0J"
hy$="                                                                              03"
ch$="                                                                              76"
cls
color 0,7

print "                     OCEAN PC File Conversion Module                            "
color 7,0
print
print "                             ****CD-ICES****"
print
print "Conversion from NODC CDROM format to ICES format"
print
input "Enter CDROM File Name ";fil1$
open fil1$ for binary as #1
if lof(1)=0 then
print
print "Input file name not found ... run aborted"
kill fil1$
end
end if
input "Enter File name for output ";fil2$
open fil2$ for output as #3
i=1:no=0:a$="":j=0:en=16000
seek #1,j
get$ #1,en,a$
while 1
l=i
i=instr(i+1,a$,chr$(10))
if i=0  then
	l=1
	seek #1,j
	get$ #1,en,a$
	i=instr(1,a$,chr$(10))
end if
if i=0 then
	print "Conversion completed - Converted file is - ";fil2$
	end
end if
rem delay 0.2
rem print mid$(a$,l,35),j,i-l
gosub setup
rem print mid$(a$,i+1,37)
i=i+1
j=j+i-l
wend
end

setup:

b$=mid$(a$,l,i-l)
lat$=mid$(b$,2,4)
long$=mid$(b$,6,5)
qu$=mid$(b$,1,1)
select case qu$
case="1"
qu$="0"
case="3"
qu$="2"
case="5"
qu$="3"
case="7"
qu$="1"
case else

print "illegal quadrant":end
end select

dt$="9"+mid$(b$,11,8)
cosh$=mid$(b$,20,4)
stn$=mid$(b$,33,4)
cyc=val(mid$(b$,24,3))
typ$=mid$(b$,27,1)
gosub mast
hyst=0:sel=0
if typ$<"3" then hyst=37:sel=1:gosub hyd
if typ$>"2" and typ$<"7" then sel=2:hyst=37:gosub hyd
if sel=0 then print "Illegal file type (";sel;") .. run aborted":end
return
mast:
ma1$=ma$
mid$(ma1$,1)=cosh$ 'country
mid$(ma1$,5)=stn$
mid$(ma1$,19)=dt$ 'year/mnth
mid$(ma1$,9)=lat$ 'latdeg
mid$(ma1$,13)=long$ 'longgdeg

mid$(ma1$,18)=qu$
stno=stno+1
locate 12,10:print stno;" Stations Converted"
print #3,ma1$
return

hyd:
hyst=37

for ii=1 to cyc
hy1$=hy$
mid$(hy1$,1)=left$(ma1$,27)
par$=mid$(b$,hyst,4)
gosub dp
if sel=1 then
par$=mid$(b$,hyst+4,5)

dc=val(mid$(b$,hyst+9,1))
dc=3 'fields are left justified!
gosub dt
else
par$=mid$(b$,hyst+4,4)
dc=2
gosub dt
end if

if sel=1 then
par$=mid$(b$,hyst+10,5)
dc=val(mid$(b$,hyst+15,1))
dc=3 'fields are left justified!
gosub ds
end if

if mid$(hy1$,32,9)<>string$(9,32) then
print #3,hy1$
end if

if sel=1 then hyst=hyst+16
if sel=2 then hyst=hyst+8
next ii

dat: 'set up data records

dp:
dc=0
no=1:gosub conv
mid$(hy1$,28)=par$:'pressure
return

dt:
if sel=1 then chk$="-9999" else chk$="-999"
if par$<> chk$ then

no=2:gosub conv
mid$(hy1$,32)=par$:'temperature
end if
return

ds:
if par$<>"-9999" then
dc=3
no=3:gosub conv
mid$(hy1$,36)=pars$
end if
return

conv: ' convert to ICES format
' no is parameter no as in ICES record (1-13)
' par$ is value (no decimals)
' dc is no of decimal plaes

par1$=par$

if no>4 then
wid =chln(no) 'width of parameter
dec=chdc(no)
else
wid=o3ln(no)
dec=o3dc(no)
end if
gosub ICES

if no=3 then
 pars$=par$ '- 03 record s
 par$=par1$

 wid=chln(no)
 dec=chdc(no)
 gosub ICES
  no=0
end if

return

ICES: 'subroutine to transfer data to ICES structutre

if dc=4 then lthan=1:dc=2 '< overpunch
if dc=5 then gthan=1:dc=2 '> overpunvch

par=val(par$)
par=par*10^(dec-dc)
if par<0 and no=2 then neg=1 else neg=0
par = clng(par)
par$=str$(par)
par$=right$(par$,len(par$)-1)

if len(par$)>wid then 'needs an overpunch?
   if left$(par$,1)<>"1" then
     par$="R"+string$(wid-1,"9")
     else
     par$=right$(par$,len(par$)-1)
     opu1=val(mid$(par$,1,1))
     mid$(par$,1)=opu$(opu1)
   end if
end if
while len(par$)<wid
par$="0"+par$
wend
if neg=1 then mid$(par$,1)="}"
if dc<dec then
wid=wid-(dec-dc)
par$=left$(par$,wid)
end if

if gthan=1 then par$="R"+string$(wid-1,"9")
if lthan=1 then
opu1=val(right$(par$,1))
mid$(par$,wid)=opu$(opu1)
end if

neg=0:lthan=0:gthan=0

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 par$=string$(wid,"?")
return

handle:

if err=53 then
print
print"   Input File not found .... run aborted":end
end if
print "Problem encountered (";err;") .. run aborted"
end
