calcfc.f 2.8 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495
  1. SUBROUTINE CALCFC (N,M,X,F,CON)
  2. C Used by COBYLA routine
  3. C Computes aggregate cost and evaluate constraints
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. INCLUDE "param.inc"
  6. DIMENSION Z(14)
  7. DIMENSION X(*),CON(*)
  8. COMMON /PB/ NPROB
  9. COMMON /VARS/ Z
  10. C Some useful constants
  11. ZERO = 0.0D0
  12. ONE = 1.0D0
  13. TWO = 2.0D0
  14. C -------------------------------------------------------------------
  15. C Z (1:14) is a container for parameters passed between subroutines
  16. C
  17. C Z(1:3) NSC, NCE, NSE
  18. C Z(4:6) TAUSC, TAUCE, TAUSE
  19. C Z(7:9) PSC, PCE, PSE
  20. C Z(10:12) FSC, FCE, FSE
  21. C Z(13;14) AA, BB
  22. C
  23. C AA : ALPHA
  24. C BB : BETA
  25. C -------------------------------------------------------------------
  26. C X(1) X(2) X(3) number of users
  27. C X(4) X(5) X(6) tolls
  28. C X(7) X(8) X(9) fares
  29. C -------------------------------------------------------------------
  30. A1 = FSCR + ASCR * (POPSC - X(1))
  31. A2 = FCER + ACER * (POPCE - X(2))
  32. A3 = FSER + ASER * (POPSE - X(3))
  33. A4 = FSCT + CW / (TWO * Z(10)) + ASCT * (X(1) + X(3)) / Z(10)
  34. A5 = FCET + CW / (TWO * Z(11)) + ACET * (X(2) + X(3)) / Z(11)
  35. A6 = A4 + A5 - Z(13) * CW / (TWO * Z(11)) + (ONE - Z(13)) * SC
  36. F = (POPSC - X(1)) * A1 + X(1) * A4 +
  37. 1 (POPCE - X(2)) * A2 + X(2) * A5 +
  38. 2 (POPSE - X(3)) * A3 + X(3) * A6 +
  39. 3 PHI*(Z(10)+Z(11))+EF*Z(13)*Z(13)
  40. F = F / ( POPSC + POPCE + POPSE )
  41. C The following constraints are always met
  42. C 0 <= X(1) <= Nsc
  43. CON(1) = X(1)
  44. CON(2) = POPSC - X(1)
  45. C 0 <= X(2) <= Nce
  46. CON(3) = X(2)
  47. CON(4) = POPCE - X(2)
  48. C 0 <= X(3) <= Nse
  49. CON(5) = X(3)
  50. CON(6) = POPSE - X(3)
  51. C Equal costs for users sc
  52. CON(7) = X(4) + A1 - X(7) - A4
  53. CON(8) = -X(4) - A1 + X(7) + A4
  54. C Equal costs for users ce
  55. CON(9) = X(5) + A2 - X(8) - A5
  56. CON(10) = -X(5) - A2 + X(8) + A5
  57. C Equal costs for users se
  58. CON(11) = X(6) + A3 - X(9) - A6
  59. CON(12) = -X(6) - A3 + X(9) + A6
  60. IF (NPROB.EQ.10) THEN
  61. C Tolls are fixed
  62. CON(13) = X(4) - Z(4)
  63. CON(14) = - X(4) + Z(4)
  64. CON(15) = X(5) - Z(5)
  65. CON(16) = - X(5) + Z(5)
  66. CON(17) = X(6) - Z(6)
  67. CON(18) = - X(6) + Z(6)
  68. ELSEIF (NPROB.EQ.11) THEN
  69. C Fares are fixed
  70. CON(13) = X(7) - Z(7)
  71. CON(14) = - X(7) + Z(7)
  72. CON(15) = X(8) - Z(8)
  73. CON(16) = - X(8) + Z(8)
  74. CON(17) = X(9) - Z(9)
  75. CON(18) = - X(9) + Z(9)
  76. ELSEIF (NPROB.EQ.12) THEN
  77. C Tolls are fixed
  78. CON(13) = X(4) - Z(4)
  79. CON(14) = - X(4) + Z(4)
  80. CON(15) = X(5) - Z(5)
  81. CON(16) = - X(5) + Z(5)
  82. CON(17) = X(6) - Z(6)
  83. CON(18) = - X(6) + Z(6)
  84. CON(19) = - DABS(X(9)) + DABS(Z(14) * ( X(7) + X(8) ))
  85. ENDIF
  86. RETURN
  87. END