123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503 |
- PROGRAM SCBD
- IMPLICIT REAL*8 (A-H,O-Z)
- COMMON /PB/ NPROB
- INCLUDE "param.inc"
- DIMENSION X(10), W(3000), IACT(51)
- DIMENSION XL(10), XU(10)
- CHARACTER LINE0,LINE1,LINE2,LINE3
- DIMENSION LINE0(90),LINE1(90),LINE2(90),LINE3(90)
-
- ZERO=0.0D0
- ONE=1.0D0
- TWO=2.0D0
- EPS = 1.0D-9
- NMAX = 25
- CALL PARAM("scbd.dat",PSC,PCE,PSE,BB,TAUSC,TAUCE,TAUSE,
- 1 FSC,FCE,FSE,AA)
- CW = VAL * CW
- SC = VAL * SC
- ASCR = VAL * ASCR
- ACER = VAL * ACER
- ASER = VAL * ASER
- DO 1, I=1,90
- LINE0(I)='-'
- LINE1(I)='='
- LINE2(I)='='
- LINE3(I)='='
- 1 CONTINUE
- LINE2(20)='N'
- LINE2(21)='0'
- LINE2(23)='T'
- LINE2(24)='R'
- LINE2(25)='A'
- LINE2(26)='I'
- LINE2(27)='N'
- LINE2(29)='S'
- LINE2(30)='E'
- LINE3(18)='W'
- LINE3(19)='I'
- LINE3(20)='T'
- LINE3(21)='H'
- LINE3(23)='T'
- LINE3(24)='R'
- LINE3(25)='A'
- LINE3(26)='I'
- LINE3(27)='N'
- LINE3(29)='S'
- LINE3(30)='E'
- C (* fixed costs, free-flow travel times *)
- dTse=DSQRT(dTsc*dTsc+dTce*dTce-2*dTsc*dTce*DCOS(theta))
- dRse=DSQRT(dRsc*dRsc+dRce*dRce-2*dRsc*dRce*DCOS(theta))
- Fsct=dTsc/sTsc*val
- Fcet=dTce/sTce*val
- Fset=dTse/sTse*val
- Fscr=dRsc/sRsc*val
- Fcer=dRce/sRce*val
- Fser=dRse/sRse*val
- C Fser=(theta*dRsc)/sRse*val
- POP = POPSC+POPCE+POPSE
- PRINT '(6F9.2)', FSCT, FCET, FSET, FSCR, FCER, FSER
- C ------------------------
- C Head of the output table
- C ------------------------
- PRINT '(90A)', LINE1
- WRITE (*, '(3X,A10,9X,A15,22X,A15)') 'ADM REGIME','TRAIN','ROADS'
- PRINT '(90A)', LINE0
- WRITE (*, '(16X,4A8,5X,4A8)') 'SC','CE','SE','AGR',
- & 'SC','CE','SE','AGR'
- PRINT '(90A)', LINE2
- C ------------------------
- C 1 -- COMPUTE THE OPTIMUM
- C ------------------------
- ID=1
- DO 10, I = 1,NMAX
- CALL OPTIMUM (TC,USCT,UCET,USET,FSC,FCE,FSE,AA,
- 1 PSC,PCE,BB,TAUSC,TAUCE,TAUSE,ID)
- TMP1 = DSQRT(CW*(USCT+USET)/(TWO*PHI))
- TMP2 = DSQRT(CW*(UCET+USET)/(TWO*PHI))
- TMP3 = (TMP1-FSC)**2+(TMP2-FCE)**2
- IF(TMP3.LT.EPS) GOTO 11
- FSC = TMP1
- FCE = TMP2
- 10 CONTINUE
- 11 CONTINUE
- IF(I.EQ.NMAX+1) PRINT*,'No convergence after ',NMAX,' iterations'
- WRITE (*, '(A12,35X,F8.4)' ) 'Optimum', TC
- POPTRAIN = USCT+UCET+USET
- POPCAR = POP-POPTRAIN
- WRITE (*, '(11X,A5,4F8.2,5X,4F8.2)') 'Users',
- & USCT,UCET,USET,POPTRAIN,
- & POPSC-USCT,POPCE-UCET,POPSE-USET,POPCAR
- C1T=FSCT+CW/(TWO*FSC)+ASCT*(USCT+USET)/FSC
- C2T=FCET+CW/(TWO*FCE)+ACET*(UCET+USET)/FCE
- C3T=C1T+C2T-AA*CW/(TWO*FSC)+(ONE-AA)*SC
- CT =(USCT*C1T+UCET*C2T+USET*C3T)/(USCT+UCET+USET)
- C1R=FSCR+ASCR*(POPSC-USCT)
- C2R=FCER+ACER*(POPCE-UCET)
- C3R=FSER+ASER*(POPSE-USET)
- CR =((POPSC-USCT)*C1R+(POPCE-UCET)*C2R+(POPSE-USET)*C3R)/
- & (POPSC+POPCE+POPSE-USCT-UCET-USET)
- WRITE (*, '(11X,A5,4F8.2,5X,4F8.2,5X)') 'Costs',
- & C1T,C2T,C3T,CT,C1R,C2R,C3R,CR
- WRITE (*, '(11X,A5,2F8.2)') 'Freq.',FSC,FCE
- WRITE (*, '(11X,A5,4F8.2)') 'Fares',PSC,PCE,BB*(PSC+PCE),
- & PSC*USCT+PCE*UCET+PSE*USET
- WRITE (*, '(11X,A5,37X,4F8.2)') 'Tolls',TAUSC,TAUCE,TAUSE,
- & (POPSC-USCT)*TAUSC+(POPCE-UCET)*TAUCE+(POPSE-USET)*TAUSE
- PRINT '(90A)', LINE0
- C ------------------------
- C 2 -- BETA LIMITED: BETA <= BETA_MAX
- C ------------------------
- TAUSC=ZERO
- TAUCE=ZERO
- TAUSE=ZERO
- PSC =ZERO
- PCE =ZERO
- BB = 1.0D0
- DO 20, I=1, NMAX
- CALL BETAFIXED (FSC,FCE,AA,PSC,PCE,BB,TAUSC,TAUCE,TAUSE,
- 1 USCT,UCET,USET,TC)
- TMP1 = DSQRT(CW*(USCT+USET)/(TWO*PHI))
- TMP2 = DSQRT(CW*(UCET+USET)/(TWO*PHI))
- TMP3 = (TMP1-FSC)**2+(TMP2-FCE)**2
- IF(TMP3.LT.EPS) GOTO 21
- FSC = TMP1
- FCE = TMP2
- 20 CONTINUE
- 21 CONTINUE
- IF(I.EQ.NMAX+1) PRINT*,'No convergence after ',NMAX,' iterations'
- WRITE (*, '(A12,35X,F8.4)' ) 'Beta bounded',TC
- POPTRAIN = USCT+UCET+USET
- POPCAR = POP-POPTRAIN
- WRITE (*, '(11X,A5,4F8.2,5X,4F8.2)') 'Users',
- & USCT,UCET,USET,POPTRAIN,
- & POPSC-USCT,POPCE-UCET,POPSE-USET,POPCAR
- C1T=FSCT+CW/(TWO*FSC)+ASCT*(USCT+USET)/FSC
- C2T=FCET+CW/(TWO*FCE)+ACET*(UCET+USET)/FCE
- C3T=C1T+C2T-AA*CW/(TWO*FSC)+(ONE-AA)*SC
- CT =(USCT*C1T+UCET*C2T+USET*C3T)/(USCT+UCET+USET)
- C1R=FSCR+ASCR*(POPSC-USCT)
- C2R=FCER+ACER*(POPCE-UCET)
- C3R=FSER+ASER*(POPSE-USET)
- CR =((POPSC-USCT)*C1R+(POPCE-UCET)*C2R+(POPSE-USET)*C3R)/
- & (POPSC+POPCE+POPSE-USCT-UCET-USET)
- WRITE (*, '(11X,A5,4F8.2,5X,4F8.2,5X)') 'Costs',
- & C1T,C2T,C3T,CT,C1R,C2R,C3R,CR
- WRITE (*, '(11X,A5,2F8.2)') 'Freq.',FSC,FCE
- WRITE (*, '(11X,A5,4F8.2)') 'Fares',PSC,PCE,BB*(PSC+PCE),
- & PSC*USCT+PCE*UCET+PSE*USET
- WRITE (*, '(11X,A5,37X,4F8.2)') 'Tolls',TAUSC,TAUCE,TAUSE,
- & (POPSC-USCT)*TAUSC+(POPCE-UCET)*TAUCE+(POPSE-USET)*TAUSE
- PRINT '(90A)', LINE0
- CC -------------------------
- CC 2 -- UNPRICED EQUILIBRIUM
- CC -------------------------
- ID = 2
- DO 30, I=1, NMAX
- CALL EQUILIBRIUM (TC,USCT,UCET,USET,FSC,FCE,FSE,AA,
- 1 ZERO,ZERO,ZERO,ZERO,ZERO,ZERO,ID)
- TMP1 = DSQRT(CW*(USCT+USET)/(TWO*PHI))
- TMP2 = DSQRT(CW*(UCET+USET)/(TWO*PHI))
- TMP3 = (TMP1-FSC)**2+(TMP2-FCE)**2
- IF(TMP3.LT.EPS) GOTO 31
- FSC = TMP1
- FCE = TMP2
- 30 CONTINUE
- 31 CONTINUE
- IF(I.EQ.NMAX+1) PRINT*,'No convergence after ',NMAX,' iterations'
- POPTRAIN = USCT+UCET+USET
- POPCAR = POP-POPTRAIN
- WRITE (*, '(A12,35X,F8.4)' ) 'Unpriced', TC
- WRITE (*, '(11X,A5,4F8.2,5X,4F8.2)') 'Users',
- & USCT,UCET,USET,POPTRAIN,
- & POPSC-USCT,POPCE-UCET,POPSE-USET,POPCAR
- C1T=FSCT+CW/(TWO*FSC)+ASCT*(USCT+USET)/FSC
- C2T=FCET+CW/(TWO*FCE)+ACET*(UCET+USET)/FCE
- C3T=C1T+C2T-AA*CW/(TWO*FSC)+(ONE-AA)*SC
- CT =(USCT*C1T+UCET*C2T+USET*C3T)/(USCT+UCET+USET)
- C1R=FSCR+ASCR*(POPSC-USCT)
- C2R=FCER+ACER*(POPCE-UCET)
- C3R=FSER+ASER*(POPSE-USET)
- CR =((POPSC-USCT)*C1R+(POPCE-UCET)*C2R+(POPSE-USET)*C3R)/
- & (POPSC+POPCE+POPSE-USCT-UCET-USET)
- WRITE (*, '(11X,A5,4F8.2,5X,4F8.2)') 'Costs',
- & C1T,C2T,C3T,CT,C1R,C2R,C3R,CR
- WRITE (*, '(11X,A5,2F8.2)') 'Freq.',FSC,FCE
- PRINT '(90A)', LINE0
- CC -----------------------
- CC 2 -- PRICED EQUILIBRIUM
- CC -----------------------
- C TAUSC= ZERO
- C TAUCE= ZERO
- C TAUSE= ZERO
- C PSC = -0.97D0
- C PCE = -0.97D0
- C BB = 0.74D0
- C PRINT*, '---------PRICED EQUIL'
- C CALL EQUILIBRIUM (TC,USCT,UCET,USET,FSC,FCE,AA,
- C 1 PSC,PCE,BB,TAUSC,TAUCE,TAUSE)
- C WRITE (*,'(4F9.4)') TC, USCT,UCET,USET
- CC -----------------------
- CC 2 -- ROAD PROFIT
- CC -----------------------
- DO 40, I=1, NMAX
- CALL PRFROAD (PRFR,TC,USCT,UCET,USET,FSC,FCE,AA,
- 1 ZERO,ZERO,ZERO,TAUSC,TAUCE,TAUSE)
- TMP1 = DSQRT(CW*(USCT+USET)/(TWO*PHI))
- TMP2 = DSQRT(CW*(UCET+USET)/(TWO*PHI))
- TMP3 = (TMP1-FSC)**2+(TMP2-FCE)**2
- IF(TMP3.LT.EPS) GOTO 41
- FSC = TMP1
- FCE = TMP2
- 40 CONTINUE
- 41 CONTINUE
- IF(I.EQ.NMAX+1) PRINT*,'No convergence after ',NMAX,' iterations'
- C WRITE (*,'(8F9.4)') TC, USCT,UCET,USET,PRFR,TAUSC,TAUCE,TAUSE
- WRITE (*, '(A12,35X,F8.4)' ) 'Road prf', TC
- POPTRAIN = USCT+UCET+USET
- POPCAR = POP-POPTRAIN
- WRITE (*, '(11X,A5,4F8.2,5X,4F8.2)') 'Users',
- & USCT,UCET,USET,POPTRAIN,
- & POPSC-USCT,POPCE-UCET,POPSE-USET,POPCAR
- C1T=FSCT+CW/(TWO*FSC)+ASCT*(USCT+USET)/FSC
- C2T=FCET+CW/(TWO*FCE)+ACET*(UCET+USET)/FCE
- C3T=C1T+C2T-AA*CW/(TWO*FSC)+(ONE-AA)*SC
- CT =(USCT*C1T+UCET*C2T+USET*C3T)/(USCT+UCET+USET)
- C1R=FSCR+ASCR*(POPSC-USCT)
- C2R=FCER+ACER*(POPCE-UCET)
- C3R=FSER+ASER*(POPSE-USET)
- CR =((POPSC-USCT)*C1R+(POPCE-UCET)*C2R+(POPSE-USET)*C3R)/
- & (POPSC+POPCE+POPSE-USCT-UCET-USET)
- WRITE (*, '(11X,A5,4F8.2,5X,4F8.2,5X)') 'Costs',
- & C1T,C2T,C3T,CT,C1R,C2R,C3R,CR
- WRITE (*, '(11X,A5,2F8.2)') 'Freq.',FSC,FCE
- WRITE (*, '(11X,A5,37X,4F8.2)') 'Tolls',TAUSC,TAUCE,TAUSE,PRFR
- PRINT '(90A)', LINE0
- CC --------------------
- CC 2 -- TRAIN PROFIT
- CC --------------------
- DO 50, I=1, NMAX
- CALL PRFTRAIN (PRFT,TC,USCT,UCET,USET,FSC,FCE,AA,
- 1 PSC,PCE,BB,ZERO,ZERO,ZERO)
- TMP1 = DSQRT(CW*(USCT+USET)/(TWO*PHI))
- TMP2 = DSQRT(CW*(UCET+USET)/(TWO*PHI))
- TMP3 = (TMP1-FSC)**2+(TMP2-FCE)**2
- IF(TMP3.LT.EPS) GOTO 51
- FSC = TMP1
- FCE = TMP2
- 50 CONTINUE
- 51 CONTINUE
- IF(I.EQ.NMAX+1) PRINT*,'No convergence after ',NMAX,' iterations'
- WRITE (*, '(A12,35X,F8.4)' ) 'Train prf', TC
- POPTRAIN = USCT+UCET+USET
- POPCAR = POP-POPTRAIN
- WRITE (*, '(11X,A5,4F8.2,5X,4F8.2)') 'Users',
- & USCT,UCET,USET,POPTRAIN,
- & POPSC-USCT,POPCE-UCET,POPSE-USET,POPCAR
- C1T=FSCT+CW/(TWO*FSC)+ASCT*(USCT+USET)/FSC
- C2T=FCET+CW/(TWO*FCE)+ACET*(UCET+USET)/FCE
- C3T=C1T+C2T-AA*CW/(TWO*FSC)+(ONE-AA)*SC
- CT =(USCT*C1T+UCET*C2T+USET*C3T)/(USCT+UCET+USET)
- C1R=FSCR+ASCR*(POPSC-USCT)
- C2R=FCER+ACER*(POPCE-UCET)
- C3R=FSER+ASER*(POPSE-USET)
- CR =((POPSC-USCT)*C1R+(POPCE-UCET)*C2R+(POPSE-USET)*C3R)/
- & (POPSC+POPCE+POPSE-USCT-UCET-USET)
- WRITE (*, '(11X,A5,4F8.2,5X,4F8.2,5X)') 'Costs',
- & C1T,C2T,C3T,CT,C1R,C2R,C3R,CR
- WRITE (*, '(11X,A5,2F8.2)') 'Freq.',FSC,FCE
- WRITE (*, '(11X,A5,4F8.2)') 'Fares',PSC,PCE,BB*(PSC+PCE),PRFT
- PRINT '(90A)', LINE0
- CC --------------------
- CC 2 -- SEMI-PUBLIC
- CC --------------------
- PSC = ZERO
- PCE = ZERO
- PSE = ZERO
- DO 60, I=1, NMAX
- CALL SEMIPUBLIC (PRFT,PRFR,TC,USCT,UCET,USET,FSC,FCE,AA,
- 1 PSC,PCE,BB,TAUSC,TAUCE,TAUSE)
- TMP1 = DSQRT(CW*(USCT+USET)/(TWO*PHI))
- TMP2 = DSQRT(CW*(UCET+USET)/(TWO*PHI))
- TMP3 = (TMP1-FSC)**2+(TMP2-FCE)**2
- IF(TMP3.LT.EPS) GOTO 61
- FSC = TMP1
- FCE = TMP2
- 60 CONTINUE
- 61 CONTINUE
- IF(I.EQ.NMAX+1) PRINT*,'No convergence after ',NMAX,' iterations'
- WRITE (*, '(A12,35X,F8.4)' ) 'Semi-pub', TC
- POPTRAIN = USCT+UCET+USET
- POPCAR = POP-POPTRAIN
- WRITE (*, '(11X,A5,4F8.2,5X,4F8.2)') 'Users',
- & USCT,UCET,USET,POPTRAIN,
- & POPSC-USCT,POPCE-UCET,POPSE-USET,POPCAR
- C1T=FSCT+CW/(TWO*FSC)+ASCT*(USCT+USET)/FSC
- C2T=FCET+CW/(TWO*FCE)+ACET*(UCET+USET)/FCE
- C3T=C1T+C2T-AA*CW/(TWO*FSC)+(ONE-AA)*SC
- CT =(USCT*C1T+UCET*C2T+USET*C3T)/(USCT+UCET+USET)
- C1R=FSCR+ASCR*(POPSC-USCT)
- C2R=FCER+ACER*(POPCE-UCET)
- C3R=FSER+ASER*(POPSE-USET)
- CR =((POPSC-USCT)*C1R+(POPCE-UCET)*C2R+(POPSE-USET)*C3R)/
- & (POPSC+POPCE+POPSE-USCT-UCET-USET)
- WRITE (*, '(11X,A5,4F8.2,5X,4F8.2,5X)') 'Costs',
- & C1T,C2T,C3T,CT,C1R,C2R,C3R,CR
- WRITE (*, '(11X,A5,2F8.2)') 'Freq.',FSC,FCE
- WRITE (*, '(11X,A5,4F8.2)') 'Fares',PSC,PCE,BB*(PSC+PCE),PRFT
- WRITE (*, '(11X,A5,37X,4F8.2)') 'Tolls',TAUSC,TAUCE,TAUSE,PRFR
- PRINT '(90A)', LINE0
- CC --------------------
- CC 2 -- DUOPOLY
- CC --------------------
- DO 70, I=1, NMAX
- CALL DUOPOLY (PRFT,PRFR,TC,USCT,UCET,USET,FSC,FCE,AA,
- 1 PSC,PCE,BB,TAUSC,TAUCE,TAUSE)
- TMP1 = DSQRT(CW*(USCT+USET)/(TWO*PHI))
- TMP2 = DSQRT(CW*(UCET+USET)/(TWO*PHI))
- TMP3 = (TMP1-FSC)**2+(TMP2-FCE)**2
- IF(TMP3.LT.EPS) GOTO 71
- FSC = TMP1
- FCE = TMP2
- 70 CONTINUE
- 71 CONTINUE
- IF(I.EQ.NMAX+1) PRINT*,'No convergence after ',NMAX,' iterations'
- WRITE (*, '(A12,35X,F8.4)' ) 'Duopoly', TC
- POPTRAIN = USCT+UCET+USET
- POPCAR = POP-POPTRAIN
- WRITE (*, '(11X,A5,4F8.2,5X,4F8.2)') 'Users',
- & USCT,UCET,USET,POPTRAIN,
- & POPSC-USCT,POPCE-UCET,POPSE-USET,POPCAR
- C1T=FSCT+CW/(TWO*FSC)+ASCT*(USCT+USET)/FSC
- C2T=FCET+CW/(TWO*FCE)+ACET*(UCET+USET)/FCE
- C3T=C1T+C2T-AA*CW/(TWO*FSC)+(ONE-AA)*SC
- CT =(USCT*C1T+UCET*C2T+USET*C3T)/(USCT+UCET+USET)
- C1R=FSCR+ASCR*(POPSC-USCT)
- C2R=FCER+ACER*(POPCE-UCET)
- C3R=FSER+ASER*(POPSE-USET)
- CR =((POPSC-USCT)*C1R+(POPCE-UCET)*C2R+(POPSE-USET)*C3R)/
- & (POPSC+POPCE+POPSE-USCT-UCET-USET)
- WRITE (*, '(11X,A5,4F8.2,5X,4F8.2,5X)') 'Costs',
- & C1T,C2T,C3T,CT,C1R,C2R,C3R,CR
- WRITE (*, '(11X,A5,2F8.2)') 'Freq.',FSC,FCE
- WRITE (*, '(11X,A5,4F8.2)') 'Fares',PSC,PCE,BB*(PSC+PCE),PRFT
- WRITE (*, '(11X,A5,37X,4F8.2)') 'Tolls',TAUSC,TAUCE,TAUSE,PRFR
- PRINT '(90A)', LINE3
- WRITE (*, '(16X,4A8,5X,4A8)') 'SC','CE','SE','AGR',
- & 'SC','CE','SE','AGR'
- PRINT '(90A)', LINE0
- C ---------------------------------------------
- C 1 -- COMPUTE THE OPTIMUM WITH DIRECT TRAIN SE
- C ---------------------------------------------
- ID=10
- DO 100, I=1, NMAX
- CALL OPTIMUM (TC,USCT,UCET,USET,FSC,FCE,FSE,AA,
- 1 PSC,PCE,BB,TAUSC,TAUCE,TAUSE,ID)
- TMP1 = DSQRT(CW*USCT/(TWO*PHI))
- TMP2 = DSQRT(CW*UCET/(TWO*PHI))
- TMP3 = DSQRT(CW*USET/(TWO*PHI))
- TMP4 = (TMP1-FSC)**2+(TMP2-FCE)**2
- IF(TMP4.LT.EPS) GOTO 101
- FSC = TMP1
- FCE = TMP2
- FSE = TMP3
- 100 CONTINUE
- 101 CONTINUE
- IF(I.EQ.NMAX+1) PRINT*,'No convergence after ',NMAX,' iterations'
- WRITE (*, '(A12,35X,F8.4)' ) 'Optimum', TC
- POPTRAIN = USCT+UCET+USET
- POPCAR = POP-POPTRAIN
- WRITE (*, '(11X,A5,4F8.2,5X,4F8.2)') 'Users',
- & USCT,UCET,USET,POPTRAIN,
- & POPSC-USCT,POPCE-UCET,POPSE-USET,POPCAR
- C1T=FSCT+CW/(TWO*FSC)+ASCT*USCT/FSC
- C2T=FCET+CW/(TWO*FCE)+ACET*UCET/FCE
- C3T=FSET+CW/(TWO*FSE)+ASET*USET/FCE
- CT =(USCT*C1T+UCET*C2T+USET*C3T)/(USCT+UCET+USET)
- C1R=FSCR+ASCR*(POPSC-USCT)
- C2R=FCER+ACER*(POPCE-UCET)
- C3R=FSER+ASER*(POPSE-USET)
- CR =((POPSC-USCT)*C1R+(POPCE-UCET)*C2R+(POPSE-USET)*C3R)/
- & (POPSC+POPCE+POPSE-USCT-UCET-USET)
- WRITE (*, '(11X,A5,4F8.2,5X,4F8.2)') 'Costs',
- & C1T,C2T,C3T,CT,C1R,C2R,C3R,CR
- WRITE (*, '(11X,A5,3F8.2)') 'Freq.',FSC,FCE,FSE
- WRITE (*, '(11X,A5,4F8.2)') 'Fares',PSC,PCE,BB,
- & PSC*USCT+PCE*UCET+PSE*USET
- WRITE (*, '(11X,A5,37X,4F8.2)') 'Tolls',TAUSC,TAUCE,TAUSE,
- & (POPSC-USCT)*TAUSC+(POPCE-UCET)*TAUCE+(POPSE-USET)*TAUSE
- PRINT '(90A)', LINE0
- CC ----------------------------------------------
- CC 2 -- UNPRICED EQUILIBRIUM WITH DIRECT TRAIN SE
- CC ----------------------------------------------
- ID = 11
- DO 110, I=1, NMAX
- CALL EQUILIBRIUM (TC,USCT,UCET,USET,FSC,FCE,FSE,AA,
- 1 ZERO,ZERO,ZERO,ZERO,ZERO,ZERO,ID)
- TMP1 = DSQRT(CW*USCT/(TWO*PHI))
- TMP2 = DSQRT(CW*UCET/(TWO*PHI))
- TMP3 = DSQRT(CW*USET/(TWO*PHI))
- TMP4 = (TMP1-FSC)**2+(TMP2-FCE)**2
- IF(TMP4.LT.EPS) GOTO 111
- FSC = TMP1
- FCE = TMP2
- FSE = TMP3
- 110 CONTINUE
- 111 CONTINUE
- IF(I.EQ.NMAX+1) PRINT*,'No convergence after ',NMAX,' iterations'
- WRITE (*, '(A12,35X,F8.4)' ) 'Unpriced', TC
- POPTRAIN = USCT+UCET+USET
- POPCAR = POP-POPTRAIN
- WRITE (*, '(11X,A5,4F8.2,5X,4F8.2)') 'Users',
- & USCT,UCET,USET,POPTRAIN,
- & POPSC-USCT,POPCE-UCET,POPSE-USET,POPCAR
- C1T=FSCT+CW/(TWO*FSC)+ASCT*USCT/FSC
- C2T=FCET+CW/(TWO*FCE)+ACET*UCET/FCE
- C3T=FSET+CW/(TWO*FSE)+ASET*USET/FCE
- CT =(USCT*C1T+UCET*C2T+USET*C3T)/(USCT+UCET+USET)
- C1R=FSCR+ASCR*(POPSC-USCT)
- C2R=FCER+ACER*(POPCE-UCET)
- C3R=FSER+ASER*(POPSE-USET)
- CR =((POPSC-USCT)*C1R+(POPCE-UCET)*C2R+(POPSE-USET)*C3R)/
- & (POPSC+POPCE+POPSE-USCT-UCET-USET)
- WRITE (*, '(11X,A5,4F8.2,5X,4F8.2,5X)') 'Costs',
- & C1T,C2T,C3T,CT,C1R,C2R,C3R,CR
- WRITE (*, '(11X,A5,3F8.2)') 'Freq.',FSC,FCE,FSE
- PRINT '(90A)', LINE1
- END
|