key off
on error goto handle
f$=command$
if f$<>"" then jmpe
cls
locate 1,1,0
PRINT "                   ***** ICES to NODC Format Conversion *****"
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:
print spc(30);"*"
print:
color 23,0:print spc(25);"*";:color 7,0
print 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 "                   I-net    - ocean@server.ices.inst.dk"
print

locate 25,1
color 0,7
print " F5 - Information";tab (69) "<esc> - Quit";
color 7,0

while not instat
wend
in$=inkey$
if len (in$)=2 and asc(right$(in$,1))=63 then gosub info
if asc(in$)=27 then cls:end
jmpe:
cls
print "                      ********ICES-NODC********"
print
print "                  Converts ICES format to NODC format"

dim o3st(4),o3ln(4),o3dc(4)
dim chst(15),chln(15),chdc(15)
dim opu$(0:9),opv$(0:9)

mas1$="0   5                                  9                                      21"
mas2$="                                                                               2"
dat$= "            9      9     9     9    9               9    9    9   9   9        3"
sup$= "                                                                             SUP"

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

if instr(b$,".")<>0 then
cout$=left$(b$,instr(b$,".")-1)
else
cout$=b$
end if
cout1$=cout$+".nod"
open "O",#2,cout1$
fer$=cout$+".sup"
open "o",#3,fer$

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

data "}","J","K","L","M","N","O","P","Q","R"
for i = 0 to 9
read opu$(i)
next i
data "{","A","B","C","D","E","F","G","H","I"
for i = 0 to 9
read opv$(i)
next i

line input #1,a$
while not eof(1)
line input #1,b$
rec$=mid$(a$,79,2)
gosub sel
a$=b$
wend
last=1
a$=b$
rec$=mid$(a$,79,2)
gosub sel
locate 20,10
print "NODC formatted data are stored in file..... ";cout1$
locate 21,10
print "Any ICES data not in NODC format is in file ";fer$
end

sel:
select case rec$
case="0J"
recno=0:stn=stn+1
locate 10,20:print stn;"  Stations Converted"
nop=1:'dpt$=""
sup=0
gosub mas
case="03"
gosub sethydr
gosub hydr
case "76","56"
pol=0
gosub chem
case="P6"
pol=1
gosub chem
case else
print #3,"illegal record type"
print #3,a$
ill=ill+1
if ill=10 then
print "Run aborted - not properly structured ICES data file"
end
end if
end select
return

mas:
mas$=mas1$
mid$(mas$,3)=mid$(a$,1,2)
mid$(mas$,50)=mid$(a$,3,2)
if mid$(a$,32,4)="NODC" then
mid$(mas$,6)=mid$(a$,36,4)
end if
mid$(mas$,10)=mid$(a$,5,4)
mid$(mas$,41)=mid$(a$,20,8)
par$=mid$(a$,69,1)
if par$<>" " then
fr=cint(val(par$)/.6)
fr$=right$(str$(fr),1)
mid$(mas$,49)=fr$
end if
qu$=mid$(a$,18,1)
if qu$="0" then mid$(mas$,27)="N":mid$(mas$,33)="E"
if qu$="1" then mid$(mas$,27)="N":mid$(mas$,33)="W"
if qu$="2" then mid$(mas$,27)="S":mid$(mas$,33)="E"
if qu$="3" then mid$(mas$,27)="S":mid$(mas$,33)="W"
mid$(mas$,28)=mid$(a$,9,4)
mid$(mas$,34)=mid$(a$,13,5)
mid$(mas$,32)=mid$(a$,65,1)
mid$(mas$,39)=mid$(a$,67,1)
mid$(mas$,56)="0"+mid$(a$,28,4)
'print mas$
RECNO=RECNO+1
print #2,mas$

masb$=mas2$
if mid$(b$,80,1)="3" or mid$(b$,80,1)="6" then
mid$(masb$,79)="3"
end if
if mid$(a$,32,9)=string$(9,32) then
mid$(masb$,18)=mid$(a$,5,4)
else
mid$(masb$,18)=mid$(a$,32,9)
end if
mid$(masb$,52)="9"
mid$(masb$,57)="9"
RECNO=RECNO+1
print #2,masb$ 'second master
return

sethydr:
dat1$=dat$
if mid$(b$,80,1)="J" then mid$(dat1$,79)="1"
if mid$(b$,80,1)="3" or mid$(b$,80,1)="6" then mid$(dat1$,79)="3"
return

hydr:

for ii = 1 to 4
par$=mid$(a$,o3st(ii),o3ln(ii))
if par$<>string$(o3ln(ii),32) then
gosub fill
select case ii

case=1 ' depth
dpt$=par$
ps=2
gosub to11 'test for overpunch 11
  if f11=1 then 'overpunch 11 identified
   f11=0
   'questionable depth
  end if

ps=4
gosub to11
  if f11=1 then 'overpunch identified
   f11=0
   mid$(dat1$,7)="T"
   ' unprotected thermometer
   end if
ps=1
gosub to11
 if f11=1 then
  f11=0
  par$="1"+par$
  else
  par$="0"+par$
  end if

mid$(dat1$,1)=par$

case =2 'temperature
dec=o3dc(2)
ps=1
gosub to11
neg$="0"
  if f11=1 then
   f11=0
   neg$="-"
   end if
ps=2
gosub to11
if f11=1 then
  f11=0
 'questionable value
end if
gosub short
nodc=5
gosub long
mid$(par$,1)=neg$
mid$(dat1$,8)=par$
mid$(dat1$,13)=right$(str$(dec),1)

case=3 'salinity
dec=o3dc(3)
ps=2
gosub to11
 if f11=1 then
  f11=0
  'questionable value
  end if
gosub short
nodc=5
gosub long
mid$(dat1$,15)=par$
mid$(dat1$,20)=right$(str$(dec),1)

case 4 'oxygen

dec=o3dc(4)

ps=2
gosub to11
 if f11=1 then
 f11=0
 'questionable value
 end if

ps=1
gosub to11
 if f11=1 then
  f11=0
  par$="1"+par$
  end if

gosub short
nodc=4
gosub long
mid$(dat1$,33)=par$
mid$(dat1$,37)=right$(str$(dec),1)
end select
end if
next ii


if mid$(b$,28,4)=dpt$ and mid$(b$,80,1)="6" and last=0 then
nop=5
rem no print yet
else
nop=1
RECNO=RECNO+1
IF RECNO=520 THEN
mid$(dat1$,79)="1"
end if
print #2,dat1$ ' print hydro record now if no chemistry follows

if recno=520 then
mid$(mas$,1)="2"
print #2,mas$
print #2,masb$
recno=2
end if
end if
return

chem:
if nop=1 then gosub sethydr

for ii = nop to 15
par$=mid$(a$,chst(ii),chln(ii))
if par$<>string$(chln(ii),32) then
gosub fill

select case ii

case=1 ' depth
dpt$=par$
ps=2
gosub to11 'test for overpunch 11
  if f11=1 then 'overpunch 11 identified
   f11=0
   'questionable depth
  end if

ps=4
gosub to11
  if f11=1 then 'overpunch identified
   f11=0
   mid$(dat1$,7)="T"
   ' unprotected thermometer
   end if
ps=1
gosub to11
 if f11=1 then
  f11=0
  par$="1"+par$
  else
  par$="0"+par$
  end if
mid$(dat1$,1)=par$

case =2 'temperature
dec=chdc(2)
ps=1
gosub to11
neg$="0"
  if f11=1 then
   f11=0
   neg$="-"
   end if
ps=2
gosub to11
if f11=1 then
  f11=0
 'questionable value
end if
gosub short
nodc=5
gosub long
mid$(par$,1)=neg$
mid$(dat1$,8)=par$
mid$(dat1$,13)=right$(str$(dec),1)

case=3 'salinity
dec=chdc(3)
ps=2
gosub to11
 if f11=1 then
  f11=0
  'questionable value
  end if
gosub short
nodc=5
gosub long
mid$(dat1$,15)=par$
mid$(dat1$,20)=right$(str$(dec),1)

case=4 'oxygen
dec=chdc(4)

ps=2
gosub to11
 if f11=1 then
 f11=0
 'questionable value
 end if

ps=1
gosub to11
 if f11=1 then
  f11=0
  par$="1"+par$
  end if

gosub short
nodc=4
gosub long
mid$(dat1$,33)=par$
mid$(dat1$,37)=right$(str$(dec),1)

case 5 'phosphate
nodc=4
dec=chdc(ii)-pol
gosub par
mid$(dat1$,49)=par$  'phosphate
mid$(dat1$,53)=right$(str$(dec),1)

case 6 'total phosphate
nodc=4
dec=chdc(ii)-pol
gosub par
 mid$(dat1$,54)=par$  'total phosphate
 mid$(dat1$,58)=right$(str$(dec),1)

case 7 'silicate
nodc=4
dec=chdc(ii)-pol
gosub par
 mid$(dat1$,59)=par$ 'silicate
 mid$(dat1$,63)=right$(str$(dec),1)

 case = 8 'nitrate
 nodc=3
 dec=chdc(ii)-pol
gosub par
 mid$(dat1$,68)=par$ 'nitrate
 mid$(dat1$,71)=right$(str$(dec),1)

 case=9 'nitrite
 nodc=3
dec=chdc(ii)-pol
gosub par
 mid$(dat1$,64)=par$ 'nitrite
 mid$(dat1$,67)=right$(str$(dec),1)

 case=10 ' ammonia
nodc=4
dec=chdc(ii)-pol
gosub par
gosub sup
mid$(sup1$,6)="AMON"+par$+right$(str$(dec),1)
sup1=1
 case=11 'total nitrogen
nodc=4
dec=chdc(ii)-pol
gosub par
gosub sup
mid$(sup1$,16)="NTOT"+par$+right$(str$(dec),1)
sup1=1
 case=12 'H2s
nodc=4
dec=chdc(ii)
gosub par
gosub sup
mid$(sup1$,26)="HSUL"+par$+right$(str$(dec),1)
sup1=1

 case=13 'pH
nodc=3
dec=chdc(ii)
gosub par
 mid$(dat1$,72)=par$
 mid$(dat1$,75)=right$(str$(dec),1)

 case=14 'alkalinity
nodc=4
 dec=chdc(ii)
gosub par
gosub sup
mid$(sup1$,36)="ALKY"+par$+right$(str$(dec),1)
sup1=1
 case=15
nodc=4
dec=chdc(ii)
gosub par
gosub sup
mid$(sup1$,46)="CPHL"+par$+right$(str$(dec),1)
sup1=1
  end select
end if
next ii

RECNO=RECNO+1
IF RECNO=520 THEN
mid$(dat1$,79)="1"
end if
print #2,dat1$ ' print hydro record now if no chemistry follows
if recno=520 then
mid$(mas$,1)="2"
print #2,mas$
print #2,masb$
recno=2
end if

if sup1=1 then
mid$(sup1$,1)=mid$(dat1$,1,5)
print #3,sup1$
sup1=0
sup1$=sup$
end if
nop=1
return


sup: 'check if supplemematy file
if sup=0 then
sup=1
print #3,mas$
sup1$=sup$
mid$(sup1$,1)=mid$(dat1$,1,5)
end if
return

par:
ps=2
gosub to11
 if f11=1 then
 f11=0
 'questionable value
 end if

ps=3
gosub to12
 if f12 then
  f12=0:dec=4 '(trace)
end if
ps=3
gosub to11
 if f11=1 then
 f11=0
 dec=4 '(trace - second definition)
end if

ps=1
gosub to11
 if f11=1 then
  f11=0
  par$="1"+par$
  end if

gosub short
gosub long

while len(par$)>nodc
dec=dec-1
if dec<0 then
dec=5
par$=string$(nodc,"9")
exit loop
exit if
end if
par$=left$(par$,len(par$)-1)
wend

return

opu1: 'identifying overpunch 11
for o11 = 0 to 9
if opu$(o11)=opu1$ then fu
next o11
fu:
return

to11: 'test for opunch 11
opu1$=mid$(par$,ps,1)
if asc(opu1$)>57 then
f11=1
gosub opu1
mid$(par$,ps)=right$(str$(o11),1)
end if
return

to12: 'test for opunch 12
opu1$=mid$(par$,ps,1)
if asc(opu1$)>57 then
f12=1
gosub opv1
if o12=10 then f12=0:exit if 'must be an opunch 11
mid$(par$,ps)=right$(str$(o12),1)
end if
return

opv1: 'identifying overpunch 12
for o12 = 0 to 9
if opv$(o12)=opv1$ then fv
next o12
fv:
return

fill: 'put in leading zeroes

IF par$ = STRING$(LEN(par$), " ") THEN RETURN
FOR ldz = 1 TO LEN(par$)
IF MID$(par$, ldz, 1) <> " " THEN EXIT FOR
MID$(par$, ldz) = "0"
NEXT ldz
RETURN

short: ' trim off trailing spaces
while right$(par$,1)=" "
par$=left$(par$,len(par$)-1)
dec=dec-1
wend
return

long:
while len(par$)<nodc
par$="0"+par$
wend
return
info:
cls
color 0,7
print"       Information about the NODC and ICES Oceanographic Station Formats       "
color 7,0
print"       Almost all Oceanographic Station data are presently held in either"
print"       the ICES or NODC formats - the current data sets go back to 1902,"
print"       the date of the establishment of the Standard Seawater Service"

print"       The formats were devised in the early 1960s.  At that time US needs"
print"       and ICES needs differed slightly, and as a result, although "
print"       structurally similar, the formats differ in both concept and"
print"       parameters.  The ICES format contains a number of chemical parameters"
print"       additional to those in the NODC format - whenever this utility"
print"       encounters such parameters, it stores them in a file (.sup extension)"
print"       These parameters are identified by the 4-digit GF3 code."
print
print"       It is intended that this utility be used in conjunction with the "
print"       sister utility <nodc-ice>, which, as its name suggests, converts data"
print"       files from NODC's format to ICES format.  This will allow the user"
print"       to take advantage of various PC-based oceanographic data display"
print"       products, eg ATLAST, and at the same take advantage of the wide"
print"       range of interactive data management software provided by ICES, but"
print"       which supports only the ICES format."
print
print"       Utilities available from ICES include data entry, data file integrity"
print"       checks (eg excessive ship speed warning), track chart, interactive "
print"       x/y plotting and data editing, irrespective of file size, extractions"
print"       of subsets (areas, sections, periods etc).  And many more!!";
locate 25,1
color 0,7:print string$(80,32);
locate 25,1
print "<Esc> - quit";
color 7,0
in$=input$(1)
return

handle:
print "You have encountered a problem (";err;").. run aborted"

end
