Ontwikkeling van het mikrosimulatiemodel FOSIM voor weefvakken en invoegingen (B)

(1)

ISSN: LVV rapport

0920-0592

mikrosimulatiennodel FOSIM

voor weefvakken en invoegingen

Bijlage: programmatekst FOSIM versie 2.0

Oktober 1993 Ir. H. Schuurman / ir. R.G.M.M. Vermijs

1 \

••r

R a p p CT VK

9 3 - 3 0

m^

T U Delft

Technische Universiteit Delft

F a c u l t e i t d e r C i v i e l e T e c h n i e k Vakgroep Infrastructuur

Sectie Verkeerskunde

Rijkswaterstaat

(2)

i

Document vakgroq) INFRASTRUCTUUR

Technische Universiteit Delft

1. Rapportnummer

VK 2205.307b

Tfectwwsche Universitett OeTft 2. ISSN-nummer

BRjftotheek Faculteit der Civiele Te< hnJek

(B«5oekadres Stevinweg 1) LW-Rapport

Postbus 5048 0920-0592

imr GA iJt-LH—

3. Titel rappott

Ontwikkeling van het mikrosimulatiemodel FOSIM

voor weefvakken en invoegingen

bijlage: programmatekst FOSIM versie 2.0

4. Thema

Verkeerstechniek

5. Auteur(s)

ir. H. Schuurman

ir. R.G.M.M. Vermijs

6. Ondeizoeksproject

Simulatie

verkeers-afwikkeling op ASW

7. Uitvoerend instituut

Technische Universiteit Delft

Faculteit der Civiele Techniek

Vakgroep Infrastructuur

Postbus 5048, 2600 GA Delft

VK

8. Categorie T^)port

Valqjublicatie

9. OpdrachtgevCT

Rijkwaterstaat, Adviesdienst Verkeer en Vervoer

10. Datum publicatie

oktober 1993

11. Samenvatting nq)port

In opdracht van de Adviesdienst Verkeer en Vervoer van Rijkswaterstaat heeft

het Laboratorium voor Verkeerskunde van de Technische Universiteit Delft het

microscopisch simulatiemodel FOSIM (verder) ontwikkeld. In dit rapport wordt

de ontwikkeling van FOSIM versie 2.0 beschreven.

De ontwikkeling heeft betrekking op:

1. het valideren van FOSIM voor weefvakken (type 2 + 1 en 3 + 1) en invoegingen

2. het grafisch weergeven van het verkeersproces

3. het gebruikersvriendelijk maken van de invoer en uitvoer

De ontwikkeling genoemd onder punt 2 en 3 is met succes uitgevoerd. Voor de

validatie van FOSIM voor weefvakken en invoegingen zijn diverse metingen

verricht.

Gekonkludeerd kan worden dat FOSIM valide is voor weefvakken type 2 + 1 . Voor

intensiteiten lager dan de kapaciteit is FOSIM gevalideerd voor weefvakken

type 3 + 1 en invoegingen.

12. Externe contacten

RWS/AVV

13. Aantal blz.

116 14. Prijs

f 5 5 ,

-(incl. alle kosten)

3 0 ^ ^ / iZl

(3)

©echo off

rem * START.BAT *

rem * * rem * * rem * BATCHFILE VOOR BESTURING FOSIM *

rem * * rem * ir.R.Vermijs L W , T.U. Delft *

rem ********************************** cis rem rem *** INTRODUKTIESCHERM *** intro rem rem *** HOOFDMENU *** :hmenu hmenu rem

rem *** VOER MENU-OPDRACHT UIT *** if not exist aktiel.bat goto end call aktiel

if not exist aktie2.bat goto hmenu call aktie2

del aktie2.bat goto hmenu rem

rem *** EINDE PROGRAMMA *** :end einde cis $debug C C *** INTRO.FOR *** C *** INTRODUKTIESCHERM VOOR FOSIM ***

C call gmod24 call ergr24(1) call wrtm24(1) C C F call cirq24(235,195,5,10,14) call cirq24(245,185,5,7,14) call cirq24(245,155,5,5,14) call cirq24(245,155,15,5,14) call cirq24(255,155,5,10,14) call bgnp24(230,155) call line24(230,195,14) . . call bgnp24(240,195) call line24(240,190,14) call line24(245,190,14) call bgnp24(245,180) call line24(240,180,14) call line24(240,155,14) C

C o

call circ24(275,185,5,14) call circ24(275,185,15,14) C C S call cirq24(305,195,5,8,14) call cirq24(310,180,10,8,14) call cirq24(320,190,10,7,14) call cirq24(325,175,5,7,14) call bgnp24(305,200)

(4)

call line24(320,200,14) call bgnp24(305,190) call line24(310,190,14) call bgnp24(320,180) call line24(325,180,14) call bgnp24(310,170) call line24(325,170,14) C C I call cirq24(345,195,5,10,14) call cirq24(345,175,5,5,14) call bgnp24(340,195) call line24(340,175,14) call bgnp24(350,195) call line24(350,175,14) ixx=345 iyy=150 call vlogo(ixx,iyy) C C M call cirq24(365,195,5,10,14) call cirq24(385,195,5,10,14) call cirq24(405,195,5,10,14) call cirq24(375,185,5,5,14) call cirq24(375,185,15,2,14) call cirq24(395,185,5,5,14) call cirq24(395,185,15,1,14) call bgnp24(375,170) call line24 (395,170,14) do 10 1=0,50,10 call bgnp24(360+1,195) call line24 (360+1,185,14) 10 continue C

C TEKST ONDER 'FOSIM'

call txt824(195,220,31,' freeway operations simulation ',14) call txt824(195,240,31,' versie 2.0 oktober 1993 ',14) call txt824(195,300,31,'Laboratorium voor Verkeerskunde',2) call txt824(195,315,31,' Vakgroep Infrastruktuur ',2) call txt824(195,330,31,' Faculteit der Civiele Techniek',2) call txt824(195,345,31,' Technische Universiteit Delft ',2) call txt824(195,360,31,' Ontwikkeld in opdracht van: ',2)

call txt824(195,375,31,' Rijkswaterstaat ',2) call txt824(195,390,31,'Adviesdienst Verkeer en Vervoer',2)

C

C call txt824(183,425,34,' druk een toets om door te gaan ',12) 3 0 call keyb24(i) if (i.eq.O) go to 30 call tmod24 end C C C $debug C

C *** TEKENEN VAN LOGO *** C call circ24(ixx,iyy,10,14) call f11124(ixx,iyy,14) call circ24(ixx,iyy,9,12) call bgnp24(ixx-9,iyy) call line24(ixx+l,iyy,12) call line24(ixx-l,iyy-9,12) call line24(ixx+l,iyy-8,14) call bgnp24(ixx-1,iyy) subroutine vlogo(ixx,iyy)

(5)

call line24(ixx+l,iyy+9,12) call line24(ixx-1,iyy+8,14) return end $debug C Q ********************************** C * HMENU.FOR * C * * C * * C * HOOFDMENU *

C * T.B.V. BESTURING OPTIES FOSIM *

C * * C * ir.R.Vermijs L W , T.U.Delft * Q **********************************

c

implicit character*40 (o)

common /al/ lo(10,10),opties(10,10) character*80 msg open (11,file='aktiel.bat',status='new') C C SCHERMOPMAAK call gmod24 call ergr24(16) call wrtm24(1) call vkop call txt824(280,25,9,'HOOFDMENU',10) call rect24(5,470,630,420,10) call txt824(5,50,11,'menu-opties',10) C C MENU-OPTIES io=l jO=l

10 opties(1,1)='1 uitvoering simulatie' lo(l,l)=23

opties(1,2)='2 invoerbestand aanmaken/kiezen' lo(l,2)=32

opties(1,3)='3 invoerbestand wijzigen' lo(l,3)=25

opties(1,4)='4 uitvoer-opties' lo(l,4)=17

o p t i e s ( 1 , 5 ) = ' 5 p l a a t s van de bestemden' l o ( l , 5 ) = 2 6

opties(1,6)='terug naar DOS' lo(l,6)=14

call menu (100,50,0,50,l,6,6,io,in,jo,jn,12) go to (100,200,300,400,500,600) jn C C UITVOERING OPTIES 100 write (11,'(''mimosa'')') close (11) go to 700 C 200 open (10,file='naam.fos') read (10,'(a)') opad call Itekst(opad,op,1) if (l.gt.3.and.op(l:l).eq.'\') then op(l:l)=' ' 1=1-1 end if write (11,210) op

(6)

210 format ('dir ',a,' | find "DAT" /c > dirlist.1st') write (11,220) op

220 format ('dir ',a,' | find "DAT" >> dirlist.1st') write (11,'(''kiesfile'')')

close (11)

o='lezen directory met invoerbestanden...' call txt824(100,240,38,0,14) go to 700 C 300 write (11,' (''in'')') write (11,'(''bewaar'')') close (11) go to 700 C 400 open (10,file='naam.fos') read (10,'(a)') opadh read (10,' (a)') opad call Itekst(opad,op,1) if (l.gt.3.and.op(l:l).eq.'\') then op(l:l)=' ' 1=1-1 end if write (11,410) op

410 format ('dir ',a,' | find "OUT" /c > dirlist.1st') write (11,420) op

420 format ('dir ',a,' | find "OUT" >> dirlist.1st') write (11,'(''uit'')')

close (11)

o='lezen directory met uitvoerbestanden...' call txt824(100,240,39,0,14) go to 700 C 500 write (11, ' (''kiespad'')') close (11) go to 700 C 600 close (11,status='delete') call veind C 700 end $debug C Q *********************************** C * KIESPAD.FOR * C * * C * * C * KIEZEN VAN HET PAD NAAR DE *

C * AANGESLOTEN IN- EN UITVOER- * C * BESTANDEN VAN FOSIM *

C * *

C * ir. R.Vermijs L W , T.U.Delft *

Q ***********************************

c

implicit character*40 (o) C

common /al/ lo(5,20),opties(5,20) C

C SCHERMOPMAAK call ergr24(16)

call wrtm24(1) cal1 vkop

call txt824(190,25,26,'5 PLAATS VAN DE BESTANDEN',10) call rect24(5,470,630,420,10)

(7)

C BEPAAL HUIDIG PAD open (11,file='naam.fos') read (11,' (a)') opadl read (11,' (a)') opad2 read (11,' (a)') onaam

call txt824(50,200,28,'de invoerbestanden stacm in:',2) call txt824(50,220,29,'de uitvoerbestanden staan in:',2) call Itekst(opadl,opl,11) call Itekst(opad2,op2,12) itel=l 10 call txt824(300,200,ll,opl,15) call txt824(300,220,12,op2,15) if (itel.eq.2) go to 20 call ok(50,250,i) if (i.eq.l) go to 30 C

C INVOEREN NIEUW PAD if (itel.eq.l) then call inpad(50,200,ll,opl) itel=2 go to 10 end if 20 call inpad(50,220,12,op2) itel=l go to 10 C C PAD BEWAREN 30 rewind (11)

write (11,'(a)') opl write (11,'(a)') op2 write (11,'(a)') onaam close (11) end C C C subroutine inpad(ixx,iyy,1,op) $debug C

C *** OPGEVEN VAN EEN PAD NAAR DATABESTANDEN *** C

call txt824(ixx,250,34,'geef nieuw pad op en druk op Enter',14) 10 call wrtm24(0) call txt824(ixx+250,iyy,l,op,15) call wrtm24(1) 2 0 call keyb24(j) if (j.eq.O) go to 20 if (j.eq.l3) then

call txt824(ixx,250,34,'geef nieuw pad op en druk op Enter',16) if (op(l:l).ne.'\') then 1=1+1 Op(l:l)='\' end if go to 40 end if if (j.eq.8) then call wrtm24(2) . ' call txt824(ixx+250,iyy,l,op,15) call wrtra24(1) op(l:l)=' ' if (I.eq.l) go to 10 1=1-1 go to 10 end if

(8)

if (j.eq.32) go to 10 if (op(l:l).eq.' ') go to 30 1 = 1+1 30 op(l:l)=char(j) go to 10 4 0 return end $debug C Q *********************************** C * KIESFILE.FOR * C * *

c * *

C * KIEZEN VAN HET AANGESLOTEN * C * INVOERBESTAND VAN FOSIM *

C * * C * ir. R.Vermijs L W , T.U.Delft *

Q ***********************************

c

implicit character*40 (o)

C LEZEN NAAM AANGESLOTEN INVOERBESTAND open (11,file='naam.fos')

read (11,'(a)') opad read (11, ' (a) ') odum read (11,'(a)') onaam call Itekst(opad,op,11) C C SCHERMOPMAAK EN KEUZEMENU call ergr24(16) call wrtm24(1) call vkop

call txt824(190,25,32,'2 INVOERBESTAND AANMAKEN/KIEZEN',10) call rect24 (5,470,630,420,10)

io=l jo=l

opties (1,1)='1 nieuw invoerbestand aanmaken' lo(l,l)=31

opties (1,2)='2 bestaand invoerbestand kiezen' lo(l,2)=32

call menu(100,50,0,50,1,2,2,io,in,jo,jn,12) go to (100,200) jn

C

C NIEUW INVOERBESTAND MAKEN C

100 ol='de naam van het nieuwe invoerbestémd is:' o2='geef een nieuwe naam op en druk op Enter' call txt824(50,100,40,01,2) call txt824(50,140,40,02,14) onaam=' ' 1=1 110 call itekst(400,100,1,onaam,15) if (onaam.eq.' ') go to 110 call txt824(50,100,40,01,16) call txt824(50,140,40,02,16) open (12,file='aktie2.bat',status='new')

write (12,'(''copy fosim.dat invoer.fos >nul'')') opad(11+1:)=onaam

write (12,120) opad

120 format ('copy fosim.dat ',a,' >nul')

close (12) •. go to 300

(9)

c

C BESTAAND INVOERBESTAND KIEZEN C

200 call txt824(5,50,8,'inhoud ',10) call txt824(60,50,ll,opad,10)

call txt824(50,100,33,'het aangesloten invoerbestand is:',2) call txt824(330,100,12,onaam,15)

C

C KIEZEN UIT INHOUD AANGESLOTEN DIRECTORY open (10,file='dirlist.lst')

read (10,*) nm if (nm.eq.O) then

call txt824(50,140,29,'geen invoerbestanden gevonden',14) call txt824(50,160,14,'druk een toets',14)

210 call keyb24(i) if (i.eq.O) go to 210 go to 300 end if n=l m=0 do 220 k=l,nm m=m+l read (10,'(a)') ol call Itekst(ol,o2,l)

write (o2 (1+1:) , ' (a)') '.DAT' opties(n,m)=o2 lo(n,m)=12 if (m.eq.20) then n=n+l m=0 end if 220 continue if (n.gt.l) m=20 io=l jo=l 230 call menu(O,150,100,20,n,m,nm,io,in,jo,jn,2) onaam=opties(in,jn) call txt824(330,100,12,onaam,15) call ok(50,150,i) if (i.eq.O) go to 230 C C KOPIEREN INVOERBESTAND open (12,file='aktie2.bat',status='new') opad(ll+l:)=onaam write (12,24 0) opad

240 format ('copy ',a,' invoer.fos >nul') close (12)

C

C VASTLEGGEN NAAM INVOERBESTAND C

300 backspace (11)

write (11,'(a)') onaam close (11)

(10)

$debug C C C C C C C C C C C C C C C C 11 20 10 30 ********************************** * UIT.FOR * * * * * * WEERGEVEN VAN RESULTATEN *

* VAN FOSIM *

* * * ir.R.Vermijs L W , T.U.Delft *

********************************** implicit character*40 (o)

common /aO/ lengte,nstr

common /al/ lo(10,20),opties(10,20) common /a2/ nfsg,kfsg(20)

common /a3/ itype(8,20) common /a4/ ivs(8,20,2) common /a5/ sond(8,20) common /a6/ nssg,kssg(20) common /a7/ igs(8,20,2) common /a8/ ndet,kdet(20)

common /a9/ itsw,tra,trd,nperc,vda,vdb,zl,z2,z3 common /alO/ nvtype,e(8,8)

common /all/ irand,ts,nt5im

common /al2/ nlijst,lijst(50),ninfo,info(50) common /al3/ nq(8),itq(8,50),iq(8,50)

common /al4/ distr(8,8),hb(8,8)

common /al5/ nvoed,kvoed(2,8),nbest,kbest(2,8) character*2 cdum INSTELLING STARTWAARDEN dimension ii (10),is(10) do 10 i=l,8 do 11 j=l,8 e(i,j)=0 distr(i,j)=0 hb(i, j)=0 continue do 20 j=l,20 itype(i,j)=3 ivs(i,j,1)=1 ivs(i,j,2)=8 sond(i,j)=1 igs(i,j,l)=l igs(i,j,2)=8 continue continue

LEZEN VAN INVOERGEGEVENS open (10,file='invoer.fos') read (10,*) lengte,nstr read (10,*) nfsg,(kfsg(i) read (10,*) ((itype(i,j), do 30 j=l,nfsg+l ,i=l,nfsg) i=l,nstr),j=l,nfsg+l) :l,nstr) =l,nstr) read (10,*) (ivs(i,j,l) read (10,*) (ivs(i,j,2) continue read (10,*) ((sond(i,j),i read (10,*) nssg,(kssg(i) do 40 j=l,nssg+l read (10,*) (igs(i,j,1),i=l,nstr) read (10,*) (igs(i,j,2),i=l,nstr) l.nstr),j=l,nfsg+l) i=l,nssg)

(11)

4 0 continue read (10,*) ndet,(kdet(i),i=l,ndet) read (10,*) itsw,tra,trd,nperc,vda,vdb,zl,z2,z3,nvtype read (10,*) ((e(i,j),i = l,8),j=l,8) read (10,*) irand,ts,ntsim read (10,*) nlijst,(lijst(i),i=l,nlijst) read (10,*) ninfo,(info(i),i=l,ninfo) do 50 i=l,nstr read (10,*) nq(i),(itq(i,j),j=l,nq(i)) read (10,*) (iq(i,j),j=l,nq(i)) 50 continue read (10,*) ((distr(i,j),j=l,nvtype),i=l,nstr) read (10,*) ((hb(i,j),j=l,nstr),i=l,nstr) close (10) C

C STARTEN GRAFISCHE MODE EN SCHERMOPMAAK opad='kompakt.out' io=l jo=l call gmod24 1 call ergr24(16) call wrtm24(1) call vkop call txt824(250,25,17,'4 UITVOER-OPTIES',10) call rect24(5,470,630,420,10) call txt824(5,50,11,'menu-opties',10) C C OVERZICHTSMENU opties(1,1)='1 basisdiagrammen' lo(l,l)=18 opties(1,2)='2 strookwisselen' lo(l,2)=17

opties(1,3)='3 uitvoerbestand kiezen' lo(l,3)=24

opties(1,4)='terug naar hoofdmenu' lo(l,4)=20 call menu(100,50,0,50,l,4,4,io,in,jo,jn,12) go to (2,3,4,5) jn C C BASISDIAGRAMMEN 2 call basisd(opad) go to 1 C C HIAATACCEPTATIE 3 go to 1 C C UITVOERBESTAND KIEZEN 4 call kiesfile(opad) go to 1 C C EINDE PROGRAMMA 5 end C C C subroutine basisd(opad) $debug C

C *** TEKENEN VAN BASISDIAGRAMMEN *** C

(12)

c C LEZEN ÜITVOERGEGEVENS open (10,file=opad) read (10,*) nper read (10,*) ndet read (10,*) nstr C

C HUIDIGE STROOK- EN DETEKTORNUMMER idet=l

istr=l 10 call teken

otl='basisdiagrammen voor detektor nummer:' ot2=' op strook nummer:' call txt824(50,250,37,otl,2)

call txt824(50,300,37,ot2,2) write (ot3,'(i2)') idet

if (istr.le.nstr) write (ot4,'(i2)') istr call txt824(350,250,2,ot3,15)

call txt824(350,300,2,ot4,15) 20 call ok(50,350,i)

if (i.eq.l) go to 50 C

C KIEZEN ANDER DETEKTOR- EN STROOKNUMMER if (idet.gt.10) then iol=idet-10 jol=2 else iol=idet jol=l end if n=l m=l do 30 i=l,ndet

write (opties(n,m),' (i2)') i lo(n,m)=2 n=n+l if (n.gt.lO) then n=n-10 m=m+l end if 30 continue if (ndet.ge.10) n=10 call menu(325,230,25,20,n,m,ndet,iol,inl,jol,jnl,15) idet=inl+(jnl-1)*10

write (ot3,'(i2)') idet

call txt824(350,250,2,ot3,15) C

iol=istr jol=l

do 40 i=l,nstr+l

write (opties(i,1),' (i2)') i if (i.gt.nstr) opties(i,1)=' E' lo(i,l)=2

4 0 continue

call menu(325,2 80,25,20,nstr+l,l,nstr+l,iol,inl,jol,jnl,15) istr=inl

write (ot4,'(i2)') istr if (istr.gt.nstr) ot4=' E' call txt824(350,300,2,ot4,15) go to 2 0 50 call txt824(50,250,37,otl,16) call txt824(50,300,37,ot2,16) call txt824(350,250,2,ot3,16) call txt824(350,300,2,ot4,16) C

(13)

call txt824(100,210,30,'B7VSISDIAGRAMMEN VOOR DETEKTOR:',2) call txt824(345,210,2,ot3,15)

if (istr.gt.nstr) then

call txt824(380,210,21,'OP ALLE STROKEN SAMEN',2) else

call txt824(380,210,10,'OP STROOK:',2) call txt824(460,210,2,ot4,15)

end if ns=l

if (ot4.eq.' E') ns=nstr C

C TEKENEN ASSEN Q-K-DIAGRAM call txt824(100,230,11,'Q-K-diagram' ,15) call bgnp24(59,245) call line24(59,426,2) call line24(210,426,2) call txt824(10,235,5,'mvt/u',2) call txt824(175,460,6,'mvt/km',2) do 60,i=0,6 call bgnp24(59,425-1*30) call line24(55,425-1*30,2) write (o,'(i5)') i*500*ns

call txt824(10,430-1*30,5,0,2) 60 continue

do 70 1=0,150,50

call bgnp24(60+1,426) call line24(60+1,430,2) write (o,'(14)') i*ns

call txt824(40+1,445,4,0,2) 70 continue

C

C TEKENEN ASSEN U-K-DIAGRAM call txt824(300,230,11,'U-K-diagram',15) call bgnp24(259,245) call line24(259,426,2) call line24(410,426,2) call txt824(210,235,4,'km/u',2) call txt824(375,460,6,'mvt/km',2) do 80,i=0,6 call bgnp24(259,425-1*30) call line24(255,425-1*30,2) write(o,' (14)') 1*25 call txt824(215,430-1*30,4,0,2) 80 continue do 90 1=0,150,50 call bgnp24(260+1,426) call line24(260+1,430,2) write (o,'(14)') i*ns

call txt824(240+1,445,4,0,2) 90 continue

C

C TEKENEN ASSEN UQ-DIAGRAM call txt824(500,230,11,'U-Q-diagram',15) call bgnp24(459,245) call line24(459,426,2) call line24(610,426,2) call txt824(410,235,4,'km/u',2) call txt824(580,460,5,'mvt/u',2) do 100,1=0,6 call bgnp24(459,425-1*30) call line24(455,425-1*30,2) write(o,' (i4)') 1*25 call txt824(415,430-1*30,4,0,2) 100 continue do 110 1=0,3 call bgnp24(460+1*50,426)

(14)

call line24(460+1*50,430,2) write (o,'(15)') i*1000*ns call txt824(430+1*50,445,5,0,2) 110 continue

C

C TEKENEN BASISDIAGRAMMEN MET CIRKELTJES do 120 i=l,nper

read (10,' (a)',err=200) cdum do 130 j=l,idet-l

do 140 k=l,4

read (10,'(a)',err=200) cdum 140 continue

13 0 continue

read (10,*,err=200) isw read (10,*,err=200) n,koord

read (10, *, err=200) (ii(il),il=l,nstr+l) read (10,*,err=200) (is(il),il=l,nstr+l) il=istr+l if (istr.gt.nstr) il=l id=0 if (is(il).gt.O) id=ii(il)/is(il) call circ24(60+id/ns,425-ii(il)*180/(3000*ns),2,15) call circ24(260+id/ns,425-is(il)*180/150,2,15) call circ24(460+ii(il)*150/(3000*ns),425-is(il)*180/150,2,15) do 150 j=idet+l,ndet do 160 k=l,4

read (10,' (a)',err=200) cdum 160 continue

150 continue

read (10,'(a)',err=200) cdum 120 continue 200 rewind (10) call ok(10,460,1) if (i.eq.O) go to 10 close (10) return end C C C subroutine kiesfile(opad) $debug C

C *** KIEZEN VAN HET AANGESLOTEN UITVOERBESTAND *** C

C SCHERMOPMAAK call ergr24 (16)

call wrtm24(1) call vkop

call txt824(190,25,27,'3 KEUZE VAN DE UITVOERFILE',10) call rect24(5,470,630,420,10)

call txt824(5,50,8,'inhoud ',10) C

C BEPAAL NAAM AANGESLOTEN DATASET open (11,file='naam.fos')

read (11,'(a)') odum read (11,' (a)') opad call Itekst(opad,op,1) call txt824(60,50,l,op,10)

call txt824(50,100,34,'het aangesloten uitvoerbestand is:',2) C

(15)

open (10,file='dirlist.lst') read (10,*) nm

if (nm.eq.O) then

call txt824(50,140,30,'geen uitvoerbestanden gevonden',14) call txt824(50,160,14,'druk een toets',14)

5 call keyb24(i) if (i.eq.O) go to 5 opad='invoer.fos' go to 3 0 end if n=l m=0 do 10 k=l,nm m=m+l read (10,'(a)') ol call Itekst(ol,o2,11)

write (o2(11+1:),' (a) ') '.OUT' opties(n,m)=o2 lo(n,m)=12 if (m.eq.20) then n=n+l m=0 end if 10 continue if (n.gt.l) m=20 iol=l jol=l 20 call menu(0,150,100,20,n,m,nm,iol,inl,jol, jnl, 2) onaam=opties(inl,jnl) call txt824(350,100,12,onaam,15) call ok(50,150,1) if (i.eq.O) go to 20 C opad (1+1:) =onaam . ^, 30 return end C C

c

subroutine Itekst(ol,o2,1) C

C *** BEPALING VAN DE LENGTE VAN EEN STRING *** C

implicit character*40 (o) o2=' ' do 10 i=l,40 if (ol(i:i).eq.' ') then l=i-l if (l.ne.O) o2=ol(:l) go to 20 end if continue if (I.eq.O) 1=1 return end

(16)

$debug C C C C C C C C C C C C C C C C C 11 20 10 *********** *********************** IN.FOR * * WIJZIGEN VAN BESTAANDE OF *

* INVOEREN VAN NIEUWE GEGEVENS *

* IN FOSIM *

* * * ir.R.Vermijs L W , T.U.Delft *

**********************************

implicit character*4 0 (o) common /aO/ lengte,nstr

common /a3/ itype(8,20) common /a4/ ivs(8,20,2) common /a5/ sond(8,20) common /a6/ nssg,kssg(20) common /a7/ igs(8,20,2) common /a8/ ndet,kdet(20)

common /a9/ itsw,tra,trd,nperc,vda,vdb,zl,z2,z3 common /alO/ nvtype,e(8, 8)

common /all/ irand,ts,ntsim

common /al2/ nlijst,lijst(50),ninfo,info(50) common /al3/ nq(8),itq(8, 50),iq(8, 50)

common /al4/ distr(8,8),hb(8,8)

common /al5/ nvoed,kvoed(2,8),nbest,kbest(2,8) INSTELLING do 10 1=1,8 do 11 j=l,8 e(i, j)=0 distr(i,j)=0 h b d , j)=0 continue do 20 j=l,20 itype(1,j)=3 i v s d , j ,1) =1 i v s d , j,2)=8 s o n d d , j) =1 i g s d , j,l)=l i g s d , j,2)=8 continue continue STARTWAARDEN open (1O read (10 read (10 read (10 do 30 j= read ( read ( 3 0 continue read (10 read U O do 40 j read ( read ( 4 0 continue read (10

LEZEN VAN INVOERGEGEVENS ,file='invoer.fos') ,*) lengte,nstr ,*) nfsg, (kfsgd) , i=l,nf sg) ,*) ( (itype d,j),1=1,nstr),j=l,nfsg+l) l,nfsg+1 10,*) (ivsd, j,l) ,i=l,nstr) 10,*) (ivsd, j,2) ,1=1,nstr) , *) ( (sondd, j) , 1=1,nstr) , j=l,nfsg+l) ,*) nssg, (kssg(1),1 = 1,nssg) l,nssg+l 10,*) (igsd, j,l) ,i = l,nstr) 10,*) (igsd, j ,2) ,i=l,nstr) ") ndet,(kdet(i),1=1,ndet)

(17)

read (10,*) itsw,tra,trd,nperc,vda,vdb,zl,z2,z3,nvtype read (10,*) ((e(i,j),1=1,8),j=l,8) read (10,*) irand,ts,ntsim read (10,*) nlijst,(lijst(1),1=1,nlijst) read (10,*) ninfo,(info(i),1=1,ninfo) do 50 1=1,nstr

read (10,*) nq(i) , (itqd, j ) , j=l,nq(i) ) read (10,*) (iqd, j ) , j=l,nq(i) )

50 continue

read (10,*) ((distr(i,j),j=l,nvtype),i=l,nstr) read (10,*) ( (hbd, j) ,j=l,nstr) , 1=1,nstr) rewind (10)

C

C STARTEN GRAFISCHE MODE EN SCHERMOPMAAK io=l jo=l call gmod24 1 call ergr24(16) call wrtm24 d ) call vkop

call txt824(210,25,25,'3 INVOERBESTAND WIJZIGEN',10) call rect24(5,470,630,420,10) call txt824(5,50,11,'menu-opties',10) C C OVERZICHTSMENU opties(1,1)='1 wegvakkonfiguratie' lo(l,l)=21 opties(1,2)='2 voertuig-bestuurder-kombinaties' lo(l,2)=34 opties(1,3)='3 simulatie-instellingen' lo(l,3)=25 opties(1,4)='4 verkeersstromen' lo(l,4)=18

opties(1,5)='terug naar hoofdmenu' lo(l,5)=20 c a l l m e n u d O O , 5 0 , O, 5 0 , 1 , 5 , 5 , i o , i n , j o , j n , 12) go t o ( 2 , 3 , 4 , 5 , 6 ) j n

c

t, WEGVAKKONFIGURATIE

SCHERMOPMAAK EN TEKENEN SITUATIE 2 call teken MENU-OPTIES iol=l jol=l 100 opties(l,l)='l lo(l,l)=16 opties(l,2)='2 lo(l,2)=20 opties(l,3)='3 lo(l,3)=18 opties(1,4)='4 lo(l,4)=32 opties(l,5)='5 lo(l,5)=27 opties(1,6)='6 lo(l,6)=25 opties(1,7)='7 lo(l,7)=16 opties(1,8)='8 lo(l,8)=25 opties(1,9)='9 lo(l,9)=13 lengte wegvak' aantal rijstroken' fysieke sekties'

strooktype per fysieke sektie' verplicht strookwisselen' snelheidsonderdrukking' strooksekties'

gewenst strookwisselen' detektoren'

opties(1,10)='terug naar hoofdmenu' lo(l,10)=20

(18)

g o t o (110,120,130,140,150,160,170,180,190,1) jnl C C UITVOERING OPTIES 110 call optiel go to 100 120 call optie2 go to 100 130 call optie3(1) go to 100 140 call optie4 go to 100 150 call opties(1) go to 100 160 call optie6 go to 100 170 call optie3(2) go to 100 180 call optie5(2) go to 100 190 call optie3(3) go to 100 C C VOERTUIG-BESTUURDER-KOMBINATIES C SCHERMOPMAAK EN HUIDIGE VOERTUIGTYPEN

3 call tekenv C C MENU-OPTIES iol=l jol=l 200 opties(1,1)='1 strookwisseltijd' lo(l,l)=19

opties(1,2)='2 reaktietijd voor acceleratie' lo(l,2)=31

opties(1,3)='3 reaktietijd voor deceleratie' lo(l,3)=31

opties(1,4)='4 strookwisseltaktlek' lo(l,4)=22

opties(1,5)='5 snelheidsverschil taktiek 1' lo(l,5)=30

opties(1,6)='6 snelheidsverschil taktiek 2' lo(l,6)=30

opties(1,7)='7 volgfaktoren' lo(l,7)=15

opties(1,8)='8 aantal voertuigtypen' lo(l,8)=23

opties(1,9)='9 eigenschappen per type voertuig' lo(l,9)=34

opties(1,10)='terug naar hoofdmenu' lo(l,10)=20 call menu(100,40,0,40,1,10,10,iol,inl,jol,jnl,12) go to (210,220,230,240,250,260,270,280,290,1) jnl C C UITVOERING OPTIES 210 call optie7 go to 200 220 call optie8 go to 200 230 call optie9 go to 200 240 call optlO go to 200 250 call optil go to 200 260 call optl2 go to 200 270 call optl3

(19)

go to 200 280 call optl4 go to 200 290 call optlS go to 200 C C SIMULATIE-INSTELLINGEN C SCHERMOPMAAK EN SITUATIE 4 call tekens C C MENU-OPTIES iol=l jol=l

300 opties(l,l)='l startwaarde voor de randomgenerator' lo(l,l)=38

opties(1,2)='2 duur van een tijdstap' lo(l,2)=24

opties(1,3)='3 simulatieduur' lo(l,3)=16

opties(1,4)='4 tijdstippen voor een voertuiglijst' lo(l,4)=37

opties (1,5)='5 tijdstippen voor detektorinformatie' lo(l,5)=38

opties(1,6)='terug naar hoofdmenu' lo(l,6)=20 call menu(100,50,0,50,1,6,6,iol,inl,jol,jnl,12) go to (310,320,330,340,350,1) jnl C C UITVOERING MENU-OPTIES 310 call optl6 go to 3 00 320 call optl7 go to 300 330 call optl8 go to 300 340 call optl9(1) go to 300 350 call optl9(2) go to 300 C C VERKEERSSTROMEN C SCHERMOPMAAK 5 call tekver C C MENU-OPTIES iol=l jol=l 400 opties(1,1)='1 intensiteitenverloop' lo(l,l)=23 opties(1,2)='2 voertuigtype-distributie' lo(l,2)=27 opties(1,3)='3 H-B-matrix' lo(l,3)=13

opties(1,4)='terug naar hoofdmenu' lo(l,4)=20 call menu(100,5O,O,50,1,4,4,iol,inl,jol,jnl,12) go to (410,420,430,1) jnl C C UITVOERING OPTIES 410 call opt20 go to 400 420 call opt21 go to 400 430 call opt22 go to 400 C

(20)

C SCHRIJVEN VAN INVOERGEGEVENS 6 do 61 i=l,nstr

do 62 j=l,nfsg+l

if (ityped, j) .gt.lO) itype d , j) =itype (1, j )-10 62 continue 61 continue write (10,*) lengte,nstr write (10,*) nfsg,(kfsg(i),1=1,nfsg) write (10,*) ((itype(i,j),1=1,nstr),j=l,nfsg+1) do 60 j=l,nfsg+l write (10,*) (ivs(i,j,1),i=l,nstr) write (10,*) (ivs(1,j,2),i=l,nstr) 60 continue write (10,*) ((sondd, j) , 1=1,nstr) , j=l,nfsg+l) write (10,*) nssg,(kssg(i),1=1,nssg) do 70 j=l,nssg+l write (10,*) (igs(i,j,1),1=1,nstr) write (10,*) d g s d , j , 2) , i=l,nstr) 70 continue write (10,*) ndet,(kdet(i),1=1,ndet) write (10,*) itsw,tra,trd,nperc,vda,vdb,zl,z2,z3,nvtype write (10,*) ((e(i,j),1=1,8),j=l,8) write (10,*) irand,ts,ntsim write (10,*) nlijst,(lijst(1),i=l,nlijst) write (10,*) ninfo,(infod),i=l,ninfo) do 80 1=1,nstr

write (10,*) n q d ) , (itqd, j ) , j=l,nq(i) ) write (10,*) (iqd, j) , j=l,nq(i))

80 continue write (10,*) ((distr(i,j),j=l,nvtype),i=l,nstr) n=nstr write (10,*) ( (hbd, j ) , j=l,nstr) , 1=1,n) close (10) end C C C subroutine menu(mx,my,mh,mv,n,m,nm,io,in,jo,jn,kleur) $debug C

C *** BESTURING VAN EEN MENU *** C

character*8O msg C

C MENUTEKST OP SCHERM AFDRUKKEN itel=l do 10 j=l,m do 2 0 i=l,n if (itel.gt.nm) go to 25 call txt824(mx+i*mh,my+j*mv,lo(i,j),opties(1,j),kleur) itel=itel+l 20 continue 10 continue

25 msg='maak een keuze met de pijltjestoetsen en druk op Enter' call txt824(10,460,55,msg,14)

C

C KIEZEN VAN EEN MENU-OPTIE in=0

jn=0

30 call keyb24(1)

if d.ne.0.or.in.eq.O.or.jn.eq.O) then if (in.eq.0) in=io

(21)

(jn.eq.O) jn=jo (i.eq.l3) go to 40 .eq.l741.and.io.ne.n.and.(jo-1)*n+io.lt.nm) in=io+l .eq.1739.emd.io.ne.l) in=io-l .eq.l744.and.jo.ne.m.and.jo*n+io.le.nm) jn=jo+l .eq.1736.and.jo.ne.1) jn=jo-l call txt824(mx+io*mh,my+jo*mv,lo(io,jo),opties(io,jo),kleur) call wrtm24(0) call txt824(mx+in*mh,my+jn*mv,lo(in,jn),opties(in,jn),kleur) call wrtm24(1) io=in if if if if if if (i, d. (i. (i. C

c

DO=:n e n d i f go t o 30

MENU-TEKST VERWIJDEREN NA KEUZE 40 itel=l call wrtm24(2) call txt824(10,460,55,msg,14) do 50 j=l,m do 60 i=l,n if (itel.gt.nm) go to 65

call txt824(mx+i*mh,my+j*mv,lo(i,j),opties d,j),kleur) itel=itel+l 60 continue 50 continue 65 call wrtm24(1) return end C C C $debug C C C subroutine getal(i,j)

*** OMZETTEN VAN ASCI-CODE IN GETALLEN *** if if if if if if if if if if (i.eq.48) (i.eq.49) (1.eq.50) (i.eq.51) (i.eq.52) d.eq.53) d.eq.54) (i.eq.55) (i.eq.56) (i.eq.57) =0 =1 =2 =3 =4 =5 =6 =7 =8 =9 return end C C C $debug C subroutine vkop C C

*** TEKENEN VAN EEN KOPJE BOVEN AAN EEN SCHERM *** call txt824(5,25,5,'fosim',14) ixx=620 iyy=25 call vlogo(ixx,iyy) call rect24(610,35,21,20,14) call bgnp24(606,25) call line24(620,39,14) call line24(634,25,14) call line24(620,11,14)

(22)

call line24(606,25,14) return end C C C subroutine vlogo(ixx,iyy) $debug C

C *** TEKENEN VAN LOGO *** C call circ24(ixx,iyy,10,14) call f11124(ixx,iyy,14) call circ24(ixx,iyy,9,12) call bgnp24(ixx-9,iyy) call line24(ixx+l,iyy,12) call line24(ixx-1,iyy-9,12) call line24(ixx+l,iyy-8,14) call bgnp24(ixx-1,iyy) call line24(ixx+l,iyy+9,12) call line24(ixx-1,iyy+8,14) return end C C C subroutine teken $debug C

C *** TEKENEN VAN DE SCHERMOPMAAK EN DE SITUATIE *** C

common /aO/ lengte,nstr C call ergr24(16) call wrtm24(1) call vkop call rect24(5,161,630,112,10) call txt824(5,49,8,'situatie',10) call rect24(5,470,630,280,10) call txt824(5,190,14,'invoergegevens',10) call schaal call stroken call fysek call strsek call type call detekt call txt824(250,25,23,'3.1 WEGVAKKONFIGURATIE',10) return end C C C subroutine schaal $debug C

C *** TEKENEN VAN SCHAALVERDELING LANGS WEGVAK *** C

common /aO/ lengte,nstr C character*5 msgl call txt824(10,155,8,'afst. m:',2) call bgnp24(100,135) call line24(100,145,2) call txt824(80,155,5,' O ',2) ix=100 v=100

(23)

j=(lengte-l)/lOO do 10 i=l,j ixx=100+nint(ix*530.O/lengte) call bgnp24(ixx,135) if (ix/500*500.eq.ix) then call line24(ixx,145,2) if (ixx-v.ge.50) then write (msgl,' (15) ') ix call txt824(ixx-25,155,5,msgl,2) v=real(ixx) end if else call line24(ixx,140,2) end if ix=ix+100 10 continue return end C C C subroutine stroken $debug C

C *** TEKENEN VAN DE RIJSTROKEN *** C

common /aO/ lengte,nstr C character*l tekst C do 10 i=0,nstr iyy=55+i*10 if (i.ge.l) then

write (tekst,' (il)') i

call txt824(90,iyy,l,tekst,15) end if call bgnp24(100,iyy) call line24(630,iyy,15) 10 continue call bgnp24(100,55) call line24(100,55+nstr*10,15) call bgnp24(630,55) call line24(630,55+nstr*10,15) return end C C

c

subroutine fysek $debug C

C *** TEKENEN VAN DE FYSIEKE SEKTIEGRENZEN *** C

common /aO/ lengte,nstr common /a2/ nfsg,kfsg(20) C do 10 i=l,nfsg if (kfsgd).ge.lengte) go to 10 ixx=100+nint(kfsg(1)*530.O/lengte) call bgnp24(ixx,55) call line24(ixx,55+nstr*10,15) 10 continue return end C C

(24)

c

subroutine strsek $debug

C

C *** TEKENEN VAN DE STROOKSEKTIEGRENZEN *** C

common /aO/ lengte,nstr common /a6/ nssg,kssg(2 0) C do 10 i=l,nssg if (kssg(1).ge.lengte) go to 10 ixx=100+nint(kssg(i)*530.O/lengte) call bgnp24(ixx,55) call line24(ixx,55+nstr*10,7) 10 continue return end C C C subroutine type $debug C

C *** TEKENEN VAN STROOKTYPE PER FYSIEKE SEKTIE *** C

common /aO/ lengte,nstr common /a2/ nfsg,kfsg(20) common /a3/ itype(8,20)

common /al5/ nvoed,kvoed(2,8),nbest,kbest(2,8) C integer lijnen(9,20) C nvoed=0 nbest=0 do 10 i=l,9 do 20 j=l,20

if (i.lt.9.and.itype(1,j) .gt.9) itype (i,j)=itype(1,3)-10 lijnen(1,j)=1

20 continue 10 continue C

C BEPALING BELIJNING A.D.H.V. STROOKTYPEN do 30 1=1,nstr

do 40 j=nfsg+1,1,-1

if (itype (1,j) .Ie .1) then if (1+1.gt.nstr) go to 40 if (j+1.gt.nfsg+1) go to 50

if (itype (1,j+1) .eq.2.and.itype(i + l,j+l) .It.4) then lijnen(i+l,j)=3

go to 40 end if

if (j-l.lt.l) go to 50

if (itype(i,j-1) .eq.2.and.itype(i+l,j-1) .It .4) then lijnend+l, j) =3

go to 40 end if

50 lijnen(i+l,j)=2 end if

if (itype (i,j) .eq.9 .and.i.eq.l) lijnend,j)=0 if (itype(1,j).eq.9.and.i.eq.nstr) lijnen(i+l,j)=0 4 0 continue

3 0 continue C

C TEKENEN VAN STREPEN EN BLOKKEN do 60 l=l,nstr+l

(25)

iyy=55+(i-l)*10 do 70 j=nfsg,0,-1 if (ix.eq.630) go to 70 if(j.eq.O) then ixx=630 else ixx=100+nint(kfsg(j)*530.O/lengte) end if if (ixx.ge.630) ixx=630 C STREEP VERWIJDEREN if (lijnen(i,j+1).eq.O) then call bgnp24(lx,iyy) call line24(ixx,iyy,16) end if C 3-9-STREEP if (lijnend, 3+1) .eq.2) then

if (lijnend, j) .eq.2) go to 70 n= (ixx-ix) /36 do 80 m=l,n+l call bgnp24(lx,iyy) if (m.eq.n+1) then call line24(ixx-1,iyy,16) else call line24(ix+27,iyy,16) end if ix=ix+36 80 continue end if C 1-3-BLOKKEN if (lijnend, j+1) .eq.3) then

if (lijnend, j) .eq.3) go to 70 n=(ixx-ix)/12 do 90 m=l,n+l call bgnp24(ix,iyy) ^' if (m.eq.n+1) then •.'\ call line24(ixx-1,iyy,16) else call line24(ix+9,iyy,16) end if ix=ix+12 90 continue end if C 100 ix=ixx 70 continue 60 continue C

C TEKENEN VAN OVERIGE WEGMARKERINGEN do 110 1=1,nstr ix=101 iyy=55+i*10 ipijl=0 ibest=0 do 120 j=nfsg,O,-1 if (ix.eq.630) go to 120 if (j.eq.O) then ixx=630 else ixx=100+nint(kfsg(j)*530.O/lengte) end if if (ixx.ge.630) ixx=630 C SERGEANTSTREPEN LINKS if (itype(i,j+1).eq.4) then

if (itype (i,j) .eq.4) go to 120 call shal24(ix,iyy,ixx-ix,10,15) end if

(26)

C SERGEANTSTREPEN RECHTS if (itype(1,j+1).eq.5) then

if (itype (i,j) .eq.5) go to 120 call shar24(ix,iyy,ixx-ix,10,15) end if

C AFGEZETTE STROOK if (itype(i,j+1).eq.6) then

if (itype (i,j) .eq.6) go to 120 call blkf24(ix,iyy,ixx-ix,10,15) end if

C RICHTINGPIJL PER VOEDINGSPUNT if (j.It.nfsg) then if (itype(1,j+2).ne.9) go to 130 end if if (itype(i,j+1).le.3.and.ipijl.eq.0) then call bgnp24(ix,iyy-5) call line24(ix+20,iyy-5,15) call line24(ix+16,iyy-7,15) call line24dx+l6,iyy-3,15) call line24(ix+20,iyy-5,15) itype(1,j+1)=itype(1,3+1)+10 ipijl=l nvoed=nvoed+l kvoed(1,nvoed)=ix kvoed(2,nvoed)=iyy end if C BESTEMMINGSPUNTEN 13 0 ihulp=itype(1,j+1) if (ihulp.ge.lO) ihulp=ihulp-10 if (ihulp.le.3.and.ibest.eq.O) then if (j.eq.O.or.itype(1,j).eq.9) then ibest=l nbest=nbest+l kbest(l,nbest)=ixx-lO kbest(2,nbest)=iyy end if end if C ix=ixx 120 continue 110 continue 140 return end C C C subroutine detekt $debug C

