; Do not change filenames or add or remove FILEI/FILEO statements using an editor. Use Cube/Application Manager.
RUN PGM=GENERATION PRNFILE="{Scenario_Dir}\OUTPUT\TGGEN00A.PRN"
FILEO PAO[1] = "{Scenario_Dir}\OUTPUT\PANDA_{ALT}{Year}.DBF",
LIST=Z,P[1],P[2],P[3],P[4],P[5],P[6],P[7],A[1],A[2],A[3],A[4],A[5],A[6],A[7],DBF=T
FILEO PRINTO[2] = "{Scenario_Dir}\OUTPUT\GENERRORS.PRN"
FILEO PRINTO[1] = "{Scenario_Dir}\OUTPUT\GENSUMMARY.PRN"
FILEI ZDATI[4] = "{SCENARIO_DIR}\Input\SPECGEN_P_{Year}{ALT}.DBF"
FILEI ZDATI[3] = "{SCENARIO_DIR}\Input\INTEXT_{Year}{ALT}.DBF"
FILEI ZDATI[2] = "{SCENARIO_DIR}\Input\SPECGEN_A_{Year}{ALT}.DBF"
FILEI ZDATI[1] = "{SCENARIO_DIR}\Input\ZONEDATA_{Year}{ALT}.dbf"
FILEI LOOKUPI[4] = "{Scenario_Dir}\OUTPUT\ARATES.DBF"
FILEI LOOKUPI[3] = "{Scenario_Dir}\OUTPUT\DUWEIGHTS.DBF"
FILEI LOOKUPI[2] = "{Scenario_Dir}\OUTPUT\GENRATESNP.DBF"
FILEI LOOKUPI[1] = "{Scenario_Dir}\OUTPUT\GENRATES.DBF"


; ================================================================
; OVERALL PROGRAM CONTROLS

PARAMETERS ZONES={ZONESA}, ZONEMSG=100

ARRAY CAR=4 CELL=999 CELLT=999 SPAFRAC=12 SPPFRAC=12
ARRAY PERDU=3 NDU=3 ODU=3
ARRAY HHCATN=999 THOUSEN=999 THHCATN=999 TTRIPHN=999
ARRAY HHCAT=999  THOUSE=999  THHCAT=999 TTRIPH=999

LOOKUP LOOKUPI=1,
       NAME=PRATE, ;TRIP PRODUCTION RATES PERMANENT POPULATION
         LOOKUP[1]=PAD, RESULT=PRATEHBW,
         LOOKUP[2]=PAD, RESULT=PRATEHBSH,
         LOOKUP[3]=PAD, RESULT=PRATEHBSR,
         LOOKUP[4]=PAD, RESULT=PRATEHBO,
       FAIL[1]=0,FAIL[2]=0,FAIL[3]=0, INTERPOLATE=N, LIST=N

LOOKUP LOOKUPI=2,
       NAME=PRATENP, ;TRIP ATTRACTION RATES NON PERMANENT POPULATION
         LOOKUP[1]=PAD, RESULT=PRATEHBW,
         LOOKUP[2]=PAD, RESULT=PRATEHBSH,
         LOOKUP[3]=PAD, RESULT=PRATEHBSR,
         LOOKUP[4]=PAD, RESULT=PRATEHBO,
       FAIL[1]=0,FAIL[2]=0,FAIL[3]=0, INTERPOLATE=N, LIST=N

LOOKUP LOOKUPI=3,
       NAME=DUWEIGHT, 
         LOOKUP[1]=SIZERANGE, RESULT=PCT1PER, ; %1 PERSON
         LOOKUP[2]=SIZERANGE, RESULT=PCT2PER, ; %2 PERSON
         LOOKUP[3]=SIZERANGE, RESULT=PCT3PER, ; %3 PERSON
         LOOKUP[4]=SIZERANGE, RESULT=PCT4PER, ; %4 PERSON
         LOOKUP[5]=SIZERANGE, RESULT=PCT5PER, ; %5+PERSON
       INTERPOLATE=N, LIST=N

