 rem to convert from fixed blueprint to ICES **BLUICE-KAI**
 REM allows for numeric set code only as codes are put into an array.
 REM allows for redefintion of set code before any station
 dim set$(900),PAR$(30,100),ICARD1$(600),FLY$(30),MUN(30),GF3$(100)
 dim MUNZ(100)
key off
ON ERROR GOTO err1
 DATA DEPH7XX,28,TEMP7RT,32,PSAL7BS,36
 DATA "DOXY7TI",40,"PHOS7XX",43,"PTOT7XX",46
 DATA "SLCA7XX",49,"NTRA7XX",52,"NTRI7XX",55
 DATA "NTRZ7XX",52,"AMON7XX",58,"AMON2XX",58,"NTOT2XX",61
 DATA "HSUL7XX",64,"PHPH7XX",67,"ALKY7XX",70,"CPHL2XX",74
 DATA "PSAL7RD",36,"TEMP7ST",32
 DATA "SLCA7AA",49,"PHOS7AA",43
 DATA "NTRI7AA",55,"NTRZ7AA",52,"PTOT7AA",46
 DATA "DO0Y7TI",40
 DATA "CHLS7XX",37,"CHLR7XX",38
cls
locate,5:PRINT "Conversion from Blueprint '86 to ICES Hydrochemistry Format"
 NODATA=27
 HY$="                                                                              03"
 CH$="                                                                              76"
 TART=0
 HY1$=HY$:ch1$=CH$
 JNUM1=1
 FOR I = 1 TO NODATA
 READ FLY$(I),MUN(I)
 PRINT FLY$(I),MUN(I);
 NEXT I

print:
PRINT "enter input file"
 INPUT IN$
psrt=instr(in$,":")

if psrt<>0 then
otfil$=RIGHT$(in$,len(in$)-psrt)

  else
  otfil$=in$
end if

psrt=instr(otfil$,".")

if psrt <>0 then otfil$=left$(otfil$,psrt-1)
otfil$=otfil$+".ICE"

open in$ for input as #1

 open "O",#2,OTFIL$
in:
if eof(1)<>0 then endrd
 LINE INPUT #1,ICARD$

 if mid$(icard$,79,2)="10" then nt
 if mid$(icard$,79,2)="0J" AND TART=0 then ok
 if mid$(icard$,79,2)="01" AND TART=0 then ok
 if mid$(icard$,79,2)="0J" or mid$(icard$,79,2)="01" THEN
 O2=0:
STCNT=STCNT+1:PRINT STCNT;:GOTO o2

end if
 if mid$(icard$,79,2)="02" AND TART=0 then par
 if mid$(icard$,79,2)="02" THEN O2=O2+1:GOTO o2

 print:PRINT "Wrong record type - ";Icard$:print:goto in
ok:
 MAS1$=mid$(ICARD$,1,27):TART=1
 SAM$=mid$(ICARD$,1,80):GOTO in
nt:
 INOM$=mid$(ICARD$,5,4)
 IN=IN+1:ICARD1$(IN)=mid$(ICARD$,11,66):goto in
100 rem
o2:

 IF O2<=1 THEN PRINT #2,SAM$
 jco=1

FOR J=1 TO IN
 for i = 1 to 77 step 11
 tes$=mid$(icard1$(J),i,11)
 if tes$="" or left$(tes$,2)="  " then nxt1
 IF TES$="99999999999" OR TES$="00000000000" THEN nxt1
 set$(jco)=tes$
 jco=jco+1

nxt1:

 next i
 NEXT J
 IN=0:LPAR=0:JPAR=1:PAR$(1,1)="":LPMAX=0
 for i = 1 to jco-1
 tu=val(left$(SET$(i),2))
 if TU=TURN then lpar=lpar+1:JPAR=1
 par$(jpar,lpar)=set$(i)
 jpar=jpar+1
 next i

 FOR I=1 TO LPAR
 FOR J= 1 TO NODATA

 CAT$=left$(PAR$(J,I),2)
 IF CAT$="  "THEN nxt2
 ic=val(CAT$)
 IQ$=mid$(PAR$(J,I),3,2)
 IF left$(IQ$,1)="M" or mid$(IQ$,2,1)="M" THEN nxt2
 IF IC=0 OR IC=99 THEN nxt2
 IF GF3$(IC)="" THEN unid ELSE id

unid:
print:PRINT "Unidentified set code ";IC:GOTO nxt2

id:
 dat1= val(mid$(PAR$(J,I),5,6))
 de1= val("1E"+mid$(PAR$(J,I),11,1))
 IQ$=mid$(PAR$(J,I),3,4)
 DAT2=DAT1/DE1
 MUNN=MUNZ(IC)

 IF MUNN=28 THEN
   mid$(HY1$,1)=mas1$
   mid$(CH1$,1)=mas1$
   GOSUB dep
 end if

 IF MUNN=32 THEN dec2=100:GOSUB temp
 IF MUNN=36 or MUNN=37 OR MUNN=38 THEN GOSUB sal
 IF MUNN=40 THEN:DEC2=100:GOSUB nuts
 IF MUNN=43 OR MUNN=46 THEN CHGO=1:DEC2=100:GOSUB nuts
 IF MUNN=55 OR MUNN=67 THEN CHGO=1:DEC2=100:GOSUB nuts
 IF MUNN=49 OR MUNN=52 OR MUNN=58 THEN CHGO=1:DEC2=10:GOSUB nuts
 IF MUNN=61 OR MUNN=64 OR MUNN=74 THEN CHGO=1:DEC2=10:GOSUB nuts
 IF MUNN=70 THEN CHGO=1:GOSUB sal
nxt2:
 next j

if mid$(hy1$,32,40)<>string$(40,32) then
 PRINT #2,HY1$
end if

HY1$=HY$

 IF CHGO=1 THEN 
CHGO=0:PRINT #2,CH1$
if instr(ch1$,"R9")<>0 or instr(ch1$,"R99")<>0 then
R99=R99+1
end if

end if
 CH1$=CH$
 next i
 IF EN$="END" THEN clse
 HY1$=HY$:CH1$=CH$
 SAM$=left$(ICARD$,80):MAS1$=left$(ICARD$,27)
 for i= 1 to JCO
 set$(i)=""
next i

FOR I = 1 TO LPAR
 FOR J = 1 TO NODATA
 PAR$(J,I)=""
 NEXT J
 NEXT I
 IF O2<>0 THEN par
 GOTO in

endrd:
EN$="END":GOTO o2

par:

 REM TO READ IN FROM PARAMETER CARDS AND CHECK CODES
 FOR IP = 12 TO 80 STEP 9
 CC$=mid$(ICARD$,IP,2):DD$=mid$(ICARD$,IP-7,7)
 IF CC$="" OR  CC$="  " OR CC$="00" THEN parnt
 IF DD$="" OR  DD$="       " OR DD$="0000000" THEN parnt
 sat=val(CC$)
 GF3$(SAT)=DD$
 FOR II = 1 TO NODATA

 IF GF3$(SAT)=FLY$(II) THEN
   MUNZ(SAT)=MUN(II)
   PRINT SAT,MUNZ(SAT),GF3$(SAT)
   GOTO turn
 end if

 NEXT II
 MUNZ(SAT)=0
PRINT SAT,MUNZ(SAT),GF3$(SAT);" NOT ACCOUNTED FOR -- **WARNING**"

turn:
IF MUNZ(SAT)=28 THEN TURN=SAT
parnt:
 NEXT IP
 TART=0
 GOTO in
dep:

' DEPTH
wide=4
dat2=clng(dat2)
expo$=str$(dat2):gosub extend
GOSUB zeros

 GOSUB hy1:GOSUB ch1:RETURN


temp:
REM TEMPERATURE

 DAT2=DAT2*dec2:wide=4
 IF DAT2<0 THEN NEG=1:DAT2=-DAT2
dat2=clng(dat2)
 expo$=str$(dat2):gosub extend

 GOSUB zeros
 IF NEG=1 THEN NEG=0:mid$(EXPO$,1)="}"
 IF DE1>=100 THEN WID=4
 IF DE1=10 THEN WID=3
 IF DE1=1 THEN WID=2
 EXPO$=left$(EXPO$,wid)

 GOSUB hy1:GOSUB ch1

 RETURN

sal:
REM SALINITY/ALKALINITY/CHLORINITY/CHLOROSITY
DAT2=DAT2*1000:wide=5
if munn=70 then wide=4
IF DE1>=1000 THEN WID=5
IF DE1=100 THEN WID=4
IF DE1=10 THEN WID=3
IF DE1=1 THEN WID=2
IF MUNN=70 THEN wid=wid-1:goto out1

IF MUNN=36 THEN out1
IF MUNN=37 THEN chls ELSE chlr

chls:
 DAT2=DAT2/DE1:DAT2=DAT2*(1-DAT2/825)
 DAT2=DAT2/.5535:DAT2=DAT2*DE1
 GOTO fin
chlr:
 DAT2=DAT2/DE1:DAT2=DAT2*1.80655:DAT2=DAT2*DE1
fin:
 MUNN=36
out1:

dat2=clng(dat2)
EXPO$=str$(DAT2):gosub extend

 GOSUB zeros
 EXPO$=left$(EXPO$,WID)

if munn=70 then sal1
 GOSUB hy1
 DAT3=DAT2+5
dat3=clng(dat3)
expo$=right$(str$(dat3),5)
IF WID=5 THEN WID=4

sal1:
 GOSUB zeros
EXPO$=left$(EXPO$,wid)
GOSUB ch1

RETURN
1000 rem
nuts:
 REM OXYGEN,NUTRIENTS,PH,CHLOROPHYLL
wide=3
IF left$(IQ$,1)=">" OR mid$(IQ$,2,1)=">" THEN EXPO$="R99":GOTO nut2
IF DAT2<0 THEN EXPO$="00}":GOTO nut2
DAT2=DAT2*DEC2

IF DE1=100 THEN WID=3
IF DE1=10 THEN WID=2
IF DE1=1 THEN WID=1
IF DEC2=10 THEN WID=WID+1
IF DAT2>=1000 THEN HI=1:DAT2=DAT2-1000
if dat2>=1000 then hi=0:expo$="R99999":goto nut3
IF left$(IQ$,1)="<" OR mid$(IQ$,2,1)="<" THEN LO=1

dat2=clng(dat2)

EXPO$=str$(dat2)
gosub extend:GOSUB zeros


IF HI=1 THEN GOSUB high:GOTO nut3
IF LO=1 THEN GOSUB low ELSE nut3
nut3:

EXPO$=left$(EXPO$,WID)
nut2:

GOSUB ch1
 IF MUNN=40 THEN MUNN=58:GOSUB hy1:MUNN=40
 RETURN

zeros:
REM TO REPLACE LEADING SPACES WITH 0s
FOR IA = 1 TO LEN(EXPO$)
 IF " "= mid$(EXPO$,IA,1) THEN mid$(EXPO$,IA)="0" ELSE exit for
 NEXT IA
ia:
 RETURN
hy1:
 mid$(HY1$,MUNN)=expo$:RETURN
ch1:

mid$(CH1$,MUNN)=expo$:RETURN

high:
 REM HIGH OVERPUNCH (11)
 HI=0:OP=ASC(left$(EXPO$,1))
IF OP=48 THEN mid$(EXPO$,1)="}":RETURN
 OP=OP+25:mid$(EXPO$,1)=CHR$(OP)
 RETURN
low:
 LO=0:OP=ASC(mid$(EXPO$,LEN(EXPO$),1))
 IF OP=48 THEN mid$(EXPO$,len(expo$))="{":RETURN
 OP=OP+16:mid$(EXPO$,len(expo$))=CHR$(OP)
RETURN

extend:
while len(expo$)>wide
expo$=right$(expo$,wide)
wend

while len(expo$)<wide
 expo$=" "+expo$
wend
return

err1:
print "error ";err;" line ";erl
print "jpar ";jpar;" lpar ";lpar;" jco";jco;" in ";in
clse:
 CLOSE #2:

 CLOSE #1:
if r99<>0 then
print
print "***Warning**** there are ";r99;" chemistry records with"
print "values exceeding the maximum"
end if

 END