C *** TEKENEN VAN DE DETEKTOREN *** C

common /aO/ lengte,nstr common /a8/ ndet,kdet(20) C character*2 tekst C call txt824(10,130,8,'det. nr:',2) ix=630 iyy=nstr*10+55 do 10 i=l,ndet if (kdet(i).ge.lengte) go to 10 ixx=100+nint(kdet(i)*530.O/lengte) if (ix-ixx.ge.20) then write (tekst,' (12) ') i call txt824(ixx-10,130,2,tekst,2) ix=ixx

(27)

end if call bgnp24(ixx,120) call line24(ixx,iyy,2) 10 continue return end C C C subroutine tekenv $debug C

C *** SCHERMOPMAAK EN WEERGEVEN HUIDIGE VOERTUIGTYPEN *** C

common /a9/ itsw,tra,trd,nperc,vda,vdb,zl,z2,z3 common /alO/ nvtype,e(8,8)

C character*36 t C call ergr24(16) call wrtm24(1) call vkop call txt824(200,25,36,'3.2 VOERTUIG-BESTUURDER-KOMBINATIES',10) call rect24(5,470,450,420,10) call txt824(5,50,14,'invoergegevens',10) call rect24(480,470,155,420,10) call txt824(480,50,8,'situatie',10) C

write (t,' (il)') itsw call txt824(500,80,l,t,15) call txt824(530,80,3,' [s]',15) write (t,'(f6.2)') tra call txt824(480,120,6,t,15) call txt824(530,120,3,'[s]',15) write (t,' (f6.2)') trd call txt824(480,160,6,t,15) call txt824(530,160,3, ' [s] ' ,15) write (t,'(i3)') nperc

call txt824(490,193,3,t,15)

call txt824(520,193,11,'% taktiek l',15) write (t,'(i3)') 100-nperc

call txt824(490,207,3,t,15) call txt824(520,207,11,'% taktiek 2',15) write (t,'(f6.2)') vda call txt824(485,240,6,t,15) call txt824(535,240,6,'[km/u]',15) write (t,' (f6.2)') vdb call txt824(485,280,6,t,15) call txt824(535,280,6,'[km/u]',15) write (t,'(f6.2)') zl call txt824(490,306,13,'zl= [m]',15) call txt824(515,306,6,t,15) write (t,'(f6.2)') z2 call txt824(490,320,15,'z2= [m/m]',15) call txt824(515,320,6,t,15) write (t,' (f6.2)') z3 call txt824 (490,334,16,'z3= [sVm]',15) call txt824(515,334,6,t,15) write (t,' (15)') nvtype call txt824(490,360,5,t,15)

call txt824(490,393,13,'druk op Enter',15) call txt824(490,407,14,'voor overzicht',15) end

(28)

subroutine tekens $debug

C

C *** SCHERMOPMAAK EN HUIDIGE SIMULATIE-INSTELLINGEN *** C

common /all/ irand,ts,ntsim C character*6 t C call ergr24(16) call wrtm24(1) call vkop call txt824(230,25,27,'3.3 SIMULATIE-INSTELLINGEN',10) call rect24(5,470,450,420,10) call txt824(5,50,14,'invoergegevens',10) call rect24(480,470,155,420,10) call txt824(480,50,8,'situatie' ,10) C

write (t,'(i5)') irand call txt824(490,100,5,t,15) write (t,' (f6.2) ') ts

call txt824(480,150,6,t,15) call txt824(535,150,3,'[s]',15) write (t,'(i5)') ntsim

call txt824(490,200,5,t,15)

call txt824(535,200,9,'[tijdst.]',15) call txt824(490,243,13,'druk op Enter',15) call txt824(490,257,14,'voor overzicht',15) call txt824(490,293,13,'druk op Enter',15) call txt824(49 0,3 07,14,'voor overzicht',15) end C C C subroutine tekver $debug C C *** SCHERMOPMAAK VERKEERSSTROMEN *** C call ergr24(16) call wrtm24(1) cal1 vkop call txt824(250,25,20,'3.4 VERKEERSSTROMEN',10) call rect24(5,470,630,420,10) call txt824(5,50,11,'menu-opties',10) return end C C C subroutine rgetal(ixx,iyy,rmax,r) $debug C

C *** INVOEREN VAN EEN REAL GETAL *** C *** MAXIMUM LENGTE IS 6 CIJFERS *** C *** MAXIMAAL 2 CIJFERS ACHTER DE KOMMA ***

C character*6 t C call wrtm24(0) 1 = 1 n=0 m=0 r=0.0 ra=0 .0 rh=0.O

(29)

c

C GETAL AFDRUKKEN 10 r=sign(ra,r)

if (n.eq.O) write (t,'(i6)') int(r) if (n.eq.l) write (t,'(f6.0)') r if (n.eq.2) write (t,'(f6.1)') r if (n.eq.3) write (t,'(f6.2)') r call txt824(ixx,iyy,6,t,15) 20 call keyb24(i) if (i.eq.O) go to 20 if (i.eq.l3) go to 40 ra=abs(r) C

C LAATSTE CIJFER VERWIJDEREN if (i.eq.8) then if (l.gt.l) 1=1-1 if (n.eq.O) then ra=int(r*0.1) else if (n.eq.l) then n=0 else ra=(int(ra*10**(n-2)))/(1.0*10**(n-2)) n=n-l end if end if end if C C CIJFER TOEVOEGEN if (l.eq.6) then if(m.eq.O) go to 20 go to 30 end if if (n.eq.3) go to 30 if (i.gt.47.and.i.lt.58) then call getald,j) if (ra.gt.O) 1=1+1 if (n.eq.O) then rh=ra*10+j if (rh.gt.rmax) go to 20 else rh=ra+(1.0*j/(10**n)) if (rh.gt.rmax) go to 20 n=n+l end if ra=rh end if C C PUNT TOEVOEGEN if d.eq.44.or.i.eq.46.amd.n.eq.O) then n=l 1=1+1 go to 10 end if C C MINTEKEN TOEVOEGEN 30 if (i.eq.45) then r=-l*r if (m.eq.O) then m=l 1 = 1 + 1 else m=0 1 = 1-1 end if end if

(30)

go to 10 C C AKKOORD 40 call wrtm24(2) call txt824(ixx,iyy,6,t,15) call wrtm24(l) return end C C C subroutine menul $debug C

C *** MENU-OPTIES: TOEVOEGEN, WIJZIGEN, VERWIJDEREN, AKKOORD C

C

common /al/ lo(10,10),opties(10,10) opties(1,1)='toevoegen' lo(l,l)=9 opties(1,2)='wijzigen' lo(l,2)=8 opties(1,3)='verwijderen' lo(l,3)=ll opties(1,4)='akkoord' lo(l,4)=7 return end subroutine optiel C C C $debug C

C *** MENU-OPTIE 1.1: LENGTE WEGVAK *** C

common /aO/ lengte,nstr C

C

character*80 tl,t2

10 tl='de lengte van het wegvak is: m (minimaal 1 m ) ' write (t2,'(i5)') lengte

call txt824(100,300,51,tl,2) call txt824(330,300,5,t2,15) call okdOO,400,1) call txt824(330,300,5,t2,16) if (i.eq.l) go to 20 15 call igetal(330,300,10000,lengte) if (lengte.eq.O) go to 15 call teken go to 10 20 call txt824(100,300,51,tl,16) return end C C C subroutine optie2 $debug C

C *** MENU-OPTIE 1.2: AANTAL RIJSTROKEN *** C

common /aO/ lengte,nstr C

(31)

character*80 tl,t2 C

10 tl='het aantal rijstroken is: (minimaal 1, maximaal 8 ) ' write (t2,'(il)') nstr call txt824(100,300,54,tl,2) call txt824(310,300,1,t2,15) call okdOO,400,1) call txt824(310,300,1,t2,16) if (i.eq.l) go to 20 15 call icijf(310,300,nstr) if (nstr.eq.O) go to 15 call teken go to 10 20 call txt824(100,300,54,tl,16) return end C C C subroutine optie3 (1) $debug C

C *** MENU-OPTIE 1.3, 1.7 EN 1.9: FYSIEKE EN STROOKSEKTIES ***

C *** EN DETEKTOREN *** C

common /a6/ nssg,kssg(20) common /a8/ ndet,kdet(20) common /a20/ nhulp,khulp(50) C

character*80 tl,t2,t3,t4,t5 C

C AFDRUKKEN HUIDIGE KONFIGURATIE itel=0

10 call hulpl(l) if (I.eq.l) then

write (tl,20) nfsg+1

20 format ('er zijn '12' fysieke sekties in het wegvak' # ' onderscheiden')

else

if (l.eq.2) then

write (tl,21) nssg+1

21 format ('er zijn '12' strooksekties in het wegvak' # ' onderscheiden ')

else

write (tl,22) ndet

22 format ('er zijn '12' detektoren in het wegvak aangebracht') end if

end if call grens

t2='de koordinaten van de tussenliggende sektiegrenzen zijn:' if (l.eq.3) t2='de koordinaten van hun posities zijn:'

call txt824(100,250,54,tl,2) call txt824(100,300,56,t2,2) if (itel.eq.l) go to 40 C C KEUZEMENU i o 2 = l j o 2 = l c a l l o k d O O , 4 0 0 , 1 ) if (i.eq.l) go to 400 40 call menul

(32)

call menu(100,350,O,20,1,4,4,io2,in2,jo2,jn2,12) C

C NIEUWE OPTIES TOEKENNEN n=l

m=l

do 50 nm=l,nhulp

write (opties(n,m),' (15)') khulp(nhulp+1-nm) lo(n,m)=5 n=n+l if (nm.eq.lO) then m=m+l n=l end if 50 continue if (nhulp.ge.lO) n=10 C go to (100,200,300,400) jn2 C

C OPTIE 1: SEKTIEGRENS OF DETEKTOR TOEVOEGEN 100 if (nhulp.eq.20) go to 40

t3='de koordinaat vém de nieuwe sektiegrens is:'

if (l.eq.3) t3='de koordinaat van de nieuwe detektor is: call txt824(100,370,43,t3,2) call igetal(450,370,9999,k) do 110 i=l,nhulp if (k.eq.O.or.k.eq.khulp(i)) go to 120 110 continue if (k.lt.lengte) then nhulp=nhulp+l khulp(nhulp)=k end if if (nhulp.eq.l) go to 120 call sort(l) 120 call hulp2 (1) call teken itel=l go to 10 C

C OPTIE 2: SEKTIEGRENS OF DETEKTOR WIJZIGEN 200 if (nhulp.eq.O) go to 40

io3=l jo3=l

t3='geef aan welke sektiegrens u wilt wijzigen'

if (l.eq.3) t3='geef aan welke detektor u wilt wijzigen' call txt824(100,360,42,t3,2)

call menu(50,300,50,2O,n,m,nhulp,io3,in3,jo3,jn3,15) nummer=(jn3-l)*10+in3

call grens

call txt824(100,360,42,t3,16)

write (t3,'(i5)') khulp(nhulp+1-nummer)

t4='de sektiegrens met koordinaat ,'

if (l.eq.3) t4='de detektor met koordinaat ,' t5='krijgt als nieuwe koordinaat:'

call txt824(100,360,36,t4,2) call txt824(100,380,29,t5,2) call txt824(340,360,5,t3,15) call igetal(340,380,9999,k) do 230 1=1,nhulp if (k.eq.O.or.k.eq.khulpd)) go to 240 230 continue if (k.It.lengte) khulp(nhulp+1-nummer)=k if (nhulp.eq.l) go to 240 call sort(l) 24 0 call hulp2(1) call teken itel=l

(33)

go to 10 C

C OPTIE 3: SEKTIEGRENS OF DETEKTOR VERWIJDEREN 300 if (nhulp.eq.O) go to 40

io4=l jo4=l

t3='geef aan welke sektiegrens u wilt verwijderen'

if (l.eq.3) t3=('geef aan welke detektor u wilt verwijderen') call txt824(100,360,45,t3,2)

call menu(50,300,50,2 0,n,m,nhulp,io4,in4,jo4,jn4,15) nummer=(jn4-l)*10+in4 khulp(nhulp+1-nummer)=0 if (nhulp.eq.l) then nhulp=O go to 310 end if call sort(l) 310 call hulp2(1) call teken itel=l go to 10 C

C OPTIE 4: SEKTIEGRENZEN OF DETEKTOREN AKKOORD 400 call wrtm24(2) call txt824(100,250,54,tl,2) call txt824(100,300,56,t2,2) call grens call wrtm24(1) call hulp2(1) return end C C C subroutine hulpl(l) $debug C

C *** OMZETTEN VAN KOORDINATEN IN HULPKOORDINATEN *** C

common /a2/ nfsg,kfsg(2 0)

common /a6/ nssg,kssg(2 0) -common /a8/ ndet,kdet(2 0)

common /a2 0/ nhulp,khulp(50) C if (I.eq.l) then do 10 i=l,nfsg khulp(i)=kfsg(i) kfsg(i)=0 10 continue nhulp=nfsg else •. if (l.eq.2) then do 20 i=l,nssg i khulp (i) =kssg (i) •: kssg(i)=0 20 continue nhulp=nssg else do 30 1=1,ndet khulp(i)=kdet(i) kdet(i)=0 30 continue nhulp=ndet end if end if return

(34)

end C C C subroutine hulp2(1) $debug C

C *** OMZETTEN VAN HULPKOORDINATEN IN KOORDINATEN *** C

common /a2/ nfsg,kfsg(20) common /a6/ nssg,kssg(20) common /a8/ ndet,kdet(20) common /a20/ nhulp,khulp(50) C if (I.eq.l) then nfsg=nhulp do 10 1=1,nfsg kfsg(i)=khulp(i) khulp(i)=0 10 continue else if (l.eq.2) then nssg=nhulp do 20 i=l,nssg k s s g d ) =khulp (1) khulp(i)=0 20 continue else ndet=nhulp do 30 i=l,ndet kdet(i)=khulp(i) khulp(i)=0 30 continue end if end if return end C C C subroutine igetal(ixx,iyy,n,k) $debug C

C *** INVOEREN VAN EEN GETAL *** C character*5 t C call wrtm24(0) k=0 10 write (t,' (15)') k call txt824(ixx,iyy,5,t,15) 2 0 call keyb24(i) if (i.eq.O) go to 20 if (i.eq.l3) go to 30 if (i.eq.8) k=k/10 if (i.gt.47.and.i.lt.58) then call getal (1,j) k=10*k+j end if if (k.gt.n) k=k/10 go to 10 30 call txt824(ixx,iyy,5,t,16) call wrtm24(1) return end

(35)

c

subroutine sort(l) $debug

C

C *** SORTEREN VAN KOORDINATEN *** C

common /a2 0/ nhulp,khulp(50) C C SORTEREN do 10 i=l,nhulp-l do 20 j=i+l,nhulp if (l*khulp(j).gt.l*khulp(i)) then ihulp=khulp(1) khulp(i)=khulp(j) khulp(j)=ihulp end if 20 continue 10 continue if (abs(1).eq.lO) go to 40 C C NULLEN VERWIJDEREN if (khulp(1).eq.O) then do 30 1=1,nhulp khulp(1)=khulp(i+l) 30 continue nhulp=nhulp-1 end if if (khulp(nhulp).eq.O) nhulp=nhulp-l 40 return end C C C subroutine grens $debug C

C *** AFDRUKKEN VAN DE KOORDINATEN *** C

common /a2 0/ nhulp,khulp(5O) C character koord*5 C 1=1 j=0 do 10 ij=l,nhulp

write (koord,'(15)') khulp(nhulp+l-ij) call txt824(50+i*50,320+j*20,5,koord,15) 1=1+1 if (ij.eq.lO) then i=l j=j+l end if -,' 10 continue return end C C

c

subroutine icijf(ixx,iyy,k) $debug C

C *** INVOEREN VAN EEN CIJFER *** C

character*l t C

(36)

call wrtm24(0) k=0 10 write (t,' (il)') k call txt824(ixx,iyy,1,t,15) 20 call keyb24 d ) if (i.eq.O) go to 20 if (i.eq.l3) go to 30

if (i.gt.47.and.i.lt.57) call getal(i,k) if (i.eq.8) k=0 go to 10 30 call txt824(ixx,iyy,l,t,16) call wrtm24(1) return end subroutine optie4 C C C $debug C

C *** MENU-OPTIE 1.4: BEPALEN VAN HET TYPE WEGVAK *** C

common /a3/ itype(8,20) C

C

character*80 tl,t2,t3,t4,t5 istr=l

isek=l

10 tl='bekijk de strooktypen m.b.v. de pijltjestoetsen en' call txt824(100,230,50,tl,2)

t2='druk op Enter indien alle strooktypen juist zijn' call txt824(100,245,48,t2,2)

t3='sektie op strook heeft typenummer ' call txt824(25,300,40,t3,2) t4='strooktypen akkoord ? n/<j>:' call txt824(25,400,30,t4,14) C C OMSCHRIJVING TYPENOMMERS t5='typenummer omschrijving' opties(1,1)='O middenstrook' lo(l,l)=21 opties(1,2)='1 linkerstrook' lo(l,2)=21 opties(1,3)='2 rechterstrook' lo(l,3)=22

opties(1,4)='3 enkele strook' lo(l,4)=22

opties(1,5)='4 links afgestreept' lo(l,5)=26

opties (1,6)='5 rechts afgestreept' lo(l,6)=27

opties(1,7)='6 afgezette strook' lo(l,7)=25

opties(1,8)='9 imaginaire strook' lo(l,8)=26 call rect24(350,440,270,160,2) call bgnp24(350,310) call line24(619,310,2) call txt824(360,300,25,t5,2) do 2 0 j=l,8 call txt824(390,310+j*15,lo(l,j),opties(l,j),2)

(37)

20 continue C

C KIEZEN VAN DE SEKTIE call menuf(4,ims,istr,isek)

C

C WIJZIGEN VAN HET SEKTIETYPE if (ims.ne.110) go to 40 30 call txt824(100,230,50,tl,16) call txt824(I00,245,48,t2,16) call txt824(25,400,30,t4,16) call txt824(335,300,1,':',15) io4=l jo4=l call menu(390,310,O,15,1,8,8,io4,in4,jo4,jn4,15) if (jn4.1e.7) then ihulp=jn4-l else ihulp=9 end if itype(istr,isek)=ihulp call teken go to 10 40 call teken return end subroutine menuf(io,i,istr,isek) C C C $debug C

C *** KIEZEN VAN EEN FYSIEKE SEKTIE MET PIJLTJESTOETSEN ***

c

common /a2/ nfsg,kfsg(20) ''i; common /a3/ itype (8,20) '

-common /a4/ ivs(8,20,2) common /a5/ sond(8,20) C

character*80 tekst,strook C

C BEPALING KOORDINATEN AANGEWEZEN SEKTIE i=l jstr=istr jsek=isek 10 if (i.eq.1736.and.istr.gt.l) jstr=istr-l if (i.eq.1744.and.istr.lt.nstr) jstr=istr+l if (1.eq.1739.and.isek.Ie.nfsg) jsek=isek+l if (i.eq.1741.and.isek.gt.l) jsek=isek-l if (i.eq.l) go to 20 ixxv=ixx iyyv=iyy ixv=ix 20 if (jsek.gt.nfsg) then ixx=100 go to 30 end if ixx=100+nint(kfsg(j sek)*530.O/lengte) 30 if (jsek.eq.l) then ix=630 go to 4 0 end if ix=l00+nint(kfsg(jsek-1)*530.O/lengte) 40 iyy=55+jstr*10 C

(38)

if (i.eq.l) go to 50

call blkf24(ixxv+1,iyyv-1,ixv-ixxv-2,8,16)

if (itype(istr,isek).eq.4) call shal24(ixxv,iyyv,ixv-ixxv,10,15) if (itype(istr,isek).eq.5) call shar24(ixxv,iyyv,ixv-ixxv,10,15) if (itype(istr,isek).eq.6) call blkf24(ixxv,iyyv,ixv-ixxv,10,15) if (itype(istr,isek).gt.9) then call bgnp24(ixxv,iyyv-5) call line24(ixxv+20,iyyv-5,15) call line24(ixxv+16,iyyv-7,15) call line24(ixxv+16,iyyv-3,15) call line24(ixxv+20,iyyv-5,15) end if call strsek C

C ROOD KLEUREN EN NUMMEREN NIEUWE AANGEWEZEN SEKTIE 50 call blkf24(ixx+l,iyy-1,ix-ixx-2,8,12)

write (tekst,' (12)') jsek call txt824(80,300,2,tekst,15) write (tekst,' (il)') jstr

call txt824(185,300,1,tekst,15) if (io.eq.4) then

ihulp=itype(jstr,jsek)

if (itype(jstr,jsek).gt.9) ihulp=ihulp-10 write (tekst,' (il)') ihulp

call txt824(335,300,1,tekst,15) end if

if do.eq.5) then

if (ivs(jstr,jsek,1).Ie.1) then

tekst='bestuurders moeten hier niet naar links wisselen' call txt824(25,330,69,tekst,2)

else

write (tekst,51)