LOOKUP LOOKUPI=4,
       NAME=ARATE, ;TRIP ATTRACTION RATES
       LOOKUP[1]=PURPOSE, RESULT=ARATEIND,
       LOOKUP[2]=PURPOSE, RESULT=ARATECOM,
       LOOKUP[3]=PURPOSE, RESULT=ARATESVC,
       LOOKUP[4]=PURPOSE, RESULT=ARATETOT,
       LOOKUP[5]=PURPOSE, RESULT=ARATEDUS,
       LOOKUP[6]=PURPOSE, RESULT=ARATESCH,
     FAIL[1]=0,FAIL[2]=0,FAIL[3]=0, INTERPOLATE=N, LIST=y

PROCESS PHASE=ILOOP 

; . . . . . . . . . . . . . . . . . . 

; Calculation of Resident Population per DU

      OPDUS = ZI.1.SFDU * (1. - (ZI.1.SF_PCTVNP/100.))
      OPDUM = ZI.1.MFDU * (1. - (ZI.1.MF_PCTVNP/100.))

      IF(OPDUS<=0.0)
      PERDUS=0.0
      ELSE
      PERDUS = ZI.1.SFPOP/OPDUS
      IF(PERDUS>5.99) PERDUS = 5.99
      ENDIF

      IF(OPDUM<=0.0)
      PERDUM = 0.0
      ELSE
      PERDUM = ZI.1.MFPOP/OPDUM
      IF(PERDUM>5.99) PERDUM = 5.99
      ENDIF

;---------------
;  CALCULATION OF HOTEL-MOTEL POPULATION PER DU
;
      ODUH   = ZI.1.HMDU * (ZI.1.HMOCC/100.)
      IF(ODUH<=0.0)
      PERDUH=0.0
      ELSE
      PERDUH = ZI.1.HMPOP/ODUH
      IF(PERDUH>5.99) PERDUH = 5.99
      ENDIF

;-------------
;  DETERMINATION OF RANGE OF POP. PER DU AND INTERPOLATION FOR RATE OF
;    TRIPS PER DU FOR A GIVEN DU TYPE AND PURPOSE.
;
;     THE POINT-SLOPE FORMULA IS USED, WITH THE MIDPOINTS OF THE
;     PERSONS PER DU RANGES BEING THE X'S, AND THE TRIP RATES FOR
;     THE GIVEN MIDPOINTS FROM THE HBLK MATRIX BEING THE Y'S.
;              SLOPE=(Y2-Y1)/(X2-X1)=M, IN TRADITIONAL NOTATION.
;              Y= MX+B, FOR ANY X AND Y.
;              B=Y2-MX2, FOR Y=Y2.
;              Y=MX+Y2-MX2, OR
;              Y=M(X-X2)+Y2.
;     IF X IS A PERDU(1),(2), OR (3), CALCULATED FROM THE ZDATA1
;     CARD, ITS FOUR HB-PURPOSE RATES ARE CALCULATED AS FOUR Y'S
;     FROM THE EQUATION.  THE ACTUAL RATE FOR A GIVEN PURPOSE AND
;     SF-MF-HM VALUE IS THE WEIGHTED SUM OF 3 INTERPOLATED RATES.  THE
;     WEIGHTS ARE THE PERCENTAGES OF 0,1, AND 2+ AUTO HOUSEHOLDS READ
;     FROM THE ZDATA1 CARD. THE PROPER SLOPES TO USE ARE FIRST CALCU-
;     LATED AS IF EACH PERDU RANGE HAD A WIDTH OF .25. EXCEPT THE
;     16TH ON AND THE LAST ONE WHICH IS OPEN ENDED.  YOU CAN'T HAVE
;     A ZONE USE THE LAST ONE AND STILL INTERPOLATE.  NOTE NSLOPE(17)
;     SPECIFIED ON PAGE 89 OF MUI,TASK B.
;
      PERDU[1] = PERDUS
      PERDU[2] = PERDUM
      PERDU[3] = PERDUH

;      IF (RNP2.EQ.2) THEN
      ODUS = ZI.1.SFDU * (1. - (ZI.1.SF_PCTVNP/100.))
      ODUM = ZI.1.MFDU * (1. - (ZI.1.MF_PCTVNP/100.))

      xx  = (ZI.1.MF_PCTVNP/100.)
      xxx = (ZI.1.MF_PCTVAC/100.)
;     CHECK FOR RESIDENT AND NON-RESIDENT PERCENTAGES
      ODUSNR = ZI.1.SFDU * ((ZI.1.SF_PCTVNP/100.) - (ZI.1.SF_PCTVAC/100.))


      IF(ODUSNR<0.0) ODUSNR = 0.0


      ODUMNR = ZI.1.MFDU * ((ZI.1.MF_PCTVNP/100.) - (ZI.1.MF_PCTVAC/100.))

      IF(ODUMNR<0.0) ODUMNR = 0.0

      NDU[1] = ODUSNR
      NDU[2] = ODUMNR
      NDU[3] = 0

;     ODUH = AS CALCULATED ABOVE
      ODU[1] = ODUS
      ODU[2] = ODUM
      ODU[3] = ODUH
;
;      DO  890 IDUTYP=1,3
;      LOOP HHTYPE=1,3

; ================================================================
; This is the main program feedback to calculate initial production
; and attraction values for each zone for each trip purpose
; ================================================================
LOOP HHTYPE=1,3 ; ESTABLISH VARIABLES FOR EACH HOUSEHOLD CLASS

IF (HHTYPE=1) ; SINGLE-FAMILY
   UNITS=   ZI.1.SFDU
   VACRATE= ZI.1.SF_PCTVNP
   POP=     ZI.1.SFPOP
   CAR[1]=ZI.1.SF_0AUTO/100, CAR[2]=ZI.1.SF_1AUTO/100, CAR[3]=ZI.1.SF_2AUTO/100
ELSEIF (HHTYPE=2); MULTI-FAMILY
   UNITS=   ZI.1.MFDU
   VACRATE= ZI.1.MF_PCTVNP
   POP=     ZI.1.MFPOP
   CAR[1]=ZI.1.MF_0AUTO/100, CAR[2]=ZI.1.MF_1AUTO/100, CAR[3]=ZI.1.MF_2AUTO/100
ELSEIF (HHTYPE=3) ; HOTEL/MOTEL
   UNITS=   ZI.1.HMDU
   VACRATE= 100-ZI.1.HMOCC
   POP=     ZI.1.HMPOP
   CAR[1]=0, CAR[2]=1.0, CAR[3]=0
ENDIF

; ================================================================
; From here down, the same equations get applied to each
; household size, auto ownership and dwelling unit type.
; Since it is being run in the HHTYPE feedback, the same equations
; will be applied and running totals by zone will be accumulated.
; ================================================================

VAC=UNITS*(VACRATE/100), OCC=UNITS-VAC

; . . . . . . . . . . . . . . . . . . 

IF (OCC>0) 
   POPDU=POP/OCC
ELSE
   POPDU=0
ENDIF

; . . . . . . . . . . . . . . . . . . 

IF (POPDU<=1.12) RANGE=1
IF (POPDU>1.12)  RANGE=2
IF (POPDU>1.37)  RANGE=3
IF (POPDU>1.62)  RANGE=4
IF (POPDU>1.87)  RANGE=5
IF (POPDU>2.12)  RANGE=6
IF (POPDU>2.37)  RANGE=7
IF (POPDU>2.62)  RANGE=8
IF (POPDU>2.87)  RANGE=9
IF (POPDU>3.12)  RANGE=10
IF (POPDU>3.37)  RANGE=11
IF (POPDU>3.62)  RANGE=12
IF (POPDU>3.87)  RANGE=13
IF (POPDU>4.12)  RANGE=14
IF (POPDU>4.37)  RANGE=15
IF (POPDU>4.62)  RANGE=16
IF (POPDU>5.99)  RANGE=17
IF (HHTYPE=1) HHDESC='SF'
IF (HHTYPE=2) HHDESC='MF'
IF (HHTYPE=3) HHDESC='HM'

if (POPDU<1&OCC>0) PRINT LIST="TAZ=",I(5.0),"  POP/DU ERROR, HHTYPE=",HHDESC(2)," Population=",POP(4.0C)," Occupied Units=",occ(4.0c), printo=2

; . . . . . . . . . . . . . . . . . . 

;  LOOP PR=1,5
;   LOOP AU=1,3
;         CL=100*PR+10*(AU-1)+HHTYPE
;         CELL[CL]=OCC*DUWEIGHT(PR,RANGE)*CAR[AU]
;         CELLT[CL]=CELLT[CL]+CELL[CL]
;         LOOP PURP=1,4
;            PRODRATE=PRATE(PURP,CL)
;            PRDDRATENP=PRATENP(PURP,CL)
;            P[PURP]=P[PURP]+PRATE(PURP,CL)*CELL[CL]+PRATENP(PURP,CL)*CELL[CL]
;         ENDLOOP ; ON PURP
;   ENDLOOP ; ON AU
;  ENDLOOP  ; ON PR

; . . . . . . . . . . . . . . . . . . 

;C   -------
;C  CALCULATE WHICH PERSONS PER HOUSEHOLD GROUP( 1-17) SHOULD BE USED
;C  THE FACT THAT PERS/DU RANGES ARE ALMOST ALL EQUAL TO .25, AS WELL AS
;C  THAT A REAL EXPRESSION IS TRUNCATED WHEN PUT INTO AN INTEGER.
;C  INTERPOLATION BETWEEN RATES HAS BEEN REMOVED FROM THIS PROGRAM
;C
      NSLOPE = INT (4. * PERDU[HHTYPE] - 2.5)
      IF (NSLOPE<1) NSLOPE = 1
      IF (NSLOPE>16) NSLOPE = 17

;C
;C CALCULATE WHAT PORTION OF THE HOUSEHOLDS ARE IN EACH GROUP
;C BY DU TYPE, BY PERS PER DU, BY AUTOS PER DU
;C
;      DO  890 IHHSZE=1,5
;      DO  890 IADU=1,3
      LOOP PR=1,5
       LOOP AU=1,3
         CL=100*PR+10*(AU-1)+HHTYPE
         HHCATN[CL]=NDU[HHTYPE]*DUWEIGHT(PR,NSLOPE)*CAR[AU]
         THOUSEN[CL]=THOUSEN[CL]+HHCATN[CL]

         HHCAT[CL]=ODU[HHTYPE]*DUWEIGHT(PR,NSLOPE)*CAR[AU]
         THOUSE[CL]=THOUSE[CL]+HHCAT[CL]


;      HHCATN(IHHSZE,IADU,IDUTYP) =NDU(IDUTYP) * DUWT(NSLOPE,IHHSZE) * PCA(IDUTYP,IADU)
;      THOUSEN(IHHSZE,IADU,IDUTYP) =THOUSEN(IHHSZE,IADU,IDUTYP) + HHCATN(IHHSZE,IADU,IDUTYP)
;C
;C NOW IF EVERYTHING HAS GONE RIGHT THUS FAR WE WILL MULTIPLY THE
;C APPROPRIATE HHCAT BY THE CORRESPONDING TRIP RATE FOR EACH OF 4
;C HOMEBASED PURPOSES FOR NON RESIDENTS
;C
         LOOP PURP=1,4
            THHCATN[CL]=HHCATN[CL]*PRATENP(PURP,CL);*CELL[CL]
            THHCAT[CL]=HHCAT[CL]*PRATE(PURP,CL);*CELL[CL]


;      DO  890 IPURP=1,4
;      THHCATN(IHHSZE,IADU,IDUTYP,IPURP) =HHCATN(IHHSZE,IADU,IDUTYP) * MATNP(IHHSZE,IADU,IDUTYP,IPURP)
;C
;      IF(TRACE(19))WRITE(6,19) IZ,IPURP,IDUTYP,IADU,(HHCATN(I,IADU,IDUTYP),I=1,5),(THHCATN(K,IADU,IDUTYP,IPURP),K=1,5)
;   19 FORMAT(1X,I4,'PURP= ',I2,'DUTYP= ',I2,'ADU= ',I2,'HOUSEHOLD = ',5F6.3,'TRIPS= ',5F6.3)
;C
;C AND THEN CALCULATE HOMEBASED PRODUCTIONS
;C
            TTRIPHN[CL]=TTRIPHN[CL]+THHCATN[CL]
            TTRIPH[CL]=TTRIPH[CL]+THHCAT[CL]
            P[PURP]=P[PURP]+THHCATN[CL]+THHCAT[CL]


;      TTRIPHN(IHHSZE,IADU,IDUTYP,IPURP) = TTRIPHN(IHHSZE,IADU,IDUTYP,IPURP)+ THHCATN(IHHSZE,IADU,IDUTYP,IPURP)
;      P(IZ,IPURP) = P(IZ,IPURP) + THHCATN(IHHSZE,IADU,IDUTYP,IPURP)
;  890 CONTINUE
         ENDLOOP ; PURP
       ENDLOOP ; AU
      ENDLOOP ; PR
     ENDLOOP ; HHTYPE


;
; CALCULATE ATTRACTIONS FOR A ZONE AND NHB & TRUCK/TAXI PRODUCTIONS
;
;TOTALDUS=(ODUS+ODUM+ODUSNR+ODUMNR)  ;Start Attractions
TOTALDUS=ZI.1.SFDU+ZI.1.MFDU  ;Start Attractions

LOOP WPURP=1,6
   A[WPURP]=ARATE(1,WPURP)*ZI.1.IND_EMP+
            ARATE(2,WPURP)*ZI.1.COMM_EMP+
            ARATE(3,WPURP)*ZI.1.SERV_EMP+
            ARATE(4,WPURP)*ZI.1.TOT_EMP+
            ARATE(5,WPURP)*TOTALDUS+
            ARATE(6,WPURP)*ZI.1.SCHOOL
ENDLOOP
; . . . . . . . . . . . . . . . . . . 

; .........................................................................


; ================================================================
; NOW PROCESS SPECIAL GENERATORS
; The way this is written, only 1 SPGEN per zone is allowed .

;SP ATTRACTIONS
SPAFRAC[1]=ZI.2.PCT_HBW/100
SPAFRAC[2]=ZI.2.PCT_HBSH/100
SPAFRAC[3]=ZI.2.PCT_HBSR/100
SPAFRAC[4]=ZI.2.PCT_HBO/100
SPAFRAC[5]=ZI.2.PCT_NHB/100
;SP PRODUCTIONS
SPPFRAC[1]=ZI.4.PCT_HBW/100
SPPFRAC[2]=ZI.4.PCT_HBSH/100
SPPFRAC[3]=ZI.4.PCT_HBSR/100
SPPFRAC[4]=ZI.4.PCT_HBO/100
SPPFRAC[5]=ZI.4.PCT_NHB/100

; . . . . . . . . . . . . . . . . . . 
;P[5]=0
LOOP PRP=1,5
    IF (ZI.2.OPERAND='+')
       IF (ZI.2.PA='A','a') A[PRP]=A[PRP]+ZI.2.TRIPS_DIFF*SPAFRAC[PRP]
    ELSEIF (ZI.2.OPERAND='-')
       IF (ZI.2.PA='A','a') A[PRP]=A[PRP]-ZI.2.TRIPS_DIFF*SPAFRAC[PRP]
    ELSEIF (ZI.2.OPERAND='*')
       IF (ZI.2.PA='A','a') A[PRP]=A[PRP]*ZI.2.TRIPS_DIFF*SPAFRAC[PRP]    
    ELSEIF (ZI.2.OPERAND='T')
       IF (ZI.2.PA='A','a') A[PRP]=ZI.2.TRIPS_DIFF*SPAFRAC[PRP]

    ENDIF

    IF (ZI.4.OPERAND='+')
       IF (ZI.4.PA='P','p') P[PRP]=P[PRP]+ZI.4.TRIPS_DIFF*SPPFRAC[PRP]
    ELSEIF (ZI.4.OPERAND='-')
       IF (ZI.4.PA='P','p') P[PRP]=P[PRP]-ZI.4.TRIPS_DIFF*SPPFRAC[PRP]
    ELSEIF (ZI.4.OPERAND='*')
       IF (ZI.4.PA='P','p') P[PRP]=P[PRP]*ZI.4.TRIPS_DIFF*SPPFRAC[PRP]
    ELSEIF (ZI.4.OPERAND='T')
       IF (ZI.4.PA='P','p') P[PRP]=ZI.4.TRIPS_DIFF*SPPFRAC[PRP]

    ENDIF

ENDLOOP


; . . . . . . . . . . . . . . . . . . 

; ================================================================

P[7]=ZI.3.IE_PROD

IF (I={ZONESA})

  LOOP k=1,{ZONESI}

;C--------------
;C    SET NHB AND TT PRODUCTIONS EQUAL TO NHB AND TT ATTRACTIONS
;C

   P[5][k]=A[5][k]+P[5][K]
   P[6][k]=A[6][k]


      HBWPT  = HBWPT  + P[1][k]
      HBWAU  = HBWAU  + A[1][k]
      HBSHPT = HBSHPT + P[2][k]
      HBSHAU = HBSHAU + A[2][k]
      HBSRAU = HBSRAU + A[3][k]
      HBSRPT = HBSRPT + P[3][k]
      HBOPT  = HBOPT  + P[4][k]
      HBOAU  = HBOAU  + A[4][k]
      NHBPT  = NHBPT  + P[5][k]
      NHBAU  = NHBAU  + A[5][k]
      TVEHAU = TVEHAU + A[6][k]
      TVEHPT = TVEHPT + P[6][k]
  ENDLOOP

EIPT=PTOT(7)
EIAT=EIPT
IIAT = HBWAU + HBSHAU + HBSRAU + HBOAU + NHBAU + TVEHAU
R=EIPT/IIAT

  LOOP t=1,{ZONESI}

  A[7][t]=(A[1][t]+A[2][t]+A[3][t]+A[4][t]+A[5][t]+A[6][t])*R

  ENDLOOP

  HBWR  = HBWPT/HBWAU
  HBSHR = HBSHPT/HBSHAU
  HBSRR = HBSRPT/HBSRAU
  HBOR  = HBOPT/HBOAU
  NHBR  = NHBPT/NHBAU
  TTR   = TVEHPT/TVEHAU

  LOOP s=1,{ZONESA}

      A[1][s] = INT( A[1][s] * HBWR + 0.5)
      A[2][s] = INT( A[2][s] * HBSHR + 0.5)
      A[3][s] = INT( A[3][s] * HBSRR + 0.5)
      A[4][s] = INT( A[4][s] * HBOR + 0.5)
      A[5][s] = INT( A[5][s] * NHBR + 0.5)
      A[6][s] = INT( A[6][s] * TTR + 0.5)
      A[7][s] = INT(A[7][s] + 0.5) 


      P[1][s] = INT(P[1][s] + 0.5) 
      P[2][s] = INT(P[2][s] + 0.5) 
      P[3][s] = INT(P[3][s] + 0.5) 
      P[4][s] = INT(P[4][s] + 0.5) 
      P[5][s] = INT(P[5][s] + 0.5) 
      P[6][s] = INT(P[6][s] + 0.5) 
      P[7][s] = INT(P[7][s] + 0.5) 

  ENDLOOP

ENDIF

ENDPROCESS







ENDRUN
