key off
FIE=1:msq=1
REM TO Summarise hydro data files - 2nd level **STASUM***
on error goto handle
gap$=command$
30 DIM SUP$(20),PAR(14),RAP(14),ros$(14),JUL(12),msq$(50),mnt$(12)
40 FOR I = 1 TO 14
50 READ ROS$(I)
60 NEXT I
70 DATA "H09/H10 (T)","H09/H10 (S)","H21","H22","H23","H26","H24","H25","H76"
80 DATA "H75","H33 (H2S)","H28","H27","B02"
90 FOR I = 0 TO 11
100 READ JUL(I)
110 NEXT I
120 DATA 0,31,59,90,120,151,181,212,243,273,304,334
cls
for i = 1 to 12
read mnt$(i)
next i
data "Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"
locate 1,5:print "                  ******STASUM********
locate ,5:print "        (level 2 inventory of ICES data files)"
locate 5,5
if gap$="?" then gosub inf
print
190 PRINT "ICES File name";:INPUT B$
if gap$="" then gap=7 else gap=val(gap$)
210 OPEN "I",#1,B$
230 C$ = "STASUM.OUT"
open "O",#2,c$
if gap>0 then
RS$="ROS-STA.OUT"
670 OPEN "O",#3,RS$
inf$="ROSDA.INF"
open "O",#4,inf$
print #3,"    Data file ROSCOP summary - produced (US date) ";date$
print #3,
end if
240 rem FR$="<##### <#### <######## <######## <##### <######## <#### <#### -## -## <#############"
fr$="& & & & & & & & ### ### &"
250 PRINT "Description - for output display ";
INPUT SHIP$
input "enter <wp> for A4 output";wp$
if ucase$(wp$)="WP" then lp=71 else lp=42
cls
locate 10,25:print "Summarizing file ";b$
270 PRINT #2," Hydro/chemistry inventory for ";SHIP$
print #2, "  Produced (US date) ";date$
350 FI=0:A1$="    ":A2$="     ":A3$="   ":PL$="--------------"
recno=0
360 while not eof(1)

430 LINe inPUT #1,A$
recno=recno+1
440 B$=right$(A$,1%):COSR$=left$(A$,4):DITT$=mid$(A$,20,6)
jmg$=mid$(a$,32,1):ship$=mid$(a$,3,2)
450 IF B$="J" OR B$="1" THEN 550
460 IF FI=0 and b$<>"2" THEN PRINT "BAD START": end
470 IF B$="3" THEN O3=O3+1:DEP$=mid$(A$,28%,4%):GOSUB 810:goto 360
480 IF B$="6" THEN CH=CH+1:DEP$=mid$(A$,28%,4%):GOSUB 850:goto 360
if b$="2" then 550
surf:
if b$="2" then o3=o3+1:dep$=mid$(a$,28,4):gosub 810:goto 360
490 JI=JI+1
500 SUP$(JI)=right$(A$,2%)
510 IF JI=1 THEN 360
520 FOR I = 1 TO JI-1
530 IF SUP$(JI)=SUP$(JI-I) THEN JI=JI-1:goto 360
540 NEXT I
550 IF FI=0 THEN
DITF$=DITT$:FI=1:recn1=1
jmgf$=jmg$
shipf$=ship$
GOSUB 1270:GOSUB 700
gosub msq
if b$="2" then surf
goto 360

end if

560 GOSUB 1100:GOSUB 1020:GOSUB 700:gosub msq
if b$="2" then surf
570 goto 360

700 IF mid$(A$,18%,1%)="0" THEN N$="N":E$="E":goto 750
710 IF mid$(A$,18%,1%)="1" THEN N$="N":E$="W":goto 750
720 IF mid$(A$,18%,1%)="2" THEN N$="S":E$="E":goto 750
730 IF mid$(A$,18%,1%)="3" THEN N$="S":E$="W":goto 750
740 N$=" ":E$=" "
750 NO$=mid$(A$,5%,4%)+" ":LAT$=mid$(A$,9%,4%)+"."+mid$(A$,65%,2%)+N$+" "
760 LONG$=mid$(A$,14%,4%)+"."+mid$(A$,67%,2%)+E$+" ":COSH$=left$(A$,4%)
770 TME$=mid$(A$,26%,2%)+":"+mid$(A$,69%,2%)+" "
780 NME$=left$(A$,4%)+" ":SOUN$=mid$(A$,28%,4%)
790 DTE$=mid$(A$,24%,2%)+"/"+mid$(A$,22%,2%)+"/"+mid$(A$,20%,2%)+" "
800 RETURN
810 IF mid$(A$,32%,4%)<>A1$ THEN mid$(PL$,1)="x":IA=1:GOSUB 1000
820 IF mid$(A$,36%,5%)<>A2$ THEN mid$(PL$,2)="x":IA=2:GOSUB 1000
830 IF mid$(A$,58%,3%)<>A3$ THEN mid$(PL$,3)="x":IA=3:GOSUB 1000
840 RETURN
850 IF mid$(A$,32%,4%)<>A1$ THEN mid$(PL$,1)="x":IA=1:gosub 1000
860 IF mid$(A$,36%,4%)<>A1$ THEN mid$(PL$,2)="x":IA=2:GOSUB 1000
870 IF mid$(A$,40%,3%)<>A3$ THEN mid$(PL$,3)="x":IA=3:GOSUB 1000
880 IF mid$(A$,43%,3%)<>A3$ THEN mid$(PL$,4)="x":IA=4:GOSUB 1000
890 IF mid$(A$,46%,3%)<>A3$ THEN mid$(PL$,5)="x":IA=5:GOSUB 1000
900 IF mid$(A$,49%,3%)<>A3$ THEN mid$(PL$,6)="x":IA=6:GOSUB 1000
910 IF mid$(A$,52%,3%)<>A3$ THEN mid$(PL$,7)="x":IA=7:GOSUB 1000
920 IF mid$(A$,55%,3%)<>A3$ THEN mid$(PL$,8)="x":IA=8:GOSUB 1000
930 IF mid$(A$,58%,3%)<>A3$ THEN mid$(PL$,9)="x":IA=9:GOSUB 1000
940 IF mid$(A$,61%,3%)<>A3$ THEN mid$(PL$,10)="x":IA=10:GOSUB 1000
950 IF mid$(A$,64%,3%)<>A3$ THEN mid$(PL$,11)="x":IA=11:GOSUB 1000
960 IF mid$(A$,67%,3%)<>A3$ THEN mid$(PL$,12)="x":IA=12:GOSUB 1000
970 IF mid$(A$,70%,4%)<>A1$ THEN mid$(PL$,13)="x":IA=13:GOSUB 1000
980 IF mid$(A$,74%,3%)<>A3$ THEN mid$(PL$,14)="x":IA=14:GOSUB 1000
990 RETURN
1000 IF RAP(IA) =1  THEN RETURN
1010 PAR(IA)=PAR(IA)+1:RAP(IA)=1:RETURN
1020 PRINT #2, USING FR$;NME$,NO$,LAT$,LONG$,TME$,DTE$,SOUN$,DEP$,O3,CH,PL$;
print #2,using "######";recn1
recn1=recno
locate 25,25
incr nstat:print nstat tab(37) " stations processed";
1040 rem NOC=NOC+1:NOS=NOS+1:IF NOC=10 THEN PRINT NOS;:NOC=0
1050 PAL=PAL+1:IF PAL=LP THEN PAL=0:PRINT #2,chr$(12):GOSUB 1370
1060 IF PAL=0 AND LP=71 THEN LP=75
if pal=0 and lp=42 then lp=45
1070 O3=0:CH=0:PL$="--------------"
1080 RETURN
1100 if gap=0 then return
yr1=val(mid$(DITL$,1,2))
1110 yr2=val(mid$(DITT$,1,2))
1120 mn1=val(mid$(DITL$,3,2))
1130 mn2=val(mid$(DITT$,3,2))
1140 dy1=val(mid$(DITL$,5,2))
1150 dy2=val(mid$(DITT$,5,2))
1151 JL1=DY1+JUL(MN1-1)
1152 JL2=DY2+JUL(MN2-1)+(YR2-YR1)*365
1153 JL=JL2-JL1-GAP
1160 IF COSR$=COSL$ AND JL<0 THEN 1161 ELSE 1170
1161 DITL$=DITT$:goto 1250
'remove if statemnets if JMG cruises need summarised
1170 if shipf$="  " then
jmgf$=jmg$
shipf$=ship$
COSL$=COSR$:DITL$=DITT$:DITF$=DITT$
erase msq$
msq=1
goto 1240
end if

PRINT #3,"Ship: ";COSL$;": Period from ";ditf$;" to ";ditl$
if jmgf$="J" then print #3,"                 (JMG Cruise)"
print #3,
jmgf$=jmg$
shipf$=ship$
ros3$="MSQ":div$=""
print #3,"Marsden squares:"
i=1:jsk=1
while i<50
if msq$(i)="" then exit loop
if jsk=1 then
print #3,left$(msq$(i),5);"  ";len(msq$(i))-5;" stations";
jsk=0
else
jsk=1
print #3,tab(40) left$(msq$(i),5);"  ";len(msq$(i))-5;" stations"
end if

ros3$=ros3$+"^"+left$(msq$(i),5)
div$=div$+"^"+str$(len(msq$(i))-5)

i=i+1
wend
'roscop forma first three lines
print #3,
cun$=left$(cosl$,2)
yr1$=right$(str$(yr1),2)
print #4,yr1$;"^";cun$;"^DA"
select case cun$
case "74"
print #4,"UK"
case "26"
print #4,"Denmark"
case "06"
print #4,"Germany"
case "58"
print #4,"Norway"
case "77"
print #4,"Sweden"
case "90"
print #4, "USSR"
case "67"
print #4, "Poland"
case "96"
print #4, "E Germany"
case else
print #4,cun$
end select
print #4,ros3$
print #4,"ng" 'operating agency'

if mn1>0 and mn2>0 and mn1<13 and mn2<13 then ' dates
dy1$=right$(ditf$,2):dy2$=right$(ditl$,2)
mn1=val(mid$(ditf$,3,2)):mn2=val(mid$(ditl$,3,2))
print #4,dy1$;"^";mnt$(mn1);"^";dy2$;"^";mnt$(mn2)
else
print #4,"ng"
end if
print #4,"Station division by msq - ";div$
print #4,right$(cosl$,2);" - ship code"
print #4,"ng"
print #4,"ICES"
print #4,"ICES"
erase msq$
msq=1
1180 COSL$=COSR$:DITL$=DITT$:DITF$=DITT$
print #3,
print #3,"Roscop Parameters"
jsk=1
1190 FOR I = 1 TO 14
1200 IF PAR(I)=0 THEN 1220
if jsk=1 then
PRINT #3, ROS$(I) tab(15) PAR(I);
jsk=0
else
print #3, tab(40) ros$(i) tab(55) par(i)
jsk=1
end if
par$=str$(par(i))
par$=right$(par$,len(par$)-1)
print #4,ros$(i);"^";par$;"^a^a^ng^";par$;" stations at ICES"
1220 NEXT I
print #4,"*"
1230 PRINT #3,:
print #3,string$(80,"-")
1240 erase PAR
1250 erase RAP
1260 RETURN
1270 COSL$=COSR$:DITL$=DITT$
PRINT #2,"KEY TO TABLE:":PAL=4
1280 REM PRINT "a:Ship/b:station no/c:latitude/d:longitude/e:time/f:date"
1290 REM PRINT "g:Secchi depth/h:max depth/i:hydrography and/j:chemistry records"
1300 REM PRINT "Observations:- k:temperature/l:salinity/m:oxygen/n:phosphate/o:TP"
1310 REM PRINT "p:silicate/q:nitrate/r:nitrite/s:TN/t:pH/u:Alk/v:chlorophyll/w:P Prod"
1320 PRINT #2,"a:Country-ship/b:station no/c:latitude/d:longitude/e:time/f:date"
1330 PRINT #2,"g:Sounding/h:max depth/i:hydrography and/j:chemistry records"
1340 PRINT #2,"Observations:- k:temperature/l:salinity/m:oxygen/n:phosphate/o:TP"
1350 PRINT #2,"p:silicate/q:nitrate/r:nitrite/s:Ammonium/t;TN/u;H2S;v:pH/w:Alk/x:chlorophyll"
1360 PRINT #2,
1370 PRINT #2,"  a     b       c         d       e       f       g    h     i   j klmnopqrstuvwx"
1380 REM PRINT"  a     b       c         d       e       f       g    h     i   j klmnopqrstuvwx"

1400 RETURN
wend
if gap>0 then GOSUB 1170
GOSUB 1020
1420 IF JI=0 THEN 1470
1430 PRINT #2, "record types ignored are:-"
1440 FOR I= 1 TO JI
1450 PRINT #2, SUP$(I)
1460 NEXT I
1470 rem


print
print "Output is stored in files STASUM.OUT"
if gap>0 then print "ROSCOP summaries are stored in ROS-STA.OUT and ROSDA.INF"
1500 end

msq:
if gap=0 then return
lat=val(mid$(a$,9,2))+val(mid$(a$,11,2))/60
lon=val(mid$(a$,13,3))+val(mid$(a$,16,2))/60
if mid$(a$,18,1)="1" or mid$(a$,18,1)="3" then lon=-lon
if mid$(a$,18,1)="2" then lat=-lat

lon=-lon
if lon<0 and fix(lon)=lon then lon=lon-.00001
if lat=-999 then end
la=int (lat/10):lo=int(lon/10)

if lo<0 then lo=36+lo
msst=1
if la>7 then msst=613

if la<0 then la=la+1:la=-la:msst=300

marsq=la*36+lo+msst
lat=abs(lat)
frlat=(lat/10-int(lat/10))*10
lon=abs(lon)
frlon=(lon/10-int(lon/10))*10

if frlat<5 and frlon<5 then marsq=marsq*10+1
if frlat<5 and frlon>=5 then marsq=marsq*10+2
if frlat>=5 and frlon<5 then marsq=marsq*10+3
if frlat>=5 and frlon>=5 then marsq=marsq*10+4

 mr$=right$(str$(marsq/10),len(str$(marsq/10))-1)
if len(mr$) = 3 then mr$="0"+mr$
if len(mr$) = 4 then mr$="0"+mr$
mid$(mr$,4)=";"
i=1
while i<50
if left$(msq$(i),5)=mr$ then
msq$(i)=msq$(i)+" "
exit loop
end if
if msq$(i)="" then
msq$(i)="     "
mid$(msq$(i),1)=mr$
msq$(i)=msq$(i)+" "
exit loop
end if
i=i+1
wend
msq=i
return

inf:
cls
print "                     ****STASUM*****                 Info/help"
print
print "   Stasum produces a summary of observations at each station from an"
print "   ICES formatted file. Additionally it produces, depending on command"
print "   line options described below, 2 files useful for interfacing the"
print "   cruises to ROSCOP (in files ros-sta.out, and rosda.inf)"
print
print "Command line options:
print
print "1.  No command - assumes gap of 7 days between cruises"
print "2.  Command as a number (eg 5) - Takes gap as given by number"
print "3.  Command is 0 - This suppresses production of ROSCOP type files"
print
print "To procede, chose one of above choices (<10 days), press <q> to quit"
gap$=input$(1)
if ucase$(gap$)="Q" then end
if gap$ <"0" or gap$ >"9" then gap$=""
return

handle:
cls
if err=53 then
cls
locate 10,5:print "File ";b$;" is not available - run aborted "
end
end if
print "Error ";err;" line no ";erl
end