51 format ('bestuurders met bestemming strook en lager,' # ' moeten hier naar links')

call txt824(25,330,69,tekst,2)

write (strook,' (il)') ivs(jstr,jsek,1)-1 call txt824(295,330,1,strook,15)

end if

if (ivs(jstr,jsek,2).ge.nstr) then

tekst='bestuurders moeten hier niet naar rechts wisselen' call txt824(25,350,69,tekst,2)

else

write (tekst,52)

52 format ('bestuurders met bestemming strook en hoger,' # ' moeten hier naar rechts')

write (strook,'(il)') ivs(jstr,jsek,2)+1 call txt824(295,350,1,strook,15)

end if end if

if (io.eq.6) then

write (tekst,'(13)') nint(100*sond(jstr,jsek)) call txt824(285,320,3,tekst,15) end if C istr=jstr isek=3sek 60 call keyb24(1) if (i.eq.O) go to 60 if (i.ne.13.and.i.ne.106.and.i.ne.110) go to 10 return end C C C subroutine menus(i,istr,isek)

(39)

$ d e b u g C

C *** KIEZEN VAN EEN STROOKSEKTIE MET PIJLTJESTOETSEN *** C

common /aO/ lengte,nstr common /a2/ nfsg,kfsg(2 0) common /a3/ itype(8,20) common /a6/ nssg,kssg(2 0) common /a7/ igs(8,20,2) C

character*80 tekst,strook C

C BEPALING KOORDINATEN AANGEWEZEN SEKTIE 1 = 1 jstr=istr jsek=iBek 10 if (i.eq.1736.and.istr.gt.l) jstr=istr-l if (i.eq.1744.and.istr.It.nstr) jstr=istr+l if (i.eq.1739.and.isek.Ie.nssg) jsek=isek+l if (i.eq.1741.and.isek.gt.l) jsek=isek-l if (i.eq.l) go to 20 ixxv=ixx iyyv=iyy ixv=ix 20 if (jsek.gt.nssg) then ixx=100 go to 30 end if ixx=100+nint(kssg(jsek)*530.O/lengte) 30 if (jsek.eq.l) then ix=630 go to 40 . end if ix=100+nint(kssg(jsek-1)*530.O/lengte) 40 iyy=55+jstr*10 C

C HERTEKENEN VORIGE AANGEWEZEN SEKTIE if (i.eq.l) go to 50 call blkf24(ixxv+1,iyyv-1,ixv-ixxv-2,8,16) call fysek call type call strsek C

C ROOD KLEUREN EN NUMMEREN NIEUWE AANGEWEZEN SEKTIE 50 call blkf24(ixx+l,iyy-l,ix-ixx-2,8,12)

write (tekst,' (12)') jsek call txt824(80,300,2,tekst,15) write (tekst,' (il)') jstr

call txt824(185,300,1,tekst,15) if (igs(jstr,jsek,1) .Ie .1) then

tekst='bestuurders willen hier niet naar links wisselen' call txt824(25,330,68,tekst,2)

else

write (tekst,51)

51 format ('bestuurders met bestemming strook en lager,' # ' willen hier naar links')

write (strook,' (il)') igs(jstr,jsek,1)-1 call txt824(295,330,1,strook,15)

end if

if (igs(jstr,jsek,2).ge.nstr) then

tekst='bestuurders willen hier niet naar rechts wisselen' call txt824(25,350,69,tekst,2)

else

write (tekst,52)

(40)

# ' willen hier naar rechts') call txt824(25,350,69,tekst,2)

write (strook,' (il)') igs(jstr,jsek,2)+1 call txt824(295,350,1,strook,15) end if istr=jstr isek=3 sek 60 call keyb24(i) if (i.eq.O) go to 60 if (i.ne.13.and.i.ne.106.and.i.ne.110) go to 10 return end subroutine optieS(1) C C C $debug C

C *** MENU-OPTIE 1.5 EN 1.8: VERPLICHT EN GEWENST ***

C *** STROOKWISSELEN *** C

common /aO/ lengte,nstr common /a2/ nfsg,kfsg(20) common /a3/ itype(8,20) common /a4/ ivs(8,20,2) common /a6/ nssg,kssg(20) common /a7/ igs(8,20,2) C

character*80 tl,t2,t3,t4 C

istr=l isek=l

10 tl='bekijk het strookwisselen m.b.v. de pijltjestoetsen en' call txt824(100,230,54,tl,2)

t2='druk op Enter indien het strookwisselen juist is' call txt824(100,250,48,t2,2) t3='sektie op strook' call txt824(25,300,19,t3,2) t4='strookwisselen akkoord ? n/<j>:' call txt824(25,400,33,t4,14) C

C KIEZEN VAN DE SEKTIE if (I.eq.l) then call menuf(5,ims,istr,isek) else call menus(ims,istr,isek) end if C

C WIJZIGEN VAN HET STROOKWISSELEN if (ims.ne.110) go to 40

call txt824(100,230,54,tl,16) call txt824(100,250,48,t2,l6) call txt824(25,400,33,t4,16) C NAAR LINKS

tl='Strookwisselen naar links wijzigen ? j/<n>:' call txt824(25,400,45,tl,14) 2 0 call keyb24(i) if (i.ne.l3.and.i.ne.106.and.i.ne.110) go to 20 if (i.eq.106) then if (I.eq.l) then write (tl,21)

21 format ('bestuurders met bestemming strook en lager,' # ' moeten hier naar links')

else

(41)

22 format ('bestuurders met bestemming strook en lager,' # ' willen hier naar links')

end if call txt824(25,400,68,tl,2) call icijf(295,400,k) if (I.eq.l) then ivs(istr,isek,1)=k+l else igs(istr,isek,1)=k+l end if call txt824(25,400,68,tl,16) end if C NAAR RECHTS

tl='strookwisselen naar rechts wijzigen ? j/<n>:' call txt824(25,400,46,tl,14) 30 call keyb24(i) if (i.ne.13.and.i.ne.106.and.i.ne.110) go to 30 if d.eq.l06) then if (I.eq.l) then write (tl,31)

31 format ('bestuurders met bestemming strook en hoger,' # ' moeten hier naar rechts')

else

write (tl,32)

32 format ('bestuurders met bestemming strook en hoger,' # ' willen hier naar rechts')

end if call txt824(25,400,69,tl,2) call icijf(295,400,k) if (k.eq.O) k=nstr+l if (I.eq.l) then ivs(istr,isek,2)=k-l else igs(istr,isek,2)=k-l end if end if call teken go to 10 40 call teken return end • C C C subroutine optie6 $debug C Q *** MENU-OPTIE 1.6: SNELHEIDSONDERDRUKKING *** C

common /aO/ lengte,nstr common /a2/ nfsg,kfsg(20) common /a5/ sond(8,20) C character*80 tl,t2,t3,t4,t5 C istr=l iBek=l 10 write (tl,11)

11 format ('bekijk de snelheidsonderdrukking m.b.v de pijltjes' # 'toetsen en')

call txt824(100,230,60,tl,2)

t2='druk op Enter indien de percentages naar wens zijn' call txt824(100,250,50,t2,2)

t3='sektie op strook' call txt824(25,300,19,t3,2) write (t4,12)

(42)

12 format ('men rijdt hier met ten hoogste % van zijn' # ' wenssnelheid') call txt824(25,320,59,t4,2) t5='snelheidsonderdrukking akkoord ? n/<j>:' call txt824(25,400,41,t5,14) C

C KIEZEN VAN DE SEKTIE call menuf(6,ims,istr,isek)

C

C WIJZIGEN VAN EEN ONDERDRUKKINGSFAKTOR if (ims.ne.110) go to 20 call txt824(100,230,60,tl,16) call txt824(100,250,50,t2,16) call txt824(25,400,41,t5,16) call igetal(270,320,100,k) sond(istr,isek)=0.01*float(k) go to 10 20 call teken return end C C C subroutine optie7 $debug C C *** MENU-OPTIE 2.1: STROOKWISSELTIJD *** C

common /a9/ itsw,tra,trd,nperc,vda,vdb,zl,z2,z3 C

character*80 tl,t2,t3 C

10 tl='de strookwisseltijd is: s' write (t2,' (il)') itsw

t3='advies: 3 s, minimaal: 1 s, maximaal: 8 s' call txt824(50,80,27,tl,2) call txt824(240,80,l,t2,15) call txt824(50,100,41,t3,2) call ok(50,150,i) if (i.eq.l) go to 3 0 20 call icijf(240,80,itsw) if (itsw.eq.O) go to 20 go to 10

30 write (t2,'(il)') itsw call txt824(50,80,l,t2,16) call txt824(500,80,l,t2,15) call txt824(50,80,27,tl,16) call txt824(50,100,41,t3,16) return end C C C subroutine optie8 $debug C

C *** MENU-OPTIE 2.2: REAKTIETIJD VOOR ACCELERATIE *** C

10 tl='de reaktietijd voor acceleratie is: s' write (t2,'(f6.2)') tra

tekstS='maximaal: 0.9 s' call txt824(50,120,43,tl,2)

(43)

call txt824(330,120,6,t2,15) call txt824(50,140,15,t3,2) call ok(50,190,1) if (i.eq.l) go to 20 call rgetal(330,120,0.9,tra) go to 10 20 write (t2,'(f6.2)') tra call txt824(480,120,6,t2,15) call txt824(330,120,6,t2,16) call txt824(50,120,43,tl,16) call txt824(50,140,15,t3,16) return end C C C subroutine optie9 $debug C

C *** MENU-OPTIE 2.3: REAKTIETIJD VOOR DECELERATIE *** C

10 tl='de reaktietijd voor deceleratie is: write (t2,' (f6.2)') trd t3 ='maximaal: 0.9 s' call txt824(50,160,43,tl,2) call txt824(330,160,6,t2,15) call txt824(50,180,15,t3,2) call ok(50,230,i) if (i.eq.l) go to 20 call rgetal(330,160,0.9,trd) go to 10 20 write (t2,'(f6.2)') trd call txt824(480,160,6,t2,15) call txt824(330,160,6,t2,16) call txt824(50,160,43,tl,16) call txt824(50,180,15,t3,16) return end C C C subroutine opt10 $debug C C *** MENU-OPTIE 2.4: STROOKWISSELTAKTIEK ***

c

character*80 tl,t2,t3,t4,t5,t6 C

10 write (tl,' (15)') nperc write (t2,'(i5)') 100-nperc

t3='% van de bestuurders verhoogt zijn snelheid om' t4='een strookwisseling mogelijk te maken (taktiek 1 ) ' t5='% van de bestuurders verlaagt zijn snelheid om' t6='een strookwisseling mogelijk te maken (taktiek 2 ) ' call txt824(20,200,5,tl,15) call txt824(65,200,46,t3,2) call txt824(45,220,49,t4,2) call txt824(20,240,5,t2,15) call txt824(65,240,46,t5,2) call txt824(45,260,49,t6,2) S' o.£'

(44)

call ok(50,310,i) call txt824(20,200,5,tl,16) call txt824(20,240,5,t2,16) if (i.eq.l) go to 20 call igetal(20,200,100,nperc) go to 10 20 write (tl,' (13)') nperc call txt824(490,193,3,tl,15) write (tl,' (13)') 100-nperc call txt824(490,207,3,tl,15) call txt824(65,200,46,t3,16) call txt824(45,220,49,t4,16) call txt824(65,240,46,t5,16) call txt824(45,260,49,t6,16) return end C C C subroutine optil $debug C

C *** MENU-OPTIE 2.5: SNELHEIDSVERSCHIL TAKTIEK 1 *** C

10 tl='een bestuurder met taktiek 1 rijdt ten hoogste' write (t2,'(f6.2)') vda

t3='km/u sneller dan het overige verkeer' call txt824(50,240,46,tl,2) call txt824(50,260,6,t2,15) call txt824(110,260,36,t3,2) call ok(50,310,1) if (i.eq.l) go to 20 call rgetal(50,260,99.O,vda) go to 10 20 write (t2,'(f6.2)') vda call txt824(485,240,6,t2,15) call txt824(50,260,6,t2,16) call txt824(50,240,46,tl,16) call txt824(110,260,36,t3,16) return end C C C subroutine opt12 $debug C

C *** MENU-OPTIE 2.6: SNELHEIDSVERSCHIL TAKTIEK 2 *** C

vdb=-l*vdb

10 tl='een bestuurder met taktiek 2 rijdt ten hoogste' write (t2,'(f6.2)') vdb

t3='km/u langzamer dan het overige verkeer' call txt824(50,240,46,tl,2)

call txt824(50,260,6,t2,15) call txt824(110,260,38,t3,2) call ok(50,310,i)

(45)

call rgetal(50,260,99.O,vdb) go to 10 20 vdb=-l*vdb write (t2,' (f6.2)') vdb call txt824(485,280,6,t2,15) call txt824(50,260,6,t2,16) call txt824(50,240,46,tl,16) call txt824(110,260,38,t3,16) return end C C C subroutine optl3 $debug C C *** MENU-OPTIE 2.7: VOLGFAKTOREN *** C

tl='de volgafstand d wordt in FOSIM berekend met' t2='de formule: d = zl + z2*f*v + z3*v', waarin:' t3='zl= [m], advies: 3.00' call txt824(50,320,44,tl,2) call txt824(50,340,44,t2,2) itel=l z=zl 10 call txt824(50,360,30,t3,2) write (t4,' (f6.2)') z call txt824(80,360,6,t4,15) call ok(50,410,i) call txt824(80,360,6,t4,16) if (i.eq.l) go to 20 call rgetal(80,360,10.O,z) go to 10 20 if (itel.eq.l) then call txt824(515,306,6,t4,15) zl=z itel=2 t3='z2= [m/m], advies: 0.80' z = z2 go to 10 end if if (itel.eq.2) then call txt824(515,320,6,t4,15) z2 = z itel=3 t3 = 'z3= [sVm] , advies: 0.01' z=z3 go to 10 end if if (itel.eq.3) then call txt824(515,334,6,t4,15) z3=z call txt824(50,320,44,tl,16) call txt824(50,340,44,t2,16) call txt824(50,360,30,t3,16) end if return end C C C subroutine opt14

(46)

$debug C

C *** MENU-OPTIE 2.8: AANTAL VOERTUIGTYPEN *** C

common /alO/ nvtype,e(8,8) C

10 tl='het aantal typen voertuigen is:' write (t2,'(i5)') nvtype

t3='minimaal 1, maximaal 8' call txt824(50,360,31,tl,2) call txt824(300,360,5,t2,15) call txt824(50,380,22,t3,2) call ok(50,430,1) if (i.eq.l) go to 30 20 call igetal(300,360,8,nvtype) if (nvtype.eq.O) go to 2 0 go to 10 30 call txt824(490,360,5,t2,15) call txt824(300,360,5,t2,16) call txt824(50,360,31,tl,16) call txt824(50,380,22,t3,16) return end C C

c

subroutine opt15 $debug C

C *** MENU-OPTIE 2.9: EIGENSCHAPPEN PER VOERTUIG *** C

common /al/ lo(10,10),opties(10,10) common /alO/ nvtype,e(8,8)

C character*80 t C C SCHERMOPMAAK call ergr24(16) call vkop call txt824(200,25,36,'3.9 VOERTUIG-BESTUURDER-KOMBINATIES',10) call rect24(5,470,630,420,10)

call txt824(5,50,31,'eigenschappen per type voertuig',10) call txt824(10,126,17,'max pos sprong in',2)

call txt824(10,140,23,'acceleratie [m/s'] call txt824(10,180,23,'volgfaktor [s] call txt824(10,220,23,'max acceleratie [m/s'ï

call txt824(10,246,15,'max volgdecele-',2)

call txt824(10,260,23,'ratie [m/s»]:',2) call txt824 (10,286,17,'maix strookwissel-', 2)

call txt824(10,300,23,'deceleratie [m/s»] call txt824(10,340,23,'max deceleratie [m/s»] call txt824(10,380,23,'wenssnelheid [km/u] call txt824(10,420,23,'voertuiglengte [m] call txt824(250,75,12,'voertuigtype',2) do 10 j=l,nvtype write (t,'(13)') j call txt824(150+j*50,100,3,t,2) 10 continue C

C AFDRUKKEN GEGEVENS VAN ALLE VOERTUIGTYPEN 20 do 30 1=1,nvtype ,2) ,2) ,2) ,2) ,2) ,2) ,2)

(47)

do 40 j=l, 8

write (opties(i,j) ,' (f6.2)') e(i,j) l o d , j)=6 call txt824(150+1*50,100+j*40,lo(i,j),opties d,j),15) 4 0 continue 30 continue C C WIJZIGEN VOERTUIGTYPE-GEGEVENS 50 call ok(50,450,i) if (i.eq.l) go to 90 io2=l jo2 = l call menu(150,100,50,40,nvtype,8,64,io2,in2,jo2,3n2,15) do 60 1=1,nvtype do 70 j=1,8 call txt824(150+i*50,100+j*40,lo(i,j),opties(i,j),15) 70 continue 60 continue

80 t='geef een nieuwe waarde op en druk op Enter' call txt824(10,460,42,t,14)

call rgetal(150+in2*50,100+jn2*40,200.0,e(in2,jn2)) call txt824(10,460,42,t,16)

C

C KONTROLE OP JUISTHEID INVOERGEGEVENS r=e(in2,jn2) go to (81,81,81,82,82,82,83,84) jn2 81 if (r.le.O.O.or.r.gt.lO.0) go to 80 go to 20 82 if (r.ge.0.0.or.r.It.-10.0) go to 80 go to 2 0 83 if (r.le.O.O.or.r.gt.200.0) go to 80 go to 2 0 84 if (r.le.O.O.or.r.gt.50.0) go to 80 go to 2 0 90 call tekenv return end C C C subroutine opt16 $debug C

C *** STARTWAARDE VOOR DE RANDOMGENERATOR *** C

common /all/ irand,ts,ntsim C

10 tl='de startwaarde van de randomgenerator is:' write (t2,'d5)') irand

call txt824(50,100,41,tl,2) call txt824(380,100,5,t2,15) call ok(50,150,1)

if (i.eq.l) go to 30

t3='geef een oneven waarde op' call txt824(50,120,25,t3,2) 20 call igetal(380,100,99999,irand) if (2*(irand/2).eq.irand.or.irand.eq.0) go to 20 call txt824(50,120,25,t3,16) go to 10 30 call txt824(490,100,5,t2,15) call txt824(380,100,5,t2,16) call txt824(50,100,41,tl,16) return end

(48)

c c c subroutine optl7 $debug C

C *** INSTELLING DUUR VAN EEN TIJDSTAP *** C

10 tl='de duur van een tijdstap is ingesteld op: s' write (t2,' (f6.2)') ts t3='0 s < tijdstap s 10 s, advies: 1 s' call txt824(50,150,48,tl,2) call txt824(375,150,6,t2,15) call txt824(50,170,34,t3,2) call ok(50,220,1) if (i.eq.l) go to 30 20 call rgetal(375,150,1.0,ts) if (ts.le.0.0) go to 20 go to 10 30 call txt824(480,150,6,t2,15) call txt824(375,150,6,t2,16) call txt824(50,150,48,tl,16) call txt824(50,170,34,t3,16) return end C C C $debug C C *** INSTELLING SIMULATIEDUUR *** C

character*80 tl,t2 C

10 tl='de simulatieduur is: tijdstappen' write (t2,'(i5)') ntsim

call txt824(50,200,37,tl,2) call txt824(210,200,5,t2,15) call ok(50,250,1) if (i.eq.l) go to 20 call igetal(210,200,9999,ntsim) go to 10 20 call txt824(490,200,5,t2,15) call txt824(210,200,5,t2,16) call txt824(50,200,37,tl,16) return end C C

c

$debug C subroutine optl8 subroutine optl9(1)

C *** TIJDSTIPPEN VOOR EEN VOERTUIGLIJST *** C *** OF DETEKTORINFORMATIE *** C

(49)

common /al2/ nlijst,lijst(50),ninfo,info(50) common /a20/ nhulp,khulp(5O)

C

itel=0

10 tl='de tijdstippen waarop een voertuiglijst'

if (l.eq.2) tl='de tijdstippen waarop detektorinformatie' t2='naar de uitvoerfile wordt weggeschreven zijn:'

call txt824(50,250,40,tl,2) call txt824(50,265,45,t2,2) if (I.eq.l) then nhulp=nlijst do 20 1=1,nhulp khulpd) =lijst d ) 20 continue else nhulp=ninfo do 30 1=1,ninfo khulp(i)=info(i) 30 continue end if 40 call tijden(0,290,10) if (itel.eq.l) go to 50 C C KEUZEMENU io2=l jo2=l call ok(50,400,i) if (i.eq.l) go to 400 50 call menul

call menu(50,100,0,2 0,1,4,4,io2,in2,jo2,jn2,12) n=l m=l call nmenu(n,m,10) C go to (100,200,300,400) jn2 C

C OPTIE 1: TIJDSTIP TOEVOEGEN 100 if (nhulp.eq.50) go to 120

t3='het nieuwe tijdstip is:' call txt824(50,200,23,t3,2) call igetal(250,200,9999,k) call txt824{50,200,23,t3,16) do 110 1=1,nhulp if (k.eq.O.or.k.eq.khulpd)) go to 120 110 continue nhulp=nhulp+l khulp(nhulp)=k call sort(-l) 120 itel=l go to 40 C ; . C OPTIE 2: TIJDSTIP WIJZIGEN

200 io3=l

jo3 = l

t3='geef aan welk tijdstip u wilt wijzigen' call txt824(50,200,38,t3,2)

call menu(0,270,40,20,n,m,nhulp,io3,in3,jo3,jn3,15) ihulp={jn3-l)*10+in3

call tijden(0,290,10)

call txt824(50,200,38,t3,16) write (t3,'(i4)') khulp(ihulp) t4='tijdstip: ,wordt tijdstip:' call txt824(50,200,30,t4,2)

(50)

call igetal(290,200,9999,k) do 210 1=1,nhulp if (k.eq.O.or.k.eq.khulpd)) go to 220 210 continue khulp(ihulp)=k call sort(-l) 220 call txt824(50,200,30,t4,16) call txt824(130,200,4,t3,16) itel=l go to 40 C

C OPTIE 3: TIJDSTIP VERWIJDEREN 300 io3=l

jo3=l

t3='geef aan welk tijdstip u wilt verwijderen' call txt824(50,200,41,t3,2) call menu(O,270,4O,2O,n,m,nhulp,io3,in3,jo3,jn3,15) call txt824(50,200,41,t3,16) ihulp=(jn3-l)*10+in3 khulp(ihulp)=0 if (nhulp.eq.l) go to 310 call sort(-l) 310 itel=l go to 40 C

C OPTIE 4: TIJDSTIPPEN AKKOORD 400 call wrtm24(2) call txt824(50,250,40,tl,2) call txt824(50,265,45,t2,2) call ti3den(0,290,10) call wrtm24(1) if (I.eq.l) then nlijst=nhulp do 410 i=l,nlijst lijst(i)=khulp(i) 410 continue else ninfo=nhulp do 420 1=1,ninfo info(i)=khulp{i) 420 continue end if return end C C C subroutine tijden(ixx,iyy,k) $debug C

C *** AFDRUKKEN VAN TIJDSTIPPEN *** C

common /a20/ nhulp,khulp(50) C character*4 t C ix=0 iy=0 do 10 1=1,nhulp write (t,'(i4)') k h u l p d )

call txt824 (ixx+d-ix) *40,iyy+iy*20,4,t,15) if (k*(i/k).eq.i) then

iy=iy+l ix=ix+k end if 10 continue

(51)

return end C C

c

subroutine opt20 $debug C C *** INTENSITEITENVERLOOP *** C

common /al/ lo(10,10),opties(10,10) common /a3/ itype (8,20)

common /all/ irand,ts,ntsim

common /al3/ nq(8),itq(8,50),iq(8,50)

common /al5/ nvoed,kvoed(2,8),nbest,kbest(2,8) common /a2 0/ nhulp,khulp(50)

C

C SCHERMOPMAAK EN TEKENEN SITUATIE call teken

call txt824(250,25,27,'3.4.1 INTENSITEITENVERLOOP',10) call txt824(70,215,20,'intensiteitenverloop',2)

call txt824(70,230,16,'van voedingspunt',2) C C SCHAALVERDELING call bgnp24(59,245) call line24(59,426,2) call line24(260,426,2) call txt824(10,225,5,'mvt/u',2) call txt824(290,445,1,'s',2) do 10 1=0,6 call bgnp24(59,425-1*30) call line24(55,425-1*30,2) write (t3,'(i4)') 1*500 call txt824(15,430-i*30,4,t3,2) 10 continue ix=0 • : do 20 1=0,ntsim,300 ixx=60+1*200/ntsim if (ixx-ix.ge.40) then call bgnp24(ixx,426) call line24dxx,430,2) write (t3,' (14)') 1 . • call txt824 (ixx-18,445,4,t3,2) .• .' ix=ixx 'i';.'' • end if • , .^••; 20 continue ' -f C ''-'

C AANGEVEN PLAATS BESCHOUWDE VOEDINGSPUNT if (nvoed.eq.O) go to 500 do 25 1=1,nvoed write (tl,' (il)') i call txt824(kvoed(l,i),kvoed(2,1) ,l,tl,12) 25 continue ivoed=l 30 call wrtm24(0)

write (tl,' (il)') ivoed

call txt824(kvoed(1,ivoed),kvoed(2,ivoed),1,tl,12) call wrtm24 d )

call txt824(220,230,l,tl,12) C

C SCHRIJVEN EN TEKENEN INTENSITEITENVERLOOP t3='tijdstippen waarop de intensiteit wijzigt:'