VTInotat
Nummer: T 31 Datum: 1988-03-25
Titel: Beskrivning och manual till program för bearbetning av trafikmätdata
Författare: Lars Elisson
Avdelning: T Projektnummer: 76004-1
Projektnamn: Mikrodatcrbaserad trafikanalysutrustning - 'TA-84 Uppdragsgivare: VTI
Distribution: fri / nyförvärv I blgränsad I
,,
_
Statens väg- och trafikinstitut
Vag-och
hah/(-' - Pa: 587 07 Linköping. Tel. 073- 77 52 00. Te/ex 50725 VT/SGI S t Besök: Olaus Magnus väg 37, Linköping
, _ -p -n . O O N -# P -P -P h . \ J1 \ J 1 \ 1 1 U 1 N O \ O \ O \ O \ O \ O \ O \ O \ k n -P W W W N H \ J \ l \ l \ l p. .. 10 10.1 10.2 10.3 0 , -10.4 INLEDNING Mätsystemet Program systemet BESKRIVNING AV MÄTDATA Datalagring Mätdatafil
ETIKETT OCH KONVERTERING
READ_B YTE
Syfte och funktion
Användarguide
Körexempel
CHECK_CASSETT Syfte och funktion
Användarguide
Körexempei TA84
Syfte och funktion Arbetssätt Utdata Beskrivning av FORDONSDATA Beskrivning av SNABBSTATISTIK Användarguide Körexempei SELECT_CODE
Syfte och funktion
Användarguide Körexempel STATISTIK TUAL , T PROGRAM KOD Read_Byte Check_Cassett TA84 Select_Code ON O O \ I \ I \ J 10 10 10 12 13 13 13 16 16 18 18 19 22 22 22 23 24 24 25 25 28 32 47
l.l Mätsystemet
Mätapparaturen 'PA-84 har två stycken givaringängar, avsedda för gummi-slang eller någon form av sensor som ger elektrisk signal. Ingångarna är. benämnda A och B. Varje gång en fordonsaxel passerar en givare skrivs tidpunkten för passagen och vilken givare (A eller B) som passagen gäller. Noggrannheten i tidangivelsen är 1 ms. Utskriften sker på ett
buffert-minne i apparaten. Efter 25 axelpassager skrivs innehållet i buffert-minnet på en kassettbandspelare, och apparaten är redo att registrera 25
st nya axelpassager.
Vid hemkomsten överförs de på bandkassetten lagrade data till en diskfil
på Viktor för vidare bearbetning. Denna överföring sker med hjälp av en Ericsson PC.
Vid den fortsatta datorbearbetningen finns ett program (TA-84, se av-snitt 6), som identifierar ett fordons samtligaaxelpassager och samlar
ihop dem. Därur beräknas sedan för varje fordon: * Ankomsttid,
* Riktning,
* Fordonskod,
* Punkthastighet, * Samtliga axelavstånd.
Fordonskoden bestäms utifrån antalet axlar hos fordonet och avståndet mellan varje axel.
Detta finns beskrivet i Notat T 17 "Axelavstând för olika fordonstyper.
Förslag till nytt system för fordonskoder".
Huvudprincipen för hela mätsystemet är således att alla händelser skall
lagras ute i fält i mätapparaturen, medan all datareduktion och beräkning sker på dator vid VTI.
För analys och utvärdering av mätdata finns ett programpaket kallat MENY upplagt på VTI's VAX-dator.
I MENY ingår följande program: Read_Byte, Check_Cassett, 'TA-84, Select-Code, Statistik och TUAL.
MENY startas med kommandot RUN<TA84.PROG>MENY.
Välj sedan det program som Du önskar exekvera, (se figur 1).
********MENy**- e*****
* 1 Till VMS
* 2 Etikett och konv. * 3 Read_Byte
* 4 Check_Cassett
* 5 TA84 * 6 Select_Code * 7 Statistik * 8 TUAL Välj alternativ:Figur 1. Skärmbild för programpaketet MENY.
Utdata från respektive program kan styras till terminal, radskrivare eller till valfri skivminnesfil.
Då utfil ska anges gäller generellt för samtliga program följande: * ge vagnretur för attlista utdata på skärmen,
* skriv VTI för utskrift på radskrivaren,
* ange ett filnamn för lagring på skivminnesfil.
I figur 2 finns en översiktsbild för hela programsystemet, där sambandet mellan olika programdelar framgår.
Kassett-band Ericsson PC i VTI VIKTOR 1 Etikett konver- <5""'° tera
Check
i
i1
' i cassett i iReadbytel / .\ N. -.\ 4.-, 'Iz' 'i' , /.' \' \ . .l
§'
'
i
i g ' J ? TA84SnabbstatistikAlpfø*øøl_iø,w_,MN Fordonsdata
<:::f§;f
...f/ \\'\ Se1ect TUAL code(
-_ _ . _ . . . . _ . . _ .<:ZIf5;///Z/,
,,/ //Yâg;::j\\\\\xx
Ir'ñM-*g
Figur 2. Översiktsbild för programsystemet för bearbetning av mät-data.
'2.1 Datalagring
Mätutrustningen är försedd med två givare, A och B. Vid mätning registreras tidpunkten då en axel passerar en givare samt vilken givare passagen gäller. Apparaten lagrar :för varje axelpassage fem bytes enligt
följande: Byte 1 Bit \I O \ U \ 0-3 4-7 Variabel TIM GIVARE GIVARE MIN SEK MSEK används ej MSEK
Värde ('Hexadecimal repr.)
3 > GIVARE B > GIVARE A 0-59 0-99 0-9
Obs-att i byte 1 kan inte bit 6 och 7 vara ettställda samtidigt.
Exempel: Byte Binärt 01010011 00110101 01011001 01110010 01100000 Hex 35 59 72 60 Värde TIM=13 :> GIVARE B :> MIN=35 => SEK=59 -_-.> MSEK=726
Nedan ses ett exempel på enmätdatafil där registreringar ligger lagrade
som en sekvens av bytes. Vänstra delen visar det hexadecimala värdet och
den högra motsvarande ASCII-tecken. Filen inleds i detta fallet med en
etikett vars längd alltid är 104 tecken (byte). Filen avslutas med ett antal
utfyllnadsbytes, OD, som apparaten lagt ut vid mätslut. Antalet OD kan variera från 0 till 255.
Mätdata kan även vara försedd med en s k fältetikett. Etiketten skapas då
mätningen initieras Och innehåller bl a uppgifter om givare och
mätutrust-ning. 51 68 80 OD CD CD OD OD OD 0D 0D 0D OD OD OD OD OD OD < --- --Hexadecimal 90 51 52 OD OD CD CD OD OD 0D 0D OD OD CD CD OD 0D OD 51 75 .10
on
00
OD
on
0D
09
.OD CD CD OD 0D OD. 0D OD OD 90 51 52 GB OD OD OD OD OD OD 0D OD OD OD OD OD 860625, 0937,8606 26 , 1052 ,NORSHOLM R2....01.:
.0.1I%á.11701113.IlIR. .2E. . .2E.0
IZE.PIZE p.2F.E.
2G.pIZG.PIZG.ê.2 aEPQQcê.QQQ..QQx PQQh.PQQu0.QR30 .QRf..QRh.PQRpEP QR . . . .. O O O O O O O O O O O O O O O. O O O O O O O O O O O O O O O. O O O O O O O O O O O 0 O 0 .O O O O O 0 O O O O O O O O O O O O O O O O O O O O O O O O O O. O O O O O O O 0 O O O O O 0 O. O O O O O O O O O O O O O 0 O. O O O O O O O O O O O O O O O. C C O O O O O O O O O O O O O. O O O O O O O O O O O O O O O. O O O O O O O C O O O O O O .O O O 0 O O O 0 O O O O O O O O. O O O O O O O O O O O O O O .OEfter överföring av mätdata till VAX-datorn bör filen förses med en etikett där uppgifter om mät- start/slut och mätplats registreras. Syftet med etiketten är att ge varje mätfil en unik identifikation och på så sätt eliminera risken för sammanblandning- av mätdata. Samtliga program "känner till" etiketten och läser automatiskt in den vid exekvering för att senare lagra den tillsammans med utdata.
Välj alternativ 2 i MENY för att förse mätdatafilen med en etikett.
Samtidigt med etiketteringen sker även en konvertering av filen. Konver-teringen innebär att de av VAXen skapade filattributen ändras och anpassas till utvärderingsprogrammens inläsningsrutin. Ändringen är nöd-vändig eftersom en fil med "felaktiga" attribut inte kan läsas av inläs-ningsrutinen. Mätdata påverkas inte av konverteringen.
4.1 Syfte och funktion
READ_BYTE är ett program för att lista registreringar. Programmet kan användas som ett hjälpmedel vid felsökning.
4. 2 Användarguide
Starta programmet genom att välja alternativ 3 i MENY. READ_BYTE - 851201
INFIL: Ange infil.
ETIKETT PÅ INFIL (CszA):
Bekräfta med vagnretur, annars N.
UTFIL (CRzTERM, VTI=VTIPRINTER): Ange utfil.
TIMl, TIMZ:
,Listning' av registreringar kan ske för max två timmar per mätperiod.
Skriv ex 11,25 för att lista endast en timme.
FRÅN,TILL (MINUT):
För TIMl och TIMZ kan listan begränsas genom att ange start- och
slutminut.
READ_BYTE 851201
INFIL: NORSHOLM_860625.BIN ETIKETT PÅ INFIL (CR=JA): 860625,0937,860626,1052, NORSHOLMRZ UTFIL (CR=TERM,VTI=VTIPRINTER): TIM1,TIM2: 9,10 FRÅN,TILL (MINUT):15,40 5. 9 17 12 10. 9 17 12 15. 9 31 49 20. 9 31 49 25. 9 31 49 30. 9 31 49 35. 9 32 45 40. 9 32 45 45. 9 32 45 50. 9 32 45 55. 9 32 46 . 60. 9 32 47 65. 9 32 47 70. 9 32 47 75. 9 32 51 80. 9 32 51 85. 9 32 51 90. 9 32 51 95. 9 33 28 100. 9 33 28 105. 9 33 28 110. 9 33 28 115. 9 33 31 120. 9 33 31 125. 9 33 31 130. 9 33 31 135. 9 33 41 140. 9 33 41 145. 9 _ 33 41 213242. 13 13 13 213243. 13 13 13 213244. 13 13 13 213245. 13 13 13 213246. 13 13 13 213247. 13 13 13 213248. 13 13 13 213249. 13 13 13 213250. 13 13 13 213251. 13 13 13 N H H N N H H N N H H N N H H N N H H N N H H N N H H N H it* *ir ** *k* ** *k* ** ** ai* *i*
Kolumn U 1 Löpnummer N
2-6 Byte N-4, N-3, N-Z, N-l, N
7 Givare
8 ** vid strukturfel
Bytes med strukturfel skrivs alltid ut även om de ligger utanför det begärda utskriftsintervallet.
5 CHECK_CASSETT
5. 1 Syfte och funktion
CHECK_CASSETT är ett program som används för att utföra
kvalitets-\ kontroll av mätdata. Utdata från programmet ger en indikation på hur mätningen förlöpt med avseende på mätutrustning och givare.
Uppgifter om t ex hastigheter eller flöden produceras ej. Följande utskrifter och kontroller görs:
- tid för första och sista axelpassage
- alla axelpassagetider jämförs med närmast föregående och eventuell
negativ tidlucka skrivs ut
- summa A och B pulser beräknas
- om fler än 5 A eller B pulser uppträder i en följd anges första och sista tidpunkten för detta. Även antalet pulser i sekvensen skrivs ut;
- strukturen för varje registrering måste vara korrekt vilket innebär att tidsangivelsen måste ligga inom givna gränser. Exp tim får ej vara
större än 23. (Se 2.1). Vidare måste det finnas indikering om A eller B
registrering.5. 2 Användarguide
Starta programmet genom att välja alternativ 4 i MENY.
CHECK_CASSETT - 851201
KONTROLL INFIL:
Ange namnet på den mätdatafil som ska bearbetas.
ETIKETT PÅ INFIL (CszA):
Bekräfta med ett vagnretur (CR:Carriage Return) eller skriv N om etikett saknas. Programmet listar ev etikett på skärmen;
UTFIL KONTROLLINFO (CRzTERM, VTI=VTIPRINTER): Ange utfil.
Programmet läser nu igenom filen och utför kvalitetskontrollen. Ev fältetikett skrivs ut tillsammans med utdata. Tidsangivelse för mätstart
och -slut skrivs alltid ut liksom totala antalet bytes i filen samt antal A
respektive B registreringar. Utdata kan även innehålla ytterligare infor-mation beroende på utfallet av kontrollen. Några exempel:
lO. A-PULSER I FÖLJD l6:lZ:O5:367-l6:12:21:531
där tidsangivelserna anger tidpunkt för den första resp sista A registrer-ingen i sekvensen. Tiden uttrycks i timmar, minuter sekunder och
milli-sekunden
NEGATIV TIDLUCKA
PCSAN 22 55' 3
3
65
82503036
SCAN
20
2
0
79 .72
72120797.
där SCAN är aktuell registrering och PSCAN närmast föregående. 82503036 anger tidpunkt uttryckt i millisekunder och 22 55 3 3 65 anger
värdet av byte l-5.
STRUKTURFEL ll OKTETTER 10 64 50 24 30- 10 33 55 37 90
Utskriften ger antalet oktetter (bytes) med strukturfel samt inom vilket ' tidsintervall de uppträder. I detta fallet är det minutangivelsen, 64, som är felaktig. Tidsintervallet blir ibland missvisande eftersom tidsangivelsen i sig kan innehålla strukturfel. Kör programmet READ_BYTE för vidare felsökning.
Strukturfel uppträder ofta i slutet av en mätdatafil. Det beror på att
TA84 mätutrustning vid mätslut fyller ut resterande buffertminne med OD (HEX) som vid utvärderingen ger strukturfel. (Se mätdatafil avsnitt
2.2).
5.3 Körexempel
CHECK_CASSETT - 851201
KONTROLL
INFIL: NORSHOLM_860625.BIN
ETIKETT PÅ INFIL (CR=JA):
860625,0937,860626,1052,
NORSHOLM R2
UTFIL KONTROLLINFO (CR=TERM,VTI=VTIPRINTER):
REGISTERERAD TID FRÅN' 09:17:12:113
6.
A-PULSER I FÖLJD
15:11:04:325-15:11:19:257 7. A-PULSER I FÖLJD 21:34:55:097-21_35:45:722 NEGATIV TIDLUCKA PSCAN 23 59 59 41 40 SCAN O 0 2 48 70 MIDNATT ! 6. A-PULSER I FÖLJD 00:09:45:005-90:10:32:906 7. A-PULSER I FÖLJD 02:28:37:873-92:29:21:408 6. B-PULSER I FOLJD 10:30:00:345-10:30:16:637 86399414 2487 STRUKTURFEL 226 OKTETTER 10 51 52 84 90- 13 13 13 STRUKTUR: KORREKT 213025 EJ KORREKT 226ANTAL KONTROLLERADE BYTES:213251
TILL: 10:51:52z849 * ANTAL REGISTRERINGAR SLANG A 21261 SLANG B 21343 13
6 TA84
6.1 Syfte och funktion
TA84 är ett program för att, utifrån mätdata, bilda fordon. För varje
fordon beräknas: - riktning - ankomsttid - fordonskod - hastighet - antal axlar - axelavstånd
Utdata sammanställs i FORDONSDATA där varje fordon lagras i ordning efter ankomsttid. Vidare erhålles s k SNABBSTATISTIK som för valfri tidsperiod bl a ger antal fordon per riktning, medelhastighet och antalet restpassager. Upp till tre olika tidsperioder kan väljas..Dessutom kan utskriftsintervallets längd väljas. Utskriften avslutas med en tabell över
antalet fordon under tidsperioden fördelade per fordonskod. Utdata lagras på diskfil eller skrivs ut på radskrivare.
6. 2 Arbetssätt
- Samla in registreringar som antas tillhöra samma fordon i en arbets-area. Inläsningen avbryts då:
LMAX - S
DT >
VMIN
där
DT = tidsskillnaden mellan* två på varandra följande
registrering-ar.
LMAX = max tillåtet axelavständ (10.00 m)
5 = givaravständ (normalt 3.30 m)
eller då:
antal registreringar = 18
(max 9 axlar i ett fordon)
beräkna hastigheten för varje axel i passagenvi = __5
i = 1 . . . n
(TAi - 31)
där
V i = hastigheten hos axel nr 1 S = givaravstândet
TAi : tidpunkt för A registrering hos axel nr i TBi : tidpunkt för B registrering hos axel nr i n = antalet axlar
fordonets hastiget erhålles som
V = Zvi
n
felkontroller:
Varje axelhastighet jämföres med denvförst passerade axeln.
Differen-sen får ej vara större än Ca+- 3 °/o (vid V:l 10 km/h).
beräkna axelavstånden
varje axelavstând L beräknas enligt
(TA1+1 _ TAi) + (TB1+1 - TBi)
Li = V * l l . n-1
2
där
Li = axelavstånd mellan axel i och i+l V :hastigheten enligt ovan
TAi = tidpunkt för A registrering hos axel i TBi = tidpunkt för B registrering hos axel i n = antalet axlar
felkontroller:
axelavstånd mindre än 0.40 m accepteras ej. axelavstånd större än 10.00 m accepteras ej.
axelavståndet beräknat över givare A resp B jämförs och differensen får ej överstiga 0.20 m.
ekipagets totala axelavstånd får ej överstiga 25.00 m.
slutkontroll
kontrollera att antalet A registreringar = antalet B registreringar
Jämför första och sista registreringen, får ej vara lika. antal reg måste vara större än tre. Enaxliga fordon tillåts ej.
om ekipaget godkännes med avseende på felkontrollerna tilldelas fordonet, utifrån axelarrangemanget, en fordonskod och lagras där-efter i utdata. Skulle däremot kontrollen indikera fel så vidtar programmet någon av nedanstående åtgärder för att försöka lösa ut passagen.
Exempel på felrutiner:
kontrollera om det finns s k dubbelpulser. Tag bort ev dubbelpulser. Med dubbelpuls avses ny puls från samma givare inom 25
milli-sekunder.
dela upp registreringarna i arbetsarean i två delar. Ev två fordon i
arbetsarean.
kasta om ordningen på registreringarna. Detta för att försöka lösa upp
"kasta bort" den första pulsen i arbetsarean. Då alla tänkbara åtgärder prövats är detta en sista utväg för att komma vidare till nästa
passage.
- efter lämplig felåtgärd beräknas åter hastighet, axelavstånd osv enligt ovan.
6.3 M
6.3.1 Beskrivning av FORDONSDATA
'Data indelas i två posttyper, posttyp 1 och posttyp 2.
Posttyp 1: Passage där vissa kriterier är uppfyllda med avseende på
axlarnas hastighet,'axe1avstånd, antal A resp B pulser, första
och sista puls, summa A och B pulser. Benämns korrekt passage. (Passage som tilldelats fordonskod som börjar med 9 kallas Restfordon). Postbeskrivning: Position Variabel 1 posttyp 2 riktning 3-11 ankomsttid 12-14 fordonskod 15-19 hastighet 21 antal axlar 22- axelavstånd
Posttyp 2: Passage där något av ovanstående kriterier ej är uppfyllt, benämns Restpassage. Postbeskrivning: Position Variabel l posttyp 2 riktning 3-1 1 ankomsttid 12-20 "dunnny"
21 antal axlar (säkerställda)
23-32
sekvens (givare 1 och givare 2)
34-39 "dunnny"
Exempel på FORDONSDATA lagrat på diskfil. 860625,0937,860626,1052, NORSHOLMR2
21091712113999 00.0
1109314925412 1109324501912 1109324692412 1109325137612 1109332833612 1109333113712 1109334106812 1109335985112 1109345094012 1109345190012 1109345245712 1109345783622 1109345923612 11093500933121 1109350283312 1109350399112 1109350516512 1109350714612 1109350816712 11093512474223 1109351683012 1109352203912 11093543302234 1109361087012 1109361363912 1109362327212 1109363758812 80.8 113.2 99.0 84.6 97.0 107.5 108.0 87.4 9319 90.3 91.7 73.8 74.7 71.7 73.1 72.2 74.0 86.7 86.1 74.3 71.8 79.7 79.5 90.3 87.7 91.7 97.4 1 1200000000 999999 22.69 22.61 22.53 22.67 22.60 22.76 22.70 22.52 22.70 22.70 22.71 23.736.3.2 Beskrivning av SNABBSTATISTIK Se körexempel avsnitt 6.5
6.4 Användarguide
Starta programmet genom att välja alternativ 5 i MENY TA84_33 PB OCH LÄTT LB < 3.3 M
INFIL:
Ange filnamn.
ETIKETT PA INFIL (CszA):
Ge vagnretur om det finns etikett, annars N. Ev etikett listas på skärmen. UTFIL FORDONSDATA (VTI=VTIPRINTER):
Ange utfil.
AVST.MELLAN SLANGAR (M): Normalt 3.3 m, se mätprotokollet.
LÄGSTA HASTIGHET (M/S):
Värdet yttrycker den lägsta hastighet som ett fordon med max axelav-stånd tillåts passera givarna utan att bli delat i två ekipage. (Variabeln VMIN i avsnitt 6.2). Observera att lägre hastighet godkännes om
axelav-ståndet är mindre än maxavständ.
AMBITIONSNIVÅ (354,26):
Ange alltid värdet sex.HUR MÅNGA UTSKRIFTSPERIODER:
UTSKRIFTSPERIOD(ER) (TIM.MIN,DYGN,TIM.MIN,DYGN)
>
Upp till tre utskriftsperioder kan begäras. Ange start och sluttid för varje
UTSKRIFTSINTERVALL (MINUTER): Ange önskat intervall.
UTFIL SNABBSTATISTIK (CRzTERM,VTI=VTIPRINTER): Ange utfil.
Programmet exekveras.
6.5 Körexempel
TA84_33 861119
PB OCH LÄTT LB
< 3.3 M
INFIL: NORSHOLM_860625.BIN ETIKETT PÅ INFIL (CR=JA): 860625,0937,860626,1052,
NORSHOLMRZ
UTFIL FORDONSDATA (VTI=VTIPRINTER): NORSHOLM FORDON.DAT
AVST. MELLAN SLANGAR (M): 3.3 '
LÄGSTA HASTIGHET (M/S): 10.00 AMBITIONSNIVÅ (3,4,5,6): 6 HUR MÅNGA UTSKRIFTSPERIODER: 1
UTSKRIFTSPERIOD(ER) (TIM.MIN,DYGN,TIM.MIN,DYGN)
>9.00,1,12.00,2
UTFIL SNABBSTATISTIK (CR=TERM,VTI=VTIPRINTER): UTSKRIFTSINTERVALL (MINUTER): 120
TID ANTAL FORDON ANTAL AXLAR HASTIGHET ANTAL RESTREG. ANTAL
R1 R2. R1 R2 le R2 A B ' RESTPAE 09:17) 1:00 725 8 1643 17 90.2 89.0 58 56 35 3°00 1009 6 2421 12 89.0 110.6 89 71 49 5 00 834 22 1988 44 89.3 100.8 72 70 39 7 00 1106 30 2519 60 88.9 99.5 91 75 49 9 00 941 22 2209 51 88.4 104.4 78 67 51 1 00 594 11 1656 26 89.4 109.7 62 58 42 3 00 414 14 1099 28 88.8 114.8 76 66 45 1.00 198 15 536 41 89.4 99.4 33 21 17 3.00 91 0 254 0 91.7 0.0 21 13 9 5°00 74 1 205 2 97.3 115.9 17 10 8 7°00 394 7 908 14 93.7 103.9 24 26 18 9 00 815 13 1887 26 90.4 104.3 63 57 42 0 51 896 6 2041 12 90.7 111.8 67 54 34 UMMA 8091 155 19366 333 - - 751 644 438
OTAL
8246
19699
-
-
1395
438
TOLKADE RESTPASSAGER ' ANTAL STUDS ***STATISTIK*** 02 111 9 120 '12 6162 128 6290 22 412 6 418 42 87 4 91 23 56 1 A 57 43 11 1 12 121 281 0 281 221 22 0 22 y 321 27 0 27 421 2 0 2 93 50 0 50 24 13 0 13 122 5 0 5 222 82 0 82 231'" 22 0 22 322 68 0 68 331 2 0 2 922 46 0 46 94 2 0 2 223 196 0 196 232 69 0 69 323 '26 1 27 332 24 2 26 923 5 0 5 224 35 0 35 233 212 3 215 333 2 0 2 342 1 0 1 924 1 0 1 933 6 0 6 234 44 0 44 243 5 0 5 934 2 0 2 244 1 0 1 935 1 0 1 S:A 8091 155 8246
TOLKADE PASSAGER MED STUDS SKIPPADE PASSAGER PGA TIDHOPP
2 1807 1366 0
Kommentarer:
I den avslutande tabellen STATISTIK visas en sammanställning över antalet fordon enligt:
Kolumn Innehåll
1 Fordonskod
2 Antal fordon riktning l, R1 3 Antal fordon riktning 2, R2 4 Summa riktning i och 2, R3 Tolkade restpassager 2 5
Denna utskrift betyder att rutinen för att kasta om ordningen på registreringarna har anropats sju gånger (2+5). Rutinen har i två fall
lyckats och i fem fall misslyckats med att lösa ut passagen.
1807
Antalet detekterade dubbelpulser. Antal studs
1366
Antalet passager som innehållit dubbelpulser men som, efter det att Tolkade passager med studs
dessa tagits bort, tolkats som korrekta passager.
Skippade passager p g a tidhopp 0
Ett fordon lagras ej i utdata om tidsdifferensen till närmast föregåen-de fordon överstiger två timmar.
7
SELECT_CODE
7.1 Syfte och funktion
SELECT_CODE är ett program för att från FORDONSDATA selektera ut fordon med avseende på, kod. Upp till tio olika fordonskoder kan väljas och även riktning l, 2 eller 3. Utdata innehåller samma variabler som Fordonsdata dock med ett något "luftigare" format.
7.2 Användarguide
Starta programmet genom att välja alternativ 6 i MENY.
SELECT_CODE 860617
INFIL: Ange filnamn.
Programmetlistar etiketten på skärmen.
OK? (CRzJA):
Bekräfta med vagnretur.
UTFIL STATISTIK (CRzTERM,VTI=VTIPRINTER): Ange utfil.
ANGE RIKTNING (1/2/3): Skriv l, 2 eller 3
ANTAL KODER (MAX 10):
Ange hur_ många olika fordonskoder Du önskar selektera ut. '
ANGE KODER:
>
Mata in de aktuella koderna. Skriv endast en kod per rad.
7.3 Körexempel
SELECT_CODE 860617
INFIL: NORSHOLM_FORDON.DAT 860625,0937,860626,1052 NORSHOLMRZ OK? (CR=JA): UTFIL STATISTIK ANGE RIKTNING (1/2/3): 3 ANTAL KODER (MAX 10): 3ANGE KODER: >122 >331 >923 l 10:07:18:731 122 1 13:00:32z892 331 1 14:45:26:066 923 1 19:35:36:877 122 l 21:30:33:659 923 1 22:09:47z381 923 1 04:50:35:594 923 1 06:29:47:179 331 1 06:50:34:138 923 1 08:51:52:632 122 1 09:05:23:366 122 1 09:25:35z272 122 **STATISTIK** KOD ANTAL 122 5 331 2 923 5 SUMMA 12 A b b wo m b m wwm w (CR=TERM,VTI=VTIPRINTER): b åb m b m m m øb m b b N N N b e t h b l -' N m m m m m m m m b wm w O O O I -' O N i -* l -' l -* O l -' O S O
:91
m U' l xl ü NJ.32 .82 .428 STATISTIK
Se särskild dokumentation för detta program.
9 TUAL
10 10.1
PROGRAMKOD Read_Byte
PROGRAM READ BYTE
C 870813 C** EV 25 INTEGER*2 SCAN(5),DECSCAN(5),TUBE,HOUR1,HOUR2,FROM,TO INTEGER*2 H24,H59,H99,H9O REAL NBYTE,PNBYTE PARAMETER (H24=36,H59=89,H99=153,H90=l44) CHARACTER FILE*35,FORM*15,LINE(2,80),ANSW*1,FETIK(250)*1 LOGICAL EOF,ERR,OUTHOUR,POUTHOUR,PPOUTHOUR,LPUT,TERM WRITE(6,'(/" READ_BYTE 870813"//)') WRITE(6,'("$INFIL: ")') READ(5,'(A)') FILE OPEN(2,FILE=FILE,FORM='UNFORMATTED',STATUS='OLD') KOLLA ETIKETT **
WRITE(6,'("$ETIKETT PÅ INFIL (CR=JA): ")' READ(5,'(A)') ANSW IF(ANSW(1:1).EQ.' ')THEN CALL GET_ETIKETT(LINE) WRITE(6,*) * WRITE(6,25) (LINE(1,L) L WRITE(6,25) (LINE(2,L),L FORMAT(1X,79A) END IF WRITE(6,'(/"$UTFIL (CR=TERM,VTI=VTIPRINTER): " ') READ(5,'(A)')FILE V IO=3 IF(FILE(1:3).EQ.'VTI')THEN 0PEN(IO,FILE='VTI_PRINT.LIS',STATUS='UNKNOWN') LPUT=.TRUE. ELSEIF(FILE.EQ.' ')THEN IO=6 TERM=.TRUE. ELSE . OPEN(IO,FILE=FILE,STATUS='UNKNOWN') END IF C** UTSKKRIFTSINTERVALL 29 30 11 WRITE(6,'("$TIM1,TIM2: ")') READ(5,*) HOUR1,HOUR2 WRITE(6,'("$FRÅN,TILL (MINUT): READ(5,*) FROM,TO IF(.N0T.TERM) THEN WRITE(IO,29) (LINE(1 WRITE(I0,30) (LINE(2 FORMAT(' ',24A) FORMAT(' ',70A)
WRITE(6,'(/"$READ BYTE RUNNINGI')')
END IF _ 71)!)
)
,L),L=l,24 rL)rL=lr70)DO WHILE(.NOT.EOF)
D0 I=1,5
SCAN(I)=INCH(2)
IF(SCAN(I).EQ.255)THEN 1 FÃLTETIKETT150 50 12 +4 -+ -+ ++
CALL GET FAELTETIK(2,FETIK)
WRITE(107150) (FETIK(LT),LT=2,250) FORMAT(/ ' Fältetikett.'/ . ',2A1/ ' Apparat nr ' Givare nr ',2A1/ ' Mätplats ',16A1/ ' Datum : ',6A1/ ' Övrigt ',30A1/,7(14X,30Al/)) GOTO 11 END IF NBYTE=NBYTE+1 END DO TUBE=O
DO WHILE((TUBE.EQ.0.0R.ERR) .AND. (.NOT.EOF)) EOF=SCAN(1).LT.O .OR. SCAN(2).LT.O _
.OR. SCAN(3).LT.O .OR. SCAN(4).LT.O .OR. SCAN(5).LT.O TUBE=SCAN(l)/64 "
SC1=IIAND(SCAN(1),63)
ERR=TUBE.LT.1 .OR. TUBE.GT.2 ERR=ERR .OR. SC1.GT.H24
ERR=ERR .OR. SCAN(2).GT.H59 .OR. SCAN(3).GT.H59 ERR=ERR .OR. SCAN(4).GT.H99 .OR. SCAN(5).GT.H9O IF(ERR)THEN SCAN(1)=IIAND(SCAN(1),63) DO J=1,5 L=SCAN(J)/16 DECSCAN(J)=L*10+(SCAN(J)-L*16) END DO IF((NBYTE-PNBYTE).GT.5)WRITE(IO,'(" WRITE(IO,50) NBYTE,DECSCAN FORMAT(F10.0,2X,515,' DO I=1,4 ' SCAN(I)=SCAN(I+1) END DO SCAN(5)=INCH(2)
EJ UTSK. BYTES!!")'
*'k') IF(SCAN(I).EQ.255)THEN 1 FÃLTETIKETT CALL GET_FAELTETIK(2,FETIK) WRITE(IO,150) (FETIK(LT),LT=2,250) GOTO 12 END IF NBYTE=NBYTE+1 PNBYTE=NBYTE END IF END DO' SCAN(1)=IIAND(SCAN(1),63) DO J=1,5 ' L=SCAN(J)/16 DECSCAN(J)=L*10+(SCAN(J)-L*16) END DO100
IF(OUTHOUR .OR. POUTHOUR .0R. PPOUTHOUR)THEN
IF(DECSCAN(2).GE.FROM .AND. DECSCAN(2).LE.TO)THEN
IF((NBYTE-PNBYTE).GT.5)WRITE(IO,'(" EJ UTSK. BYTES!!")' IF(TUBE.GT.O)TUBE=l/TUBE+1 WRITE(IO,100) NBYTE,DECSCAN,TUBE FORMAT(F10.0,2X,515,IS) PNBYTE=NBYTE END IF END IF PPOUTHOUR=POUTHOUR
POUTHOUR=(DECSCAN(1).EQ.HOUR1) .OR. (DECSCAN(1).EQ.HOUR2) END DO
IF(LPUT)THEN CLOSE(IO)
CALL LIBSSPAWN ('PRIN/QUE=VTI/FORM=VTI/DEL VTI_PRINT.LIS') END IF
10.2 Check_Cassett
PROGRAM CHECK CASSETTE
C**870813 10 C** EV 25 ..|.. 40 45 50 +
INTEGER*4 HOUR,SEC,TUBE
INTEGER*4 PTUBE,OUT,NTUBE(2)
REAL*8 TIME,CTIME,PTIME,STARTSEQ,ANTSEQ
CHARACTER MPLACE*80,INFILE*35,UTFILE*35,CH(2)*1,LINE(2,80)
CHARACTER ANSW*1
LOGICAL EOF,FIRST,LPUT
DATA CH/'B','A'/
COMMON // OUT
CHECK-CASSETT - 870813")') KONTROLL"//)') WRITE(6,'("$INFIL: ")') READ(5,'(A)') INFILE OPEN(UNIT=2,FILE=INFILE,STATUS='OLD',FORM='UNFORMATTED',ERR=lO KOLLA ETIKETT **WRITE(6,'("$ETIKETT PÅ INFIL (CR=JA): ")') READ(5,'(A)') ANSW IF(ANSW(1:1).EQ.' ')THEN CALL GET_ETIKETT(LINE) WRITE(6,*) WRITE(6,25) (LINE(1,L),L=1,79) WRITE(6,25) (LINE(2,L),L=1,79) FORMAT(1X,79A) END IF WRITE(6,'(/" WRITE(6,'(/" \ WRITE(6,' ,
(/"$UTFIL KONTROLLINFO (CR=TERM,VTI=VTIPRINTER): ")') READ(5,'(A)') UTFILE IF(UTFILE(1:1).EQ.' OUT=6 ELSE OUT= 3 IF(UTFILE(1:3).EQ.'VTI')THEN OPEN(UNIT=OUT,FILE='VTI PRINT.LIS',STATUS='UNKNOWN') LPUT=.TRUE. ' ELSE OPEN(OUT,FILE=UTFILE,STATUS='UNKNOWN') END IF WRITE(OUT,40)(LINE(1,L),L=l,24) WRITE(OUT,45)(LINE(2,L),L=1,70) FORMAT(1X,24A) FORMAT(1X,7OA/) WRITE(OUT,50) INFILE FORMAT(/5X,' CHECK_CASSETT - 870813',//, 5x,' KONTROLL'//f INFIL: ',A/) WRITE(6,*)'CHECK-CASSETT RUNNING' END IF ')THEN FIRST=.TRUE. CALL GETSCAN(TIME,TUBE,EOF) ANTSEQ=ANTSEQ+1 DO WHILE(.NOT.EOF)
200
PTUBE=TUBE
CALL CTIME(TIME,HOUR,MIN,SEC,MSEC)
WRITE(OUT,'(/" REGISTRERAD TID"/" FRÅN:")') WRITE(OUT,200) HOUR,MIN,SEC,MSEC FORMAT('$',7X,IZ.2,':',IZ.2,':',IZ.2,':',13.3//) FIRST=.FALSE. END IF C * TEST A- EL B-PULS I FÖLJD + 250 +
300
+ + IF(TUBE.EQ.PTUBE)THEN ANTSEQ=ANTSEQ+1 ELSE IF(ANTSEQ.GT.5)THEN CALL CTIME(STARTSEQ,IHOUR,IMIN,ISEC,IMSEC) CALL CTIME(PTIME,HOUR,MIN,SEC,MSEC) WRITE(0UT,250) ANTSEQ,CH(TUBE),IHOUR,IMIN,ISEC,IMSEC, HOUR,MIN,SEC,MSEC FORMAT(F6.0,2X,A,'-PULSER I FÖLJD'/8X,IZ.2,':',12.2,':' ,IZ.2,':',13.3,'-',IZ.2,':',IZ.2,':',12.2,':',I3.3) END IF ANTSEQ=1 STARTSEQ=TIME PTUBE=TUBE END IF PTIME=TIME CALL GETSCAN(TIME,TUBE,EOF) END DO CALL CTIME(PTIME,HOUR,MIN,SEC,MSEC) WRITE(OUT,'(//," TILL: ")') WRITE(OUT,200) HOUR,MIN,SEC,MSEC WRITE(OUT,300) NTUBE(1),NTUBE(2)FORMAT(' ANTAL REGISTRERINGAR'/ ' SLANG A',I10/ '
' SLANG B',IlO/)
CLOSE(OUT) IF(LPUT)
CALL LIBSSPAWN ('PRIN/DEL/QUE=VTI/FORM=VTI VTI_PRINT.LIS') END
C********************************************
C NOPS => ANTAL BYTES PER SCANNINGSUBROUTINE GETSCAN(TIME,TUBE,EOF) PARAMETER (NOPS=5) INTEGER*4 SCAN(NOPS),TUBE,PSCAN(NOPS),H59,H24,H90,H99,0UT,SC1 REAL*8 ANTBYTE,ERRBYTE,TIME,PTIME,XTIME,ADD CHARACTER FETIK(250)*1 LOGICAL EOF,ERR . DATA ADD/0.0/,H59/89/,H24/36/,H90/l44/,H99/153/ COMMON // OUT EOF=.FALSE.
11 100 12
+-++
-+
+-+
ERR=.TRUE. TUBE=O NERR=O DO I=1,NOPS SCAN(I)=INCH(2) IF(SCAN(I).EQ.255)THEN z CALL GET FAELTETIK(2,FETIK)WRITE(0UT,100) (FETIK(LT),LT=2,250) FORMAT(/ ' Fältetikett.'/ Apparat nr ',2A1/ Givare nr . '.2Al/ Mätplats : ',16A1/ patum ° ',6A1/
' övrigt
',30A1/,7(14X,30Al/))
GOTO 11 END IF. FÄLTETIKETT ' ääá ANTBYTE=ANTBYTE+1 END DOD0 WHILE((TUBE .EQ. O .OR. ERR) TUBE=SCAN(l)/64
EOF=SCAN(1).LT.O .OR. SCAN(2).LT.O .OR. SCAN(3).LT.O .OR. SCAN(4).LT.O .OR. SCAN(5).LT.O
SClaJIAND(SCAN(l),63)
ERR=TUBE .LT. I .OR. TUBE .GT. 2 ERR=ERR .OR. SCl .GT. H24
ERR=ERR .OR. SCAN(2).GT.H59 .OR. SCAN(3).GT.H59 ERR=ERR .OR. SCAN(4).GT.H99 .OR. SCAN(5).GT.H90 NERR=NERR+1
IF(ERR .AND. .NOT.EOF) THEN DO I=1,NOPS-l
SCAN(I)=SCAN(I+1) END DO
SCAN(NOPS)=INCH(2)
.AND. .NOT. EOF)
IF(SCAN(I).EQ.255)THEN ! CALL GET_FAELTETIK(2,FETIK) WRITE(OUT,100) (FETIK(LT),LT=2,250) GOTO 12 END IF FÄLTETIKETT NSCAN=NSCAN+1 ERRBYTE=ERRBYTE+1 END IF END DO SCAN(1)=JIAND(SCAN(1),63) DO K=1,5 L=SCAN(K)/16 * SCAN(K)=L*lO+(SCAN(K)-L*16) END DO
10
20
FORMAT(' STRUKTURFEL'IS' OKTETTER'SI4'-'SI4) IF(.NOT.EOF) THEN IF(TUBE.NE.O)TUBE=l/TUBE+1 TIME=ADD+(SCAN(1)*3600.+SCAN(2)*60.+SCAN(3))*1000. MSEC=SCAN(4)*10.0+SCAN(5)/10 TIME=TIME+MSEC XTIME=TIME
IF(TIME .LT. PTIME) THEN
WRITE(OUT,*) ' NEGATIV TIDLUCKA'
WRITE(OUT,'(A,SI4,F12.0)') ' PSCAN',PSCAN,PTIME WRITE(OUT,'(A,SI4,F12.0)') ' SCAN',SCAN,TIME IF(PSCAN(1).GT.22 .AND. SCAN(1).LT.1)THEN
WRITE(OUT,*) 'MIDNATT !' ADD=ADD+24.0*3600.*1000. TIME=ADD+TIME . END IF END IF DO K=1,5 PSCAN(K)=SCAN(K) END DO PTIME=XTIME ELSEIF(EOF)THEN WRITE(OUT,20) ANTBYTE,ERRBYTE,ANTBYTE+ERRBYTE FORMAT(//' STRUKTUR: KORREKT 'F7.0,/
' EJ KORREKT 'F7.0,/
' ANTAL KONTROLLERADE BYTES:'F7.0) END IF RETURN END SUBROUTINE CTIME(XTIME,HOUR,MIN,SEC,MSEC) INTEGER*2 HOUR,SEC REAL*8 TIME,XTIME TIME=XTIME HOUR=TIME/3600000. TIME=TIME-HOUR*3ÖOOOOO. HOUR=MOD(HOUR,24) MIN=TIME/60000. TIME=TIME-MIN*GOOOO. SEC=TIME/1000. TIME=TIME-SEC*1000. MSEC=TIME END
10.3 TA84
PROGRAM TA84_33
C**870813PARAMETER (DL=0.20,SAM=10.0,SAL=0.40)
INTEGER*4 NOR(2),RESTCODE(10),TUBE,SEQ,A,B,FIRSTTUBE,ICODE,WHY
INTEGER*4 RANOP,HOUR,SEC,H1,H2,Sl,82,IDX(18),TU(18)
INTEGER*4 NO(2,2,2),NOS,NOP,NOPT,MINUTTID,AXGROUP(6)
INTEGER*4 SPAS,SAXL,SRESTP,TUT,IKOD,D1,D2,PERIOD,NORAB
INTEGER*4 GODP(2),RESTS(2),SRESTS(2),RESTP,SUM(2,73)
INTEGER*4 SRESTREG,SSl,SSZ,SUMBO,SUMBOKOD
REAL*8 FTIME(3),TTIME(3),PRTIME(3),PFIRSTTIME,FIRSTTIME
REAL*8 PTIME,TIME,TIMETABLE(18,2),TT(18),PREVTIME,RESTTIME
REAL*8 PRFREQ
REAL*4
SA(9),SB(9),SAB(9)
REAL*4
TVAVER(2),BL
LOGICAL ACCEPTED PASSAGE,EOF,BREAKTIME,IMPOSSIBLE,SKIPPED
LOGICAL ERROR,EQUALN,FIRSTTRY,DFUT,LPUT,CTUT,TAILSKIPPING
LOGICAL CRUISE,DUMMY,TERM,ETIKETT,STUDS,STUDSPASSAGE
LOGICAL COUNT,FIRST,EMPTY,FIRSTREG,OK,STUDS DUMMY,FOUND
LOGICAL LPSNABB
CHARACTER HEADLINE*80,CNV(0:2),FILE*35,ANSW*10,MARK*1
CHARACTER LINE(2,80),CKOD*3,COM*1
.
PARAMETER (A=1,B=2)
PARAMETER (BL=25)
COMMON // IO,IOS
DATA CNV/' ','A','B'/
C** EV TESTUTSKRIFTSFILER C UNIT 8 BOUNCE-RUTIN C UNIT 7 PERMUTE-RUTIN C OPEN(7,FILE='PERMUTE_TEST.DAT',STATUS='UNKNOWN') C OPEN(8,FILE="BOUNCE_TEST.DAT',STATUS='UNKNOWN') CA HEADLINE='ASCII INLÄSNING FRÅN TA84:DATA'CA LINE1=LINE2='TA84:DATA'
CA OPEN(UNIT=2,FILE='TA84.DAT',STATUS='OLD')
HEADLINE=' PB OCH LÄTT LB < 3.3 M' L=LEN(HEADLINE)
WRITE(6,'(/" TA84_33 870813 ",A/)') HEADLINE(1:L) C ** INFIL ****** 5 CONTINUE 6 WRITE(6,'("$INFIL: ")') READ(*,'(A)') FILE OPEN(UNIT=2,FILE=FILE,FORM='UNFORMATTED',STATUS='OLD',ERR=6) C** KOLLA EV ETIKETT **
WRITE(6,'("$ETIKETT PÅ INFIL (CR=JA): " ') READ(5,'(A)') ANSW
IF(ANSW(1:1).EQ.' ') THEN CALL GET ETIKETT(LINE) WRITE(6,?)
WRITE(6,*)(LINE(1,L),L=1,79)
WRITE(6,*)(LINE(2,L),L=l,79)
ELSE
WRITE(6,'("$MÄTTID (ÅÅMMDD,TTMM,ÅÅMMDD,TTMM): ")')
READ(5,'(24A)'1 (LINE(1,L),L=1,24)
WRITE(6,'("$MATPLATS: ")')
READ( ,'(80A)') (LINE(2,L),L=1,80)
WRITE(6,*)(LINE(1,L),L=1,24) WRITE(6,*)(LINE(2,L),L=1,79) END IF
C **-UTFIL *******
10 WRITE(6,'("$UTFIL FORDONSDATA (CRSDUMMY): ")') READ(5,'(A)') FILE DATA 10/10/ IF(FILE(1:1).EQ.' ')THEN OPEN(UNIT=IO,FILE='VTI_PRINT.LIS',STATUS='NEW') LPUT=.TRUE. ELSE OPEN(UNIT=IO,FILE=FILE,CARRIAGECONTROL='LIST',STATUS='NEW') DFUT=JTRUE. END IF
c ** SKRIV ETIKETT PÅ UTFIL
WRITE(IO,30) (LINE(1,L),L=1,24)
WHITE(I0,31) (LINE(2,L),L=1,70) 30 FORMAT(' '24A)
31 FORMAT(' '70A/)
WRITE(6,'("$AVST. MELLAN SLANGAR (M): ")') READ(5,*) TUBEDIST
CRUISE=TUBEDIST .LT. 0
IF(CRUISE) OPEN(UNIT=5,FILE='A STATION.DAT',STATUS='NEW') TUBEDIST=ABS(TUBEDIST) ' ' WRITE(6,'("$LÄGSTA HASTIGHET (M/S): ")') READ(5,*) VMIN WRITE(6,'("SAMBITIONSNIVÅ (3,4,5,6): ")') READ(5,*) LEVEL STUDS DUMMY=LEVEL.LT.O LEVEL=ABS(LEVEL)
IF(LEVEL .LT. 3 .OR. LEVEL .GT. 6) LEVEL=3
ADD=24.0*3600.0*1000.0 '
13 WRITE(6,'("$HUR MÅNGA UTSKRIFTSPERIODER: ")') READ(5,*) NPER
NPER=ABS(NPER)
IF(NPER.LT.1 .OR. NPER.GT.3) GOTO 13
14 WRITE(6,'(" UTSKRIFTSPERIOD(ER) (TIM.MIN,DYGN,TIM.MIN,DYGN)") D0 I=1,NPER
WRITE(6,'("$>")')
READ(5,*) FTIME(I),D1,TTIME(I),D2 IF(D1.LT.1 .OR. D2.LT.1) GOTO 14
IF(FTIME(I).LT.0.0 .OR. FTIME(I).GT.24.0)GOTO 14 IF(TTIME(I).LT.0.0 .OR. TTIME(I).GT.24.0)GOTO 14 FTIME(I)=DINT(FTIME(I))*3600000.+
+ (FTIME(I)-DINT(FTIME(I)))*100.*60000. TTIME(I)=DINT(TTIME(I))*3600000.+
FTIME({)=DNINT((FTIME(I)+ADD*(D1-1))/10.0)*10.0 TTIME(I)=DNINT((TTIME(I)+ADD*(D2-l))/10.0)*10.0 END DO WRITE(6,'("SUTSKRIFTSINTERVALL (MINUTER): ")') READ(5,*) PRFREQ PRFREQ=PRFREQ*60000. CTUT=PRFREQ .NE. O PRFREQ=ABS(PRFREQ) C20 WRITE(6,'("SSVANSKLIPPNING (J/N): ")') C READ(5,'(A)') ANSW C IF(ANSW(1:1).NE.'J'.AND.ANSW(1:1).NE.'N') GOTO 20 C TAILSKIPPING=ANSW(1:1) .EQ. 'J' TAILSKIPPING=.FALSE. DTM=(SAM-TUBEDIST)/VMIN*1000 C** UTFIL SNABBSTATISTIK ** WRITE(6,'
+ ("$UTFIL SNABBSTATISTIK (CR=TERM,VTI=VTIPRINTER): ")') READ(5,'(A)') FILE TERM=FILE(1:1).EQ.' ' IOS=6
IF(.NOT.TERM)THEN
WRITE(6,'(/"$TA84 IS RUNNING")')
:05:9
IF(FILE(1:3).EQ.'VTI')THEN
OPEN(IOS,FILE='SNABBSTATISTIK.LIS',STATUS='NEW')
LPSNABB=.TRUE.
ELSE
OPEN(IOS,FILE=FILE,STATUS='UNKNOWN')
END IF
WRITE(IOS,30) (LINE(1,L),L=1,24)
WRITE(IOS,31) (LINE(2,L),L=1,70)
'
'
WRITE(IOS,34)TUBEDIST,VMIN,SAM,SAL,DL,DTM,LEVEL,TAILSKIPPING
34
FORMAT(/
I + AKTUELLA KRITERIER: '/ + 7 _______7 ___________________ 1 + ' SLANGAVSTÅND (M):'F5.2/ + ' MINSTA HASTIGHET (M/S):',F6.2/ + ' MAX AXELAVSTÅND (M): ',F6.2/ + ' MIN AXELAVSTÅND (M): ',F6.2/ + ' MAX AXELAVST. DIFF (M):',F6.2/ + ' MAX REG.TID DIFF (MS): ',F7.0/+ ' AMBITIONSNIVÅ: ',16/ + ' SVANSKLIPPNING (T/F): ',L6/) END IF C C UTSKRIFT AV TABELLHUVUD************************* IF(CTUT) THEN WRITE(IOS,45)
45 FORMAT(//' TID .ANTAL FORDON _ANTAL AXLAR ',
+ ' HASTIGHET ANTAL RESTREG. ANTAL'/
+ ' R1 , R2 R1 R2 ',
+ ' R1 R2 A B RESTPAS'/)
EOF=.FALSE. FIRSTREG=.TRUE. FIRST=.TRUE. PERIOD=O C************************************************* C************************************************* DO WHILE(.NOT. EOF) DTMAX=DTM NORABMAX=18 FIRSTTRY=.TRUE. ACCEPTED PASSAGE=.FALSE. STUDSPASSAGE=.FALSE. SKIPPED=.FALSE. EMPTY=.FALSE. PFIRSTTIME=FIRSTTIME IF(FIRST)PFIRSTTIME=99000OOO CALL GETREG(TIME,TUBE,EOF) IF(.NOT.COUNT) THEN IF(TIME.GT.FTIME(PERIOD+1).AND.FTIME(PERIOD+1).GT.OQ001 .OR. FIRST) THEN
WRITE(IOS,*) PERIOD=PERIOD+1 PRTIME(PERIOD)=FTIME(PERIOD) IF(FIRSTTIME.LT.0.001)THEN CALL CTIME(TIME,HOUR,MIN,SEC,MSEC) WRITE(IOS,'(1X,"("IZ.2":"IZ.2")")') HOUR,MIN C NÄSTA RAD EJ LÄMPLIG OM NEG TIDLUCKA VID START
C C CD
IF(FTIME(PERIOD).LT.TIME)
PRTIME(PERIOD)=TIME-DMOD(TIME-FTIME(PERIOD),PRFREQ)
END IF
END IF
END IF
COUNT=TIME.GE.FTIME(PERIOD) .AND. TIME.LE.TTIME(PERIOD)
EMPTY=TIME.GT.TTIME(PERIOD) .AND. PFIRSTTIME.LT.TTIME(PERIOD
IF(PERIOD.EQ.O)STOP 'PERIOD=O'
CALL SKIPREG(0)
iRESET REG. I ARBETSAREAN
DO WHILE(.NOT.(ACCEPTED PASSAGE .03. EOF))
NOR(A)=0
NOR(B)=O
NORAB=O
SEQ=O
DT=0.0
STUDS=.FALSE.
CALL GETREG(TIME,TUBE,EOF)
FIRSTTIME=TIME
FIRSTTUBE=TUBE
BREAKTIME=DT.GT.DTMAX .OR. NORAB.GE.NORABMAX
DO WHILE(.NOT. (BREAKTIME .OR. EOF))
IF(NOR(TUBE).EQ.9) THEN
WRITE(6,*) 'BUFFER FULL 1'
BREAKTIME=.TRUE.
C NOR(TUBE)=NOR(TUBE)+1 NORAB=NORAB+1 PTIME=TIME TIMETABLE(NOR(TUBE),TUBE)=TIME TT(NORAB)=TIME TU(NORAB)=TUBE
IF(TUBE .EQ. FIRSTTUBE) SEQ=JIBSET(SEQ,NORAB) CALL GETREG(TIME,TUBE,EOF)
DT=TIME-PTIME
BREAKTIME=DT.GT.DTMAX .OR. NORAB.GE.NORABMAX END IF END DO IF(.NOT.FIRSTTRY) THEN COUNT=FIRSTTIME.GE.FTIME(PERIOD) .AND. FIRSTTIME.LE.TTIME(PERIOD) EMPTY=FIRSTTIME.GT.TTIME(PERIOD) .AND. PFIRSTTIME.LT.TTIME(PERIOD) END IF WRITE(6,46) (TT(I),I=1,NORAB) FORMAT(' TT:'/14Fll.0) WRITE(6,47) (TU(I),I=1,NORAB) FORMAT(' TU:'/l4I9) WRITE(6,*)'RETURN' READ(5,*) DUMMY
IF(FIRSTTRY .OR. SKIPPED) THEN MAXNORAB=NORAB
SKIPPED=.FALSE.'
END IF .
C KONTROLLERA OM SAMMA HASTIGHET GENOM HELA "PASSAGEN" C ACCEPTED PASSAGE=.TRUE. WHY=0 N=JMINO(NOR(A),NOR(B)) TD1=TIMETABLE(1,A)-TIMETABLE(1,B) IF(ABS(TD1) .LT. 0.000001) TD1=1.0 PV=TUBEDIST/TD1 VSUM=ABS(PV) DO IR=2,N TD1=TIMETABLE(IR,A)-TIMETABLE(IR,B) IF(ABS(TD1) .LT. 0.000001) TD1=1.0 V=TUBEDIST/TD1 DV=ABS(PV-V)*1000.0 R1=DV/(ABS(PV)*1000.0) R2=(2.0/TUBEDIST)*(0.06 + ABS(PV)) VMS=ABS(V*1000) IF(R1 .GT. R2) THEN CALL SKIPREG(0) CALL BOUNCE(TT,TU,IDX,NORAB,NBO,STUDS) IF(STUDS)THEN STUDSPASSAGE=.TRUE. CALL SHIFT(TT,TU,IDX,NORAB) IF(COUNT)SUMBO=SUMBO+NBO WHY=1
END IF
IF( .NOT. STUDS ) THEN. 'NORABMAX=( IR-l ) *2 WHY=10 ENDIF ACCEPTED PASSAGE=.FALSE. IR=N END IF VSUM=VSUM+ABS(V) PV=V END DO IF(N.NE.O)VAVER=VSUM/N C
c KONTROLERA om RIMLIGA AXELAVSTÅND c
IF(ACCEPTED PASSAGE) THEN TLEN=0.0 DO ID=1,N-l SA(ID)=ABS(VAVER*(TIMETABLE(ID+1,A)-TIMETABLE(ID,A))) SB(ID)=ABS(VAVER*(TIMETABLE(ID+l,B)-TIMETABLE(ID,B))) DIFF=ABS(SB(ID)-SA(ID)) SAB(ID)=(SA(ID)+SE(ID))/2.0 TLEN=TLEN+SAB(ID)
IF(SAB(ID).GT.SAM .03. SAB(ID).LT.SAL .OR. TLEN.GT.25
+ % .03. DIFF .GT. DL) THEN -CALL SKIPREG(O) CALL BOUNCE(TT,TU,IDX,NORAB,NBO,STUDS) IF(STUDS)THEN ' CALL SHIFT(TT,TU,IDX,NORAB) STUDSPASSAGE=;TRUE. IF(COUNT)SUMBO=SUMBO+NBO WHY=WHY+100 END IF . IF(.NOT.STUDS)THEN NORABMAX=ID*2 WHY=WHY+1000 ENDIF ACCEPTED PASSAGE=.FALSE. ID=N-l END IF END D0 END IF C c EN SISTA KONTROLL c
EQUALN=NOR(A) .EQ. NOR(B)
IF(.NOT.EQUALN .AND. ACCEPTED PASSAGE)THEN CALL SKIPREG(O) CALL BOUNCE(TT,TU,IDX,NORAB,NBO,STUDS) IF(STUDS)THEN CALL SHIFT(TT,TU,IDX,NORAB) STUDSPASSAGE=.TRUE. IF(COUNT)SUMBO=SUMBO+NBO ACCEPTED PASSAGE=.FALSE.
WHY=WHY+50 END IF END IF C SKIPPA OM STUDS IF(STUDS)THEN IF(LPUT.ANDQSTUDS DUMMY.AND.(COUNT.OR.EMPTY))THEN DO I=IDX(1)-l,l,-l FOUND= + (ABS(TT(IDX(1))-TT(I)).LT.BL).AND.TU(IDX(1)).EQ.TU(I) IF(FOUND)GOTO 83 END DO
IF(.NOT.FOUND) STOP 'SANN PULS SAKNAS 1'
83 CONTINUE
CALL CTIME(TT(I),JHOUR,JMIN,JSEC,JMSEC) WRITE(IO,84) CNV(TU(I)),JMIN,JSEC,JMSEC
84 FORMAT(
+ ' REG. SLANG ',A,2X,12.2':'12.2':'I3.3,' SANN PULS CALL CTIME(TT(IDX(1)),JHOUR,JMIN,JSEC,JMSEC)
WRITE(IO,85) CNV(TU(IDX(1))),JMIN,JSEC,JMSEC
85 FORMAT(
+ ' REG. SLANG ',A,2X,I2.2':'12.2':'I3.3,' SKIPPAD STUDSPULS END IF
CALL SKIPREG(1) END IF
IF(ACCEPTED PASSAGE) THEN
. IMPOSSIBLE=(BJTEST(SEQ,1).EQ.BJTEST(SEQ,NORAB)) + .OR. .N0T. EQUALN .OR .NORAB.LT.4
IF(IMPOSSIBLE) THEN CALL SKIPREG(O) ACCEPTED PASSAGE=.FALSE. WHY=WHY+10000 NORABMAX=NORAB-1 END IF END IF IWHY=O IF(NORABMAX .LT. 4) THEN
ERROR=N.LT.4 .OR. N.GT.LEVEL .OR. + .NOT.EQUALN .OR. .NOT.FIRSTTRY
IF(.NOT.ERROR) THEN
C KASTA om ORDNINGEN PÅ PULSERNA om MÖJLIGT CALL SKIPREG(O)
CALL PERMUTE(IDX,NORAB,ERROR,TU,TT) IF(.NOT. ERROR) THEN
IF(COUNT)THEN
IF(LPUT) WRITE(IO,'(1213)') (IDX(I),I=1,NORAB)« NOMO=NOMO+1 END IF CALL SHIFT(TT,TU,IDX,NORAB) ELSE IF(COUNT)THEN IF(LPUT)
+ WRITE(IO,'(" OMÖJLIG "12.2" REG. PASSAGE z")')No NOME=NOME+1
END IF NORABMAX=NORAB IWHY=1 END IF IF(ERROR) THEN JST=l IF(TAILSKIPPING) JST=MAXNORAB DO JS=1,JST
C EN PULS MÅSTE SKIPPAS KAN EJ INGÅ I NÅGON "PASSAGE" 1 CALL SKIPREG(1) TUBEåTU(JS) TIME=TT(JS) NOS=NOS+1 ACCEPTED PASSAGE=.FALSE. IF(COUNT)RESTS(TUBE)=RESTS(TUBE)+1 IF(COUNT)SRESTS(TUBE)=SRESTS(TUBE)+1 DIFF=TIME-RESTTIME IF(NS.EQ.10.0R.(NS.GT.O.AND.DIFF.GT.DTM)) THEN .
C RESTKODSREGISTRET MÅSTE TÖMMAS
90 100 CALL CTIME(RESTTIME,HOUR,MIN,SEC,MSEC) IF(DFUT)THEN IF(FIRSTREG)PREVTIME=RESTTIME IF(FIRSTREG)FIRSTREG=.FALSE. OK=RESTTIME-PREVTIME .LT. 7200000. IF(.NOT.OK)THEN WRITE(IOS,'(F15.0,2X,F15.0)')PREVTIME,RESTTIME WRITE(IOS,'(" TIDHOPP! SKIPPAD RESTPASSAGE")')
NSKIPPBNSKIPP+1 ^
END IF
PREVTIME=RESTTIME END IF
IF(DFUT .AND. OK)
WRITE(IO,90)RESTCODE(1),HOUR,MIN,SEC,MSEC, NS/2,RESTCODE . FORMAT('2',Il,312.2,I3.3'999 O0.0',I2,1X,lOIl' 999999') IF(COUNT)THEN IF(LPUT) WRITE(IO,100) 0,0,HOUR,MIN,SEC,MSEC,-l,ZER0,0, (CNV(RESTCODE(I)),I=l,10) FORMAT(16,13,2X,IZ.2':'12.2':'IZ.2':'I3.3, 8X,IS,F7.1,I4,5X,10A2) RESTP=RESTP+1 SRESTP=SRESTP+1 END IF DO IS=1,NS RESTCODE(IS)=O END DO NS=0 END IF . CALL CTIME(TIME,HOUR,MIN,SEC,MSEC) NS=NS+1
IF(NS .EQ. 1) RESTTIME=TIME RESTCODE(NS)=TUBE
MARK='A'
IF(TUBE .EQ. B) MARK='B' IF(LPUT)
+ WRITE(IO,110) MARK,MIN,SEC,MSEC,JS
110 FORMAT(' REG. SLANG',A3,1X,IZ.2':'IZ.2':'I3.3
+ ' SKIPPAD ',I5) END IF END DO IWHY=IWHY+10 SKIPPED=.TRUE. NORABMAX=18 END IF END IF FIRST=.FALSE.* FIRSTTRY=.FALSE. WRITE(6,*)'WHY=',WHY,' IWHY=',IWHY ** HÅRD KRAV PÅ FRITT FORDON ** , END D0
*********** .NOT.(ACCEPTED PASSAGE .OR. EOF)*********
O
O
O
O
C "PASSAGEN" BEFUNNEN RIMLIG C
IF(STUDSPASSAGE .AND. COUNT) SUMBOKOD=SUMBOKOD+1
c TÖM Ev RESTKODER
IF(NS .NE. 0) THEN
-CALL CTIME(RESTTIME,H0UR,NIN,SEC,MSEC) IF(DFUT)THEN IF(FIRSTREG)PREVTIME=RESTTIME IF(FIRSTREG)FIRSTREG=.FALSE. OK=RESTTIME-PREVTIME .LT. 7200000. IF(.NOT.0K)THEN WRITE(IOS,'(F15.0,2X,F15.0)')PREVTIME,RESTTIME WRITE(IOS,'(" TIDHOPP! SKIPPAD RESTPASSAGE")') NSKIPP=NSKIPP+1
END IF
PREVTIME=RESTTIME END IF
IF(DFUT .AND. OK)
+ WRITE(IO,90)RESTCODE(1),HOUR,MIN,SEC,MSEC,NS/2,RESTCODE IF(COUNT .OR. EMPTY)THEN
IF(LPUT) + WRITE(IO,100) 0,0,HOUR,MIN,SEC,MSEC,-1,ZER0,0, + (CNV(RESTCODE(I)),I=l,10) RESTP=RESTP+1 SRESTP=SRESTP+1 END IF DO Is=1,Ns RESTCODE(IS)=O END DO Ns=0 END IF
+ CALL GETCODE(SAB,N,IKOD) CALL CODETOC(IKOD,CKOD) NOPT=NOPT+1 VAKM=VAVER*3600. CALL CTIME(FIRSTTIME,HOUR,MIN,SEC,MSEC) IF(DFUT)THEN IF(FIRSTREG)PREVTIME=FIRSTTIME IF(FIRSTREG)FIRSTREG=.FALSE. OK=FIRSTTIME-PREVTIME .LT. 7200000. IF(.NOT.OK)THEN WRITE(IOS,'(F15.0,2X,F15.0)')PREVTIME,FIRSTTIME WRITE(IOS,'(" TIDHOPP! SKIPPAD PASSAGE")') END IF
PREVTIME=FIRSTTIME END IF
IF(DFUT .AND. OK)
WRITE(IO,130,ERR=99) FIRSTTUBE,HOUR,MIN,SEC,MSEC,CKOD, VAKM,N,(SAB(ID),ID=l,N-1)
FORMAT('l',Il,3(IZ.2),I3.3,A3,F5.l,IZ,lOF4.2) GOTO 101
c OM AXELAVSTÅND > 9.9949 ÄNDRA TILL 9.99 130 99 104 101 + + + 120 DO IJKL=1,N-l _ IF($AB(IJKL) .GT. 9.9949)THEN AXAVST=SAB(IJKL) SAB(IJKL)=9.99 WRITE(IO§,104) AXAVST,SAB(IJKL),CKOD
FORMAT(' ANDRING AXELAVSTÅND:',F10.6,' ==> 'F10.6' KOD 'END IF
END DO
CONTINUE
IF(CRUISE) WRITE(5,'(I10,F7.2,I3,10F7.3)') FIRSTTIME,VAV,N,(SAB(ID),ID=1,N-l)
IF(COUNT .OR. EMPTY)THEN
IF(COUNT)THEN ' IF(LPUT) WRITE(10,120)NOPT,FIRSTTUBE,HOUR,MIN,SEC,MSEC,CKOD,VAKM, N,(SAB(ID),ID=1,N-l) FORMAT(16,13,2X,IZ.2':'12.2':'12.2':'13.3,8X,A5,F7.1,I4,10F6 SUM(FIRSTTUBE,IKOD)=SUM(FIRSTTUBE,IKOD)+1 GODP(FIRSTTUBE)=GODP(FIRSTTUBE)+1 TVAVER(FIRSTTUBE)=TVAVER(FIRSTTUBE)+VAKM NO(FIRSTTUBE,1,1)=NO(FIRSTTUBE,1,1)+N NO(FIRSTTUBE,2,1)=NO(FIRSTTUBE,2,1)+N NO(FIRSTTUBE,1,2)=NO(FIRSTTUBE,1,2)+1 NO(FIRSTTUBE,2,2)=NO(FIRSTTUBE,2,2)+1 NOP=NOP+(N*2) END IF C** EV TÖMN. AV SNABBSTAT. + DO WHILE(FIRSTTIME-PRTIME(PERIOD).GE.PRFREQ.AND.COUNT.OR.EMPTY) NP=NP+1 PRTIME(PERIOD)=PRTIME(PERIOD)+PRFREQ TP=PRTIME(PERIOD)
145 C************ .4. IF(EMPTY)TP=FIRSTTIME CALL CTIME(TP,HOUR,MIN,SEC,MSEC) IF(CTUT) THEN VM1=0.0 VM2=0.0 IF(GODP(1) .NE.O)VM1=TVAVER(1)/GODP(1) IF(GODP(2).NE.0)VM2=TVAVER(2)/GODP(2) WRITE(IOS,145) HOUR,MIN,GODP(1),GODP(2),NO(1,1,1), NO(2,1,1),VMl,VM2,RESTS(l),RESTS(2),RESTP FORMAT(1X,IZ.2':'IZ.2,2I8,ZX,2I7,2X,2F7.1,216,6X,IS) END IF NO(1,1,1 NO(2,1, NO(l,l NO(2,1
(
(
O O O O RESTS RESTS RESTP . TVAVER 1 TVAVER(2 GODP(1)=GODP(2)=0.0
IF(EMPTY)EMPTY=.FALSE. END DO END'IF CALL SKIPREG(NORAB) END IF END D0 O O I I ll II II 1 2 2 ) ) C O 1 2 0(
0 O O. O. O .NOT. ***********k*********************i:IF(COUNT .OR. EMPTY) THEN IF(CTUT) THEN VM1=0.0 VM2=0.0 IF(GODP(1).NE.0) VMl-TVAVER(1)/GODP(1) IF(GODP(2).NE.O) VM2=TVAVER(2)/GODP(2) WRITE(IOS,145) HOUR,MIN,GODP(1),GODP(2),NO(1,1,1), .NO(2,l,l),VM1,VM2,RESTS(1),RESTS(2),RESTP END IF END IF C** SKRIV SUMMOR ** 146 147
+ WRITE(IOS,146) NO(1,2,2),NO(2,2,2),NO(1,2,1),NO(2,2,1),SRESTS,SRESTP
FORMAT(/1X,'SUMMA',218,2X,217,2(6X,'-'),2X,2I6,6X,I5) SPAS=NO(1,2,2)+NO(2,2,2) SAXL=NO(1,2,1)+NO(2,2,1) SRESTREG=SRESTS(l)+SRESTS(2) WRITE(IOS,147) SPAS,SAXL,SRESTREG,SRESTP FORMAT(/1X,'TOTAL',6X,T7,9X,I8,2X,2(6X,'-'),5X,16,9X,15///) WRITE(IOS,'(2X," ***STATISTIK***"/)') DATA AXGROUP/4,ll,21,31,4l,52/ L=l
160 170 150 +-++ DO K=l,73 IF((SUM(1,K)+SUM(2,K)) .NE. IF(K .GT. AXGROUP(L))THEN WRITE(IOS,*) L=L+1 END IF CALL CODETOC(K,CKOD) WRITE(IOS,160) CKOD,SUM(1,K),SUM(2,K),SUM(1,K)+SUM(2,K) FORMAT(1X,A3,316) SSl=SSl+SUM(1,K) SSZ=SSZ+SUM(2,K) O)THEN END IF END DO WRITE(IOS,170) SSl,SSZ,SSl+SSZ FORMAT(/' 5:A'3I6) WRITE(IOS,150) NOMO,NOME,SUMBO,SUMBOKOD,NSKIPP FORMAT(/' TOLKADE RESTPASSAGER ',2I6/,
' ANTAL STUDS ',IÖ/,
' TOLKADE PASSAGER MED STUDS ',IÖ/, ' SKIPPADE PASSAGER PGA TIDHOPP ',16) CLOSE(IO)
IF(LPSNABB)THEN CLOSE(IOS)
CALL LIBSSPAWN ('PRIN/QUE=VTI/FORM=VTI/DEL SNABBSTATISTIK.LIS END IF
IF(LPUT)THEN
CALL LIBSSPAWN ('PRIN/QUE=VTI/FORM=VTI/DEL VTI PRINT.LIS')
END IF END C*************************************'k************************ Citak***********************************1k************************ CA CA CAlO ll SUBROUTINE GETREG(TIME,TUBE,EOF) IMPLICIT INTEGER (A-Z)
PARAMETER (CAP=20)
INTEGER*4 TUTAB(CAP),IDX(*),TU(*),TUT REAL*8 TITAB(CAP),TIME,TT(*)
LOGICAL EOF
DATA IN,OUT,FIRST/3*l/
IF(CONT .EQ. 0) THEN
READ(2,*,END=10) TITAB(IN),TUTAB(IN) GOTO 11 EOF=.TRUE. CONTINUE CALL GETSCAN(TITAB(IN),TUTAB(IN),EOF) IN=JMOD(IN,CAP)+1 CONT=CONT+1 END IF TIME=TITAB(OUT) TUBE=TUTAB(OUT) OUT=JMOD(OUT,CAP)+1 CONT=CONT-l RETURN
ENTRY SKIPREG(N) C** SKIPPA REG ** OUT=JMOD(FIRST+N-1,CAP)+1 FIRST=JMOD(FIRST+N-1,CAP)+1 CONT=IN-FIRST IF(CONT .LT. O) CONT=CONT+CAP RETURN
ENTRY SHIFT(TT,TU,IDX,NORAB)
C** SKIFTAR FYSISKT **
DO I=1,NORAB
IF=IDX(I) IT=I+OUT-lIF(IT .GT. CAP) IT=IT-CAP
15 FORMAT(1X,ZI4,2I9) TITAB(IT)=TT(IF) TUTAB(IT)=TU(IF) END DO END c*********************************************** SUBROUTINE GETSCAN(TIME,TUBE,EOF)
C NOPS => ANTAL BYTES PER SCANNING PARAMETER (NOPS=5) INTEGER*4 SCAN(NOPS),TUBE,PSCAN(NOPS),H59,H24,H90,H99 REAL*8 TIME,XTIME,PTIME,ADD LOGICAL EOF,ERR,MIDNIGHT CHARACTER FETIK(250)*1 COMMON // IO,IOS DATA ADD/0.0/,H59/89/,H24/36/,H90/l44/,H99/153/ EOF=.FALSE. ERR=.TRUE. TUBE=O NERR=O DO I=1,NOPS ll -SCAN(I)=INCH(2) IF(SCAN(I).EQ.255)THEN z FÄLTETIKETT CALL GET_FAELTETIK(2,FETIK) GOTO 11 END IF END D0
DO WHILE((TUBE .EQ. O .OR. ERR) .AND. .NOT. EOF) TUBE=SCAN(l)/64
EOF=SCAN(1).LT.O .OR. SCAN(2).LT.O .OR.
+ SCAN(3).LT.O .OR. SCAN(4).LT.O .OR. SCAN(5).LT.O SC1=JIAND(SCAN(1),63)
ERR=TUBE .LT. I .OR. TUBE .GT. 2 ERR=ERR .OR. SCl .GT. H24
ERR=ERR .OR. SCAN(2).GT.H59 .OR. SCAN(3).GT.H59 ERR=ERR .OR. SCAN(4).GT.H99 .OR. SCAN(5).GT.H90. NERR=NERR+1
12 DO I=1,NOPS-l SCAN(I)=SCAN(I+1) END DO SCAN(NOPS)=INCH(2) IF(SCAN(I).EQ.255)THEN I FÄLTETIKETT CALL GET_FAELTETIK(2,FETIK) GOTO 12 END IF END IF END DO
IF(.NOT. EOF) THEN
SCAN(1)=JIAND(SCAN(1),63) D0 K=1,5 L=SCAN(K)/16 SCAN(K)=L*10+(SCAN(K)-L*16) END DO WRITE(IOS,*)'SCAN=',SCAN
IF(NERR .NE. l) WRITE(IOS,10) NERR-1,PSCAN,SCAN FORMAT(15' OKTETTER SKIPPADE'514'-'SI4)
TUBE=l/TUBE+1 TIME=ADD+(SCAN11)*3600.+SCAN(2)*60.+SCAN(3))*1000. MSEC=SCAN(4)*10.0+SCAN(5)/10 XTIME=TIME+MSEC TIME=TIME+MSEC WRITE(IOS,*)'TIME=',TIME IF(TIME .LT. PTIME) THEN
MIDNIGHT=PSCAN(1).GT.22 .AND. SCAN(1).LT.1 IF(MIDNIGHT)THEN
ADD=ADD+24.0*3600.*1000.
TIME=ADD+TIME ELSE
WRITE(IOS,*) ' NEGATIV TIDLUCKA'
WRITE(IOS,'(A,5I4,F12.0)') ' PSCAN',PSCAN,PTIME WRITE(IOS,'(A,514,F12.0)') ' SCAN',SCAN,TIME END IF END IF DO K=1,5 PSCAN(K)=SCAN(K) END DO PTIME=XTIME END*IF END C*********************************************** SUBROUTINE CTIME(XTIME,HOUR,MIN,SEC,MSEC) INTEGER*4 HOUR,SEC REAL*8 TIME,XTIME TIME=XTIME HOUR=TIME/3ÖOOOOO. TIME=TIME-HOUR*3600000. HOUR=MOD(HOUR,24) MIN=TIME/60000.
TIME=TIME-MIN*ÖOOOO .
SEC=TIME/1000 .
TIME=TIME-SEC*1000 . MSEC=TIME
10. 4 Select_Code PROGRAM SELECT CODE
C**860617
INTEGER NCODE(10)
CHARACTER FILE*35,SELCODE(10)*3,RAD*50,CODE*3,RIKTN*1,ANSW*5 CHARACTER LINE(2,80),SELRIKTN*1
LOGICAL EOF,WANTED,TERM
C** PROGRAM FÖR ATT SELEKTERA VISSA KODER C** UTFIL SAMMA FORMAT SOM DUMMYLISTA
WRITE(6,'(/" SELECT-CODE 860617 "//)') C** INFIL 3 WRITE(6,'("$INFIL: ")') READ(5,'(A)') FILE OPEN(3,FILE=FILE,STATUS='OLD') C** LÄS ETIKETT READ(3,'(24A)') (LINE(l,L),L=l,24) READ(3,'(80A)') (LINE(2,L),L=1,80) WRITE(6,'(1X,24A)') (LINE(1,L),L=1,24) WRITE(6,'(1X,80A)') (LINE(2,L),L=1,80) WRITE(6,'(/"$0K? (CR=JA): ")') READ(5,'(A)') ANSW IF(ANSW(1:1).NE.' CLOSE(3) GOTO 3 END IF C** UTFIL' ') THEN
WRITE(6,'("$UTFIL STATISTIK (CR=TERM,VTI=VTIPRINTER): READ(5,'(A)') FILE IF(FILE(1:1).EQ.' IOS=6 TERM=.TRUE. ELSE IOS=7 IF(FILE(1:3).EQ.'VTI')THEN OPEN(7,FILE='VTI_PRINT.LIS',STATUS='UNKNOWN') LPUT=.TRUE. ELSE OPEN(7,FILE=FILE,STATUS='NEW') END IF WRITE(IOS,'(1X,24A)') WRITE(IOS,'(1X,7OA/)') ')THEN (LINE(1,L),L=1,24) (LINE(2,L),L=1,70) END IF * C RIKTNING 4 WRITE(6,'("$ANGE RIKTNING (1/2/3): ")') READ(5,'(A)') SELRIKTN IF(SELRIKTN(1:1).EQ.'1'.OR.SELRIKTN(1:1).EQ.'2'.OR. + SELRIKTN(1:1).EQ.'3')THEN GOTO 5 " ELSE GOTO 4 END IF C KODER
5 WRITE(6,'("$ANTAL KODER (MAX 10): ")')
READ(5,*) N
IF(N.GT.10 .OR. N.LT.1) GOTO 5 WRITE(6,'(" ANGE KODER:")') DO I=1,N
WRITE(6,'("$>")')
READ(5,'(A)') SELCODE(I) END DO
IF(.NOT.TERM) WRITE(6,'(/"$SELECT_CODE RUNNING"/)') WRITE(6,*) C** LÄS TOMRAD+FÖRSTA FORDONET READ(3,'(A)') RAD READ(3,'(A)') RAD CODE=RAD(12:14) RIKTN=RAD(2:2) C LÄS IGENOM FILEN 300 75 100 DO WHILE(.NOT.EOF) DO I=1,N WANTED=CODE.EQ.SELCODE(I) .AND. (RIKTN.EQ.SELRIKTN.OR.SELRIKTN.EQ.'3') IF(WANTED)THEN NCODE(I)=NCODE(I)+1 NTOT=NTOT+1 NAX=ICHAR(RAD(21:21))-48 L=4*(NAX-1) WRITE(IOS,300) RAD(2:2),RAD(3:4),RAD(5:6),RAD(7:8), RAD(9:11),RAD(12:14),RAD(15:19),RAD(20:21), (RAD(K:K),K=22,22+L) ° FORMAT(5X,A1,2X,A2':'AZ':'AZ':'A3,10X,A3,2X,A5, 3X,A2,2X,10(4A,2X)) END IF END D0 READ(3J'(A)',END=75) RAD CODE=RAD(12:14) RIKTN=RAD(2:2) END DO CONTINUE WRITE(IOS,100) FORMAT(/' **STATISTIK**'/, ' ' KOD ANTAL') DO I=1,N WRITE(IOS,'(1X,A3,I10)') SELCODE(I),NCODE(I) END DO
WRITE(IOS,'(" SUMMA",18)') NTOT IF(LPUT)THEN
CLOSE(IOS)
CALL LIBSSPAWN ('PRIN/QUE=VTI/FORM=VTI/DEL VTI_PRINT.LIS')
END IF END
