!l $Header: m:/default/source/RCS/ngtdm.f,v 1.355 2010/11/26 21:36:01 JBE

Exp $ER

! = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! ! MAIN NGTDM PROCESSING REOUTINE CORRESPONDING TO THE ! NEW INTERSTATE TRANSMISSION MODULE (ITM) ! ! 0 1/02/97

-- CALLS MAIN PTM, DTM, ITM ROUTINES !

-- CALLS PRE AND POST PROCESSING ROUTINES ! ! STATUS: ! ! CALLS: NGTDM_PTM ! NGTDM_DTMBASE ! NGTDM_DTMFORE ! NGTDM_ITM ! NGTDM_POST ! NGREAD_MAP ! NGREAD_HIST ! ! = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! SUBROUTINE NGMAIN IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ogglobal' include 'ngparinc' include 'ngtdminc' include 'ngitminc' include 'ngsteoinc' include 'ngcdmdinc' include 'ngakinc' include 'ogsmimp'

common /ogsmC1/ ogsmCflg INTEGER*4 ogsmCflg ! 1=use ogsmc, 0=do not use ogsmc

INT EGER*4 cbmCflg ! 1=use ogsmc CBM calc, 0=do not use ogsmc

INTEGER*4 NET ! REPRESENTS PK,OP NETWORK INTEGER*4 S,YR,I ! COUNTERS INTEGER*4 CNVGCNT ! COUNTS CYCLES FOR CONVERGENCE INTEGER*4 A,L ! ARC ID INTEGER*4 SRC,DEST ! SOURCE & DESTINATIO NODES INTEGER*4 HGRW ! PASSED VAR BETWEEN ANGTS/MACK ROUTINE

INTEGER*4 FILE_MGR ! FUNCTION WHICH PASSES UNIT NUMBERS INTEGER*4 RTOVALUE ! FUNCTION TO SET RUNT IME PARAMETER VALUE INTEGER*4 FIXAKMD ! RUNTIME PARAMETER FOR FIXING MACKEN & ANGTS FLOWS INTEGER*4 JENDYR ! LAST YEAR VALUE CORRESPONDS TO IENDYREXTERNAL RTOVALUE ! 0 = NO FIX, 1=FIX BOTH, 2= FIX AK, 3= FIX

MD CHARACTER*18 FNAME

LOGICAL READFLG/.TRUE./

!

--------------

JENDYR = RTOVALUE('IJUMPCAL',2030)

ogsmCflg = 0 ! 1=use ogsmc, 0=do not use ogsmc cbmCflg = 0 ! 1=use ogsmc CBM calc, 0=do not use ogsmc

MODYR = CURIYR + IBASYR

- 1

CALL NGGLB_INTRANS

! TEMP TEMP TEMP (UNTIL GET OUT OF RESTART FILE) TEMP TEMP TEMP

IF (CURITR.EQ.1) THEN DO S=1,4 oOGQNGIMP(S+10,CURIYR) = 0.0 oOGPNGIMP(S+10,CURIYR) = 1.50 ENDDO ! THIS NEEDED WHEN EXTENDING LAST PROJECTION YEAR

IF (oEXSPEND(1,CURIYR).LE.0.000001) oEXSPEND(1,CURIYR) = oEXSPEND(1,CURIYR

- 1)

IF (oOGNGRSV(1 ,CURIYR).LE.0.00001) oOGNGRSV(1,CURIYR) = oOGNGRSV(1,CURIYR

- 1)

IF (oOGNGRSV(2,CURIYR).LE.0.00001) oOGNGRSV(2,CURIYR) = oOGNGRSV(2,CURIYR

- 1)

IF (oOGNGRSV(3,CURIYR).LE.0.00001) oOGNGRSV(3,CURIYR) = oOGNGRSV(3,CURIYR

- 1)

IF (oOGNGRSV(9, CURIYR).LE.0.00001) oOGNGRSV(9,CURIYR) = oOGNGRSV(9,CURIYR

- 1) ENDIF

IF (NCRL .EQ. 1) THEN IF (MODYR.GE.LHISYR.AND.MODYR.LT.IENDYR) THEN CALL NGCOAL2GAS CALL NGTDM_CNGBUILD ENDIF IF (.NOT.FIXLNGFLG) THEN CALL NGCAN_LNGVS !var sup LNG ! SET CN LNG IMPORT LEVELS FOR CURRENT YEAR

ENDIF CALL NGITM_DEBUG3(NGOERR) ! put cur cap, flow, dmd into PRV (previous yr) variables

IF (MODYR. LT.IENDYR) CALL NGADD_MEXIF (MODYR .EQ. EHISYR) THEN WRITE(NGOBENCH,*) ' HISTORICAL REGIONAL WELLPR SCALE ', & 'FACTORS' WRITE(NGOBENCH,10) (YR,YR=IBASYR,EHISYR) DO S=1,uSNODES IF (SUPARRAY(S).EQ.1) WRITE(NGOBENCH,11) S,(HIST_RPSHIFT(S,YR),YR=IBASYR,EHISYR)

ENDDO 10 FORMAT(9X,'REG',<IJUMPYR>(4X,I4)) 11 FORMAT(1X,'RPSHIFT',I4,<IJUMPYR>F8.4)

CALL NGSET_BENCH IF (BMYEAR .NE. EHISYR) THEN CALL NGSTEO_BENCHSUPLM ENDIF ENDIF
! SAVE ARC_SHRPR INTO ARC_PREV_SHRPR FOR USE NEXT YR ! AND INSURE NO 0 OR NEG SHARES FOR T

- 1 IN NEXT YR (USUALLY FROM LHISYR)

DO NET=1,NETWORK

DO A=1,NARCS ARC_PREV_SHRPR(NET,A) = ARC_SHRPR(NET,A) ENDDO DO L=1,NPROC DEST = PROC_ORD(L) DO A=ARC_LOOP(NET,DEST,1),ARC_LOOP(NET,DEST,2) SRC = ARC_2NODE(A,1) IF (SRC.LE.TNODES .OR. SR C.GE.(TNODES+SNODES)) THEN SHR(NET,A,MODYR) = AMAX1(SHR(NET,A,MODYR),0.01) ENDIF ENDDO ENDDO ENDDO
CALL NGPTAR_OUT ! WRITE REALIZED PIPELINE TARIFFS CALL NGSTOR_OUT ! WRIT E REALIZED STORAGE TARIFFS IF (NCNMX.EQ.0 .OR.NCNMX.EQ.2) CALL NGCANADA

! TRANSFER GLOBAL VARIABLES BACK

IF (CURIYR .EQ. LASTYR) THEN FNAME='NGOPTM ' NGOPTM=FILE_MGR('C',FNAME,.FALSE.) FN AME='NGOERR ' NGOERR=FILE_MGR('C',FNAME,.FALSE.) FNAME='NGOTREE ' NGOTREE=FILE_MGR('C',FNAME,.FALSE.) FNAME='NGOBENCH ' NGOBENCH=FILE_MGR('C',FNAME,.FALSE.) FNAME='NGOHIST ' NGOHIST=FILE_MGR('C',FNAME,.FALSE.) FNAME='NGODTM 'NGODTM=FILE_MGR('C',FNAME,.FALSE.) FNAME='NGOBAL ' NGOBAL=FILE_MGR('C',FNAME,.FALSE.)

CLOSE(UNIT=NGUNIT) ! NGTDMOUT ENDIF

CALL NGGLB_OUTTRANS

RETURN ENDIF

IF (READFLG) THEN NGUNIT = 4 ! NGTDMOUT output file OPEN (UNIT=NGUNIT, FILE='NGTDMOUT.txt')

FNAME='NGOPTM ' NGOPTM=FILE_MGR('O',FNAME,.TRUE.)

FNAME='NGOERR ' NGOERR=FILE_MGR('O',FNAME,.TRUE.)

FNAME='NGOTREE ' NGOTREE=FILE_MGR('O',FNAME,.TRUE.)

FNAME='NGOHIST ' NGOHIST=FILE_MGR('O',FNAME,.TRUE.)

FNAME='NGOBENCH ' NGOBENCH=FILE_MGR('O',FNAME,.TRUE.)

FNAME='NGODTM ' NGODTM=FILE_MGR('O',FNAME,.TRUE.)

FNAME='N GOBAL ' NGOBAL=FILE_MGR('O',FNAME,.TRUE.)

! READ INPUT DATA

CALL NGREAD_MAP ! READ NETWORK MAPPING DATA CALL NGSET_INIT ! INITILIZE DATA CALL NGREAD_USRDATA ! READ USER INP UT, STEO, NGDBGITR CALL NGREAD_DTAR ! DIST TAR INPUT CALL NGREAD_HIST ! BULK OF HISTORICAL DATA

IF ((EHISYR .EQ. LHISYR) .AND. (STEO_NG .EQ. 1) ) THEN BMYEAR = STEOYRS(STEO_YEAR) ELSE BMYEAR = EHISYR IF (STEO_NG .EQ. 1) THEN STEO_NG = 0 WRITE(6,2007) LHISYR,EHISYR ! ATTN 2007 FORMAT(1X,'ATTN NGTDM: STEO=ON BUT LHISYR(',I4,') NOT ',
&'EQUAL TO EHISYR(',I4,')') ENDIF ENDIF

FIXAKMD = RTOVALUE('FIXAKMD ',0) IF (FIXAKMD.EQ.0 .OR. FIXAKMD.EQ.2) THEN QMD_ALB = 0.0 ELSE DO YR=IBASYR,JENDYR CN_FIXSUP(5,YR) = QMD_ALB(YR) ENDDO E NDIF IF (FIXAKMD.EQ.0 .OR. FIXAKMD.EQ.3) QAK_ALB = 0.0

READFLG = .FALSE. ENDIF

CALL NGSET_DBGITR IF (CURITR.EQ.1) THEN IF (FIXAKMD.NE.1 .AND. FIXAKMD.NE.2) CALL NGAKPTRIG(HGRW) IF (FIXAKMD.NE.1 .AND. FIXAKMD.NE.3) CALL NGMDPTRIG(HGRW) oGAK_ALB(CURIYR) = QAK_ALB(MODYR) oGMD_ALB(CURIYR) = QMD_ALB(MODYR) IF (CNCAPSW.EQ.0) CALL NGCANCAP(2) ! OVERWRITE READ CAN CAP IF NGCANOVR=1, USING CONSUMP METHO D

CALL NGSET_UTZ CALL NGSET_PTMVAR CALL NGTDM_PTM ENDIF

! WRITE VALUES OF VARIABLES PASSED FROM OTHER NEMS MODELS

IF (NGDBGITR(1,1)) CALL NGREPIN

IF (MODYR .LE. EHISYR) THEN

!!!!!! IF (MODYR.LE.1994) CALL NGHIST_UDMD ! SET HIST EU DMD, EMM FIXED FOR 1995 FORWARD

IF (CURITR .EQ. 1) THEN CALL NGDTM_TRNTAX ! TAX FOR CNG VEHICLE DTAR CALC

CALL NGTRN_HIST ! XFER HIST INFO TO SINGL E YR VAR

IF (MODYR.GT.IBASYR) CALL NGDTM_SETPREV ! PREVIOUS YR DTAR AND QTY ENDIF

CALL NGSET_BASDMD ! INFO INTO NGTDM VARIABLES IF (FIXLNGFLG) THEN CALL NGSETLNG_INGM ENDIF CALL NGAD J_PINEU ! ADJUST HIST PR FOR IN & EU SECCALL NGDMD_ALK ! AK SUBMODULE

-- moved since hist

prices scaled in PINEU

CALL NGDTM_HISDIST IF (MODYR.EQ.EHISYR .AND. FCRL.EQ.1) CALL NGDTM_HISOUT

!

- PROCESS HISTORICAL DATA TO GENERATE ITM INFO ! SHR CURPCAP CGBENCH ! ARC_SHRPR PFUEL_FAC IF (MODYR .EQ. LHISYR) THEN CALL NGDTM_FORECAST_TRNF ! TRANS DTA R_F (w/taxes) CALL NGTDM_ITM ! ITM

- FORECAST ROUTINES ELSE CALL HNGTDM_ITM ! ITM

- HISTORICAL ROUTINES ENDIF

ELSE ! FORECAST YEARS

IF (CURITR .EQ. 1) THEN CALL NGDTM_TRNTAX ! TAX FOR CNG VEHICLE DTAR CALC CALL NGDTM_SETPREV ! PREVIOUS YR DTAR AND QTY IF (OGSMCFLG.EQ.1) THEN !

-- ogsm - c run w/ ngtdm CALL NGCAN_frOGSMC(CBMCFLG) ! OVERWRITE CN OGSM VARS , oOGRESCAN, oOGPRRCAN

ENDIF
CALL NGPCAP_ADJSHR ! ADJUST PREV YR SHARES BASED ON ! PLANNED CAPACITY ADDITIONS ENDIF IF (NCNMX.EQ.1 .OR. NCNMX.EQ.3) THEN CALL NGCAN_INGM IF (CURITR.EQ.1) THEN DO I=2,4 CN_FIXSUP(I,MODYR) = 0.0 ENDDO ELSE ZOGPRRNG(SNODES

- lSNODES

- 3) = oOGPRRCAN(2,CURIYR) ENDIF CN_FIXSUP(1,MODYR) = oOGRESCAN(1,CURIYR) * oOGPRRCAN(1,CURIYR) ELSE CALL NGCAN_FXADJ ! ADJUST NONPRICE RESPONSIVE CANADIAN SUPPLY ENDIF

CALL NGDMD_ALK ! AK SUBMODULE CALL NGSET_BASDMD ! INFO INTO NGTDM VARIABLES IF (FIXLNGFLG) THEN CALL NGSETLNG_INGM ENDIF
CALL NGTDM_DTMFORE ! DTM FORECAST YR PROCESSING

CALL NGTDM_ITM ! ITM ENDIFCALL NGTDM_POST ! POST PROCESS RESULTS INTO NEMS

VAR

IF (NGDBGITR(1,2)) CALL NGREPOUT

CALL NGGLB_OUTTRANS

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! ! READ DATA TO DEVELOP MAPP ING VARIABLES: ! ARC_LOOP ! ARC_2NODE ! NODE_2ARC ! SARC_2NODE ! SNODE_2ARC ! ! STATUS: COMPLETE ! ! CALLED BY: NGTDM ! ! = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! SUBROUTINE NGREAD_MAP IMPLICIT NONE

include 'parametr' include 'ngparinc' include 'ngtdminc' include 'ngitminc' include 'ngcdmdinc'

INTEGER*4 I,J,K,L,N ! COUNTERS INTEGER*4 NGMAP ! INPUT UNIT NUMBER INTEGER*4 SRC ! SOURCE NODE ALONG ARC INTEGER*4 DEST ! NODE ON TREE (DEST NODE) INTEGER*4 NET ! REPRESENTS PK, OP NETWORKS INTEGER*4 DNUM(TNODES) ! PLACEHOLDER FOR NUM OF INFLOW ARCS INTEGER*4 DMAP(TNODES,14)!PLACEHOLDER FOR SRC NODE ID

INTEGER*4 XDNUM(TNODES) ! PLACEHOLDER FOR NUM OF INFLOW ARCS INTEGER*4 XDMAP(TNODES,14)!PLACEHOLDER FOR SRC NODE ID

INTEGER*4 FILE_MGR ! FUNCTION WHICH PASSES UNIT NUMBERS CHA RACTER*18 FNAME

CHARACTER*1 CH ! END OF DATA SYMBOL (#) !

-------------

FNAME='NGMAP ' NGMAP=FILE_MGR('O',FNAME,.FALSE.) !EEE NGMAP=30!EEE OPEN(UNIT=NGMAP,FILE='ngmap',STATUS='OLD')

! DEFINE NODES PROCESSING ORDER

CALL NEXTDATA(NGMAP)

READ(NGMAP,10) NPROC, (PROC_ORD(I),I=1,NPROC) ! do i=1,nproc ! write(6,*) 'PROC_ORD',I,PROC_ORD(I) ! enddo

10 FORMAT(1X,I3,2X,33I4)

! DEFINE FIXED AND VARIABLE SUPPLY TYPES

CALL NE XTDATA(NGMAP)

READ(NGMAP,*) I IF (I.EQ.1) THEN FIXLNGFLG=.TRUE. ELSE FIXLNGFLG=.FALSE. ENDIF READ(NGMAP,15) (SUPARRAY(I),I=1,SNODES) READ(NGMAP,15) (SUPTYPE(I),I=1,SNODES) READ(NGMAP,15) (SUPREG(I),I=1,SNODES) READ(NGMAP,16) (FSRGN(I),I=1,NSUPTYPE) READ(NGMAP,16) (NSRGN(I),I=1,NSUPTYPE) READ(NGMAP,15) (MAP_NG(I),I=1,SNODES) READ(NGMAP,15) (MAP_OG(I),I=1,SNODES)

15 FORMAT(13X,92I3) 16 FORMAT(13X,14I3)

! DEFINE NUMBER OF VARIABLE SUPPLY NODES FOR US AND CAN

NVSUP=0 uNVSUP=0 ! cNVSUP=0 DO I=1,SNODES IF (SUPARRAY(I) .EQ. 1) THEN NVSUP=NVSUP+1 VARSUP(NVSUP)=I VNODES(I)=NVS UP !em4 IF (I .LE. uSNODES) THEN !em4 uNVSUP=uNVSUP+1 ! ELSE ! cNVSUP=cNVSUP+1 !em4 ENDIF

ENDIF ENDDO

! DEFINE SRC AND DEST NODES FOR EACH ARCDO I=1,TNODES ANUM(I) = 0 DO J=1,10 AMAP(I,J) = 0 ENDDO ENDDO

CALL NEXTDATA(NGMAP)

CH = 'A' DO WHILE (CH .NE. '#') ! PIPELINE ARCS READ(NGMAP,20) CH, I, DNUM(I), (DMAP(I,J), J=1,DNUM(I)) K = ANUM(I) ANUM(I) = ANUM (I) + DNUM(I) ! NUM ARCS INTO NODE I DO J=1,DNUM(I) AMAP(I,J+K) = DMAP(I,J) ! LIST OF SRC NODES INTO NODE I ENDDO ENDDO

CALL NEXTDATA(NGMAP)

CH = 'A' DO WHILE (CH .NE. '#') ! SUPPLY A RCS READ(NGMAP,20) CH, I, DNUM(I), (DMAP(I,J), J=1,DNUM(I)) XDNUM(I)=0 DO J=1,DNUM(I) IF (SUPARRAY(DMAP(I,J)).EQ.1 .OR. & (DMAP(I,J).GE. FSRGN(14) .AND. & ! INCL LNG SUPPLY ARCS !yd1: aren't LNG arcs included automatically? check this

DMAP(1,J).LT.(FSRGN(14)+NSRGN(14)))) THEN XDNUM(I)=XDNUM(I)+1 XDMAP(I,XDNUM(I))=DMAP(I,J) ENDIF ENDDO DNUM(I)=XDNUM(I) DMAP(I,:)=XDMAP(I,:)

K = ANUM(I) ANUM(I) = ANUM(I) + DNUM(I) ! NUM ARCS INTO NODE I IF (DNUM(I).GT.0) THEN DO J=1,DNUM(I) ! LIST OF SRC NODES INTO NODE I AMAP(I,J+K) = DMAP(I,J) + TNODES ENDDO ENDIF ENDDO

! SINCE DNUM(I) WILL BE USED TO REDUCE THE ARC COUNT ON THE OFF

- PEAK ! NETWORK, NEED TO ZERO IT BEFORE READING COUNT INFO ON STORAGE ARCS

DO I=1,TNODES DNUM (I) = 0 ENDDOCALL NEXTDATA(NGMAP)

L=0 CH = 'A' DO WHILE (CH .NE. '#') ! STORAGE ARCS READ(NGMAP,20) CH, I, DNUM(I), (DMAP(I,J), J=1,DNUM(I)) K = ANUM(I) ANUM(I) = ANUM(I) + DNUM(I) ! NUM ARCS INTO NODE I DO J=1,DNUM(I) ! LIST OF SRC NODES INTO NODE I AMAP(I,J+K) = DMAP(I,J) + TNODES + SNODES L=L+1 STR_2NODE(L) = I ENDDO ENDDO

20 FORMAT(A1,3X,I3,I3,12(3X,I3))

! DEFINE NODE_2ARC, ARC_2NODE, ARC_LOOP MAPPING VARIABLES

DO NET=1,NETWORK DO I=1,TNODES ARC_LOOP(NET,I,1)=0.0 ARC_LOOP(NET,I,2)=0.0 DO J=1,TNODES NODE_2ARC(I,J) =0.0 ENDDO ENDDO ENDDO DO I=1,ARCS ! 1,100 ARC_2NODE(I,1)=0.0 ARC_2NODE(I,2)=0.0 ENDDO

K=0

DO DEST=1,TNODES ! 1,38 w/ World LNG IF (ANUM(DEST) .GE. 1) THEN I=K+1 DO N=1,ANUM(DEST) SRC = AMAP(DEST,N) K=K+1 NODE_2ARC(SRC,DEST) = K ARC_2NODE(K,1) = SRC ARC_2NODE(K,2) = DEST ENDDO J=K

! INCLUDE STORAGE SUP ARCS IN PK NET ARC_LOOP(PKNET,DEST,1) = I ARC_LOOP(PKNET,DEST,2) = J

! EXCLUDE STORAGE SUP ARCS IN OP NET ARC_LOOP(OPNET,DEST,1) = IARC_LOO P(OPNET,DEST,2) = J

- DNUM(DEST) ENDIF ENDDO NARCS = K

!

--------------------- ! DEFINE SOURCE AND DEST NODE FOR EACH SECONDARY ARC ! SNODE_2ARC, SARC_2NODE

DO I=1,TNODES ANUM(I) = 0 DO J=1,10 AMAP(I,J) = 0 ENDDO ENDDO

CALL NEXTDATA(NGMAP)

CH = 'A' DO WHILE (CH .NE. '#') ! SECONDARY PIPELINE ARCS READ(NGMAP,20) CH, I, DNUM(I), (DMAP(I,J), J=1,DNUM(I)) K = ANUM(I) ANUM (I) = ANUM(I) + DNUM(I) ! NUM ARCS INTO NODE I DO J=1,DNUM(I) AMAP(I,J+K) = DMAP(I,J) ! LIST OF SRC NODES INTO NODE I ENDDO ENDDO

DO I=1,TNODES ! 1,24 DO J=1,TNODES ! 1,24 SNODE_2ARC(I,J)=0.0 ENDDO ENDDO DO I=1,SARCS ! 1,51 SARC_2NODE(I,1)=0.0 SARC_2NODE(I,2)=0.0 ENDDO

K=0

DO DEST=1,TNODES IF (ANUM(DEST) .GE. 1) THEN DO N=1,ANUM(DEST) SRC = AMAP(DEST,N) K=K+1 SNODE_2ARC(SRC,DEST) = K SARC_2NODE(K,1) = SRC SARC_2NODE(K,2) = DEST ENDDO ENDIF ENDDO

!

--------------------- ! DEFINE TRANSFER NODE CONNECTED T O ANGTSCALL NEXTDATA(NGMAP) READ(NGMAP,5) NODE_ANGTS 5 FORMAT(7X,I3)

!

--------------------- ! READ IN MAPPING INFO FOR CAN & MEX BORDING CROSSING

CALL NEXTDATA(NGMAP) DO N=1,NXMAPUS ! CAN EXP ARCS ENTERING BORDER CROS SING NODES READ(NGMAP,25) (CAN_XMAPUS(N,I),I=1,4) ENDDO

CALL NEXTDATA(NGMAP) DO N=1,NXMAPCN ! CAN EXP ARCS EXITING BORDER CROSSING NODES READ(NGMAP,25) (CAN_XMAPCN(N,I),I=1,3) ENDDO

CALL NEXTDATA(NGMAP) DO N=1,NMEX ! MEX EXP ARCS READ(NGMAP,25) MEX_XMAP(N,1),MEX_XMAP(N,2) ENDDO

CALL NEXTDATA(NGMAP) DO N=1,NLNGTER ! LNG BORDER CROSSING NODES READ(NGMAP,25) (LNG_XMAP(N,I),I=1,3) ENDDO

2 5 FORMAT(5X,4I6)

!

--------------------- ! MAPPING OF SUPPLY AND EMM SUBREGIONS INTO NGTDM REGIONS

! SNGCOAL PRODUCTION INTO NGTDM REGION

CALL NEXTDATA(NGMAP) READ(NGMAP,30) NODE_SNGCOAL

! LNG PRODUCTION INTO NGTDM REGIONS

CALL NEXTDATA(NGMAP) READ(NGMAP,30) (MAPLNG_NG(N), N=1,NLNGIMP)

! MAP LNG PRODUCTION FR OLD REG INTO NEW REG

CALL NEXTDATA(NGMAP) READ(NGMAP,30) (MAPLNG_NEW(N), N=1,NLNGTER)

! OFFSHORE (1

- 3) MAPPING INTO 17 NGTDM/OGSM SUBREGIONS

CALL NEXTDATA(NGMAP) READ(NGMAP,30) (OCSMAP(N), N=1,NOCSREG)

! PMM PADD (1

- 5) MAPPING INTO 17 NGTDM/OGSM SUBREGIONSCALL NEXTDATA(NGMAP) READ(NGMAP,31) (PMMMAP_NG(N), N=1,NSUPSUB)

! NGTDM (1

- 12) REGION MAPPING INTO 17 NGTDM/OGSM SUBREGIONS

CALL NEXTDATA(NGMAP) READ(NGMAP,31) (SUPSUB_NG(N), N=1,NSUPSUB)

! SUPPLY (1

- 6) REGION MAPPING INTO 17 NGTDM/OGSM SUBREGIONS

CALL NEXTDATA(NGMAP) READ(NGMAP,31) (SUPSUB_OG(N), N=1,NSUPSUB)

! NGTDM (1

- 12) REGION MAPPING INT 20 NGTDM/EMM SUBREGIONS

CALL NEXTDATA(NGMAP) READ(NGMAP,32) (EMMSUB_NG(N), N=1,NNGEM

- 1)

! EMM (1

- 13) REGION MAPPING INTO 20 NGTDM/EMM SUBREGIONS

CALL NEXTDATA(NGMAP) READ(NGMAP,32) (EMMSUB_EL(N), N=1,NNGEM

- 1)

30 F ORMAT(20(2X,I2)) ! FOR NOCSREG, NLNGIMP, SNGOTH 31 FORMAT(17(2X,I2)) ! FOR NSUPSUB = 17 32 FORMAT(20(2X,I2)) ! FOR NNGEM

- 1 = 20

!

--------------------- ! NGTDM MAPPING OF CENSUS DIV.

CALL NEXTDA TA(NGMAP) READ(NGMAP,33) (NG_CENMAP(N), N=1,DNODES) 33 FORMAT(1X,12(2X,I2)) ! 12 = DNODES

NGMAP=FILE_MGR('C',FNAME,.FALSE.) !EEE CLOSE(UNIT=NGMAP)

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! ! READ USER INPUT DATA ! MAXCYCLE : maximum number of cycles up/down tree ! NOBLDYR : no builds allowed until AFTER this year ! SHR_OPT : sharing algorithm option ! PCTADJSHR : t

- 1 shr adjustment when planned capacity > 0 ! PCTFLO : min flow (% of t

- 1), sharing algorithm opt 2 & 6 ! ALPHAFAC : param used in sharing algorithm ! GAMMAFAC : param used in sharing algorithm ! MUFAC : param used in sharing algorithm (not used now) ! SUPCRV : supply curve option (1=orig, 2=new from K.Forbes)! PSUP_DELTA : convergence delta for supply prices

! QSUP_DELTA : convergence delta for small supply quantities ! QSUP_SMALL : small supply quantity for convergence ! QSUP_WT : weighting factor for sup qty btwn tree cycles ! ! STATUS: COMPLETE ! ! CALLED BY: NGMAIN ! ! = = = = = = = = = = = = = = = = = = = = = = = = = = = = SUBROUTINE NGREAD_US RDATA IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ogglobal' include 'ngparinc' include 'ngtdminc' include 'ngitminc' include 'ngcdmdinc'

INTEGER*4 I,J ! COUNTERS INTEGER*4 NGUSER ! INPUT UNIT NUMBER INTEGER*4 FILE_MGR ! FUNCTION WHICH PASSES UNIT NUMBERS

CHARACTER*18 FNAME !

-----------

FNAME='NGUSER ' NGUSER=FILE_MGR('O',FNAME,.FALSE.) !EEE !EEE NGUSER=30 !EEE OPEN(UNIT=NGUSER,FILE='nguser',STATUS='OLD')

! READ IN MODEL RUN PARAMETERS

CALL NEXTDATA(NGUSER) ! READ UNTIL @ IN 1ST COLUMN READ(NGUSER,*) CNCAPSW READ(NGUSER,*) MAXCYCLE READ(NGUSER,*) NOBLDYR

! READ IN SHARING ALGORIT HM PARAMETERS

READ(NGUSER,*) SHR_OPT READ(NGUSER,*) PCTADJSHR READ(NGUSER,*) PCTFLO READ(NGUSER,*) ALPHAFAC READ(NGUSER,*) GAMMAFAC READ(NGUSER,*) MUFAC

! READ IN SUPPLY CONTROL DATA

READ(NGUSER,*) PSUP_DELTA READ(NGUSER,*) QSUP_DELTAREAD(NGUSER,*) QSUP_SMALL READ(NGUSER,*) QSUP_WT

! READ IN 3

- 5

- TIER SUPPLY CURVE INFO

CALL NEXTDATA(NGUSER) ! READ UNTIL @ IN 1ST COLUMN READ(NGUSER,*) SUPCRV READ(NGUSER,*) PARM_MINPR READ(NGUSER,*) PARM_SUPCRV3 READ(NGUSER,*) PARM_SUPCRV5 READ(NGUSER,*) (PARM_SUPELAS(I), I=1,5)

! TRANSFER PARAMETERS FOR EMM'S USE

oNGSCRV_PER(1) = PARM_SUPCRV3 oNGSCRV_PER(2) = PARM_SUPCRV5 DO I=1,5 oNGSC RV_ELAS(I) = PARM_SUPELAS(I) ENDDO

! READ IN STEO DATA

CALL NGREAD_STEODATA(NGUSER)

! READ NGDBGITR DATA

CALL NGREAD_NGDBGITR(NGUSER)

! CLOSE INPUT FILE

NGUSER=FILE_MGR('C',FNAME,.FALSE.) !EEE !EEE NGUSER=30 !EEE CLOSE(UNIT=NGUSER)

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! ! READ USER INPUT DATA ! NGDBGRPT (USED TO GENERATE NGDBGITR) ! NGDBGCNTL (USED TO GENERATE NGDBGITR) ! ! STATUS: COMPLETE ! ! CALLE D BY: NGREAD_USRDATA ! ! = = = = = = = = = = = = = = = = = = = = = = = = = = = = SUBROUTINE NGREAD_NGDBGITR(NGUSER) IMPLICIT NONE

include 'parametr' ! INCLUDE (NCNTRL)include 'ngparinc' include 'ngtdminc'

INTEGER*4 I,J ! COUNTERS INTEGER*4 NGUSER ! INPUT UNIT NUMBER !

-----------

! READ IN TRACE REPORT AND FREQUENCY CONTROL SWITCHES FOR ! THE ALL MODULES

DO I=1,4 CALL NEXTDATA(NGUSER) ! READ UNTIL @ IN 1ST C OLUMN READ(NGUSER,333) (NGDBGRPT(I,J),J=1,20) ! REPORT SWITCHES READ(NGUSER,444) (NGDBGCNTL(I,J),J=1,20) ! FREQUENCY ENDDO

333 FORMAT(3X,20(L1)) 444 FORMAT(3X,20(I1))

RETURN END

!================================= ============================== ! DISTRIBUTOR TARIFF MODULE READ !=============================================================== SUBROUTINE NGREAD_DTAR IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'nghistinc' include 'ngdtminc' include 'ngitminc' include 'ngptmitm' include 'ogglobal'

REAL*4 DUM ! DUMMY TO DO A SKIP READ

INTEGER*4 NGDTAR ! INPUT UNIT NUMBER INTEGER*4 NET,REG INTEGER*4 I,J,K,M,MSEC INTEGER*4 RTOVALUE ! RETURN VALUE FOR SENS ANALYSIS INTEGER*4 CATG,KEY INTEGER*4 FYR,LYR ! FIRST AND LAST YEAR OF HDD AVERAGE

INTEGER*4 FILE_MGR CHARACTER*18 FNAME CHARACTER*9 D UM9 CHARACTER*17 DUM17 CHARACTER*1 CH !

---------------

FNAME='NGDTAR 'NGDTAR=FILE_MGR('O',FNAME,.FALSE.)

!EEE NGDTAR=31 !EEE OPEN(UNIT=NGDTAR,FILE='ngdtar',STATUS='OLD')

!**ELASTICITIES FOR F,I DMD CURVES FOR UTIL, NON

- UTIL CALL NEXTDATA(NGDTAR) READ(NGDTAR,*) (UTIL_ELAS_F(I),I=1,NNGEM)

CALL NEXTDATA(NGDTAR) READ(NGDTAR,*) (UTIL_ELAS_I(I),I=1,NNGEM)

CALL NEXTDATA(NGDTAR) READ(NGDTAR,*) (NONU_ELAS_F(I),I=1,DSEC

- 1)

CALL NEXTDATA(NGDTAR) READ(NGDTAR,*) (NONU_ELAS_I(I),I=1,DSEC

- 1)

!**RETAIL COST AND MIN % COVERAGE OF COST !**AND DECLINE RATE FOR TRANS DTAR_F OFF HISTORY CALL NEXTDATA(NGDTAR) READ(NGDTAR,220) (RETAIL_COST(I),I=1,2)

CALL NEXTDATA(NG DTAR) READ(NGDTAR,220) PERMG

CALL NEXTDATA(NGDTAR) READ(NGDTAR,220) TRN_DECL 220 FORMAT(12X,F4.2,3X,F4.2)

!**STATE TAX CALL NEXTDATA(NGDTAR) READ(NGDTAR,130) (TST1(M),M=1,DNODES) READ(NGDTAR,160) (TST2YR(M),M=1,DNODES) 160 FORMAT(7X,12(I6)) READ(NGDTAR,130) (TST2(M),M=1,DNODES) 130 FORMAT(7X,12(F6.3))

!**FEDERAL TAX TFDYR = 0 CALL NEXTDATA(NGDTAR) READ(NGDTAR,*) DUM9,I READ(NGDTAR,*) DUM9,(TFDYR(J),J=1,I) READ(NGDTAR,*) DUM9,(TFD(J),J=1,I)

!**VARIABLES FOR DTM ALGORITHM: MISC, & COEFF

CALL NEXTDATA(NGDTAR) READ(NGDTAR,*) OPTIND,OPTCOM,OPTRES,OPTELP,OPTELO ! SELECT EQUATION OPTION

CALL NEXTDATA(NGDTAR) READ(NGDTAR,*) DUM9, (MAP_NRG_CRG(I),I=1,DNODES) READ(NGDTAR,*) DUM9,(FDIFF(I),I=1,CRG)CALL NEXTDATA(NGDTAR) IN_PKALP = 0.0 READ(NGDTAR,*) DUM9,IN_CNST READ(NGDTAR,*) DUM9,(IN_ALP(I),I=1,DNODES) READ(NGDTAR,*) DUM9,(IN_PKALP(I,1),I=1,DN ODES) READ(NGDTAR,*) DUM9,IN_RHO READ(NGDTAR,*) DUM9,IN_LNQ READ(NGDTAR,*) DUM9,IN_DIST

CALL NEXTDATA(NGDTAR) READ(NGDTAR,*) DUM9,EL_CNST READ(NGDTAR,*) DUM9,(EL_ALP(I),I=1,NNGEM

- 1) READ(NGDTAR,*) DUM9,EL_RESID READ(NGDTAR,*) DUM9,EL_RHO READ(NGDTAR,*) DUM9,EL_PARM

CALL NEXTDATA(NGDTAR) READ(NGDTAR,*) DUM17,oEL_MRKUP_BETA(1) READ(NGDTAR,*) DUM17,oEL_MRKUP_BETA(2)

CALL NEXTDATA(NG DTAR) CM_PKALP = 0.0 READ(NGDTAR,*) DUM9,(CM_ALP(I),I=1,DNODES) READ(NGDTAR,*) DUM9,(CM_PKALP(I,1),I=1,DNODES) READ(NGDTAR,*) DUM9,CM_ADJ READ(NGDTAR,*) DUM9,CM_RHO READ(NGDTAR,*) DUM9,CM_LNQ

CALL NEXTDATA(NGDTAR ) READ(NGDTAR,*) DUM9,HDYWHTLAG READ(NGDTAR,*) DUM9,HW_ADJ READ(NGDTAR,*) DUM9,HW_BETA0 READ(NGDTAR,*) DUM9,HW_BETA1 READ(NGDTAR,*) DUM9,HW_RHO

CALL NEXTDATA(NGDTAR) RS_PKALP = 0.0 READ(NGDTAR,*) DUM9,(RS_ALP(I),I=1,DNODES) READ(NGDTAR,*) DUM9,(RS_PKALP(I,1),I=1,DNODES) READ(NGDTAR,*) DUM9,RS_ADJ READ(NGDTAR,*) DUM9,RS_RHO READ(NGDTAR,*) DUM9,RS_LNQ READ(NGDTAR,*) DUM9,RS_COST READ(NGDTAR,*) DUM9,RS_PARM

CALL NEXTDATA(NGDTAR) DO K=FHISYR,LHISYR

- 1 READ(NGDTAR,*) J,(NUMRS(I,K),I=1,DNODES) ENDDO

CALL NEXTDATA(NGDTAR) READ(NGDTAR,*) (NUM_REGSHR(I),I=1,DNODES)CALL NEXTDATA(NGDTAR) READ(NGDTAR,* ) (RECS_ALIGN(I),I=1,DNODES)

! HEATING DEGREE DAY DATA

CALL NEXTDATA(NGDTAR) READ(NGDTAR,*) FYR,LYR IF (LYR.GT.LHISYR) WRITE(4,*) ' NGREAD HDDYR ERROR ' AHDD = 0.0

CALL NEXTDATA(NGDTAR) DO NET=1,NETWORK DO REG=1,NNGEM

- 1 READ(NGDTAR,*) I,J,(HHDD(I,J,K),K=FHISYR,LHISYR) IF (I.NE.NET .OR. J.NE.REG) WRITE(4,*) ' NGREAD HDD ERROR' DO K=FYR,LYR AHDD(NET,REG) = AHDD(NET,REG) + HHDD(NET,REG,K) ENDDO AHDD(NET,REG) = AHDD(NET,REG) / REAL(LYR

- FYR+1) ENDDO ENDDO

!**MORE VARIABLES FOR NEW DTM ALGORITHM: INTRASTATE TARIFFS, CG BENCH

CALL NEXTDATA(NGDTAR) READ(NGDTAR,280) (INTRAST_TAR(I), I=1,DNODES) DO NET=1,NETWORK READ(NGDTAR,280) (INTRAREG_TAR(NET,I), I=1,DNODES) ENDDO 280 FORMAT(12X,12(F5.2))

CALL NEXTDATA(NGDTAR) DO NET=1,NETWORK READ(NGDTAR,*) DO I=1,DNODES READ(NGDTAR,*) J,M,(HCG_BENCH(J,M,K),K=IBASYR,LHI SYR) IF (J.NE.NET .OR. M.NE.I) WRITE(6,*) ' NGTDM ERROR HCGBENCH READ ',J,NET,M,I

ENDDO ENDDO
!**parameters for ngtdm_cngbuild CALL NEXTDATA(NGDTAR) READ(NGDTAR,456) MAX_CNG_BUILD READ(NGDTAR,456) CNG_HRZ READ(NGDTAR,456) FREE_YRS READ(NGDTAR,456) CNG_WACC READ(NGDTAR,456) CNG_BUILDCOST CNG_BUILDCOST = CNG_BUILDCOST/(oMC_PCWGDP(20)/oMC_PCWGDP(

- 2)) 456 FORMAT(16X,F10.3) READ(NGDTAR,457) (NSTAT(I), I=1,MNUMCR

- 2) 457 FORMA T(16X,9F10.2) READ(NGDTAR,458) (CNG_RETAIL_MARKUP(I), I=1,DNODES) 458 FORMAT(16X,12F10.2)READ(NGDTAR,459) CNG_MARKUP

459 FORMAT(16X,F10.3)

NGDTAR=FILE_MGR('C',FNAME,.FALSE.) !EEE CLOSE(UNIT=NGDTAR)

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! ! READ STEO DATA ! ! STATUS: UNDER CONSTRUCTION ! ! CALLED BY: NGMAIN ! ! CALLS: NGREAD_USRDATA ! ! = = = = = = = = = = = = = = = = = = = = = = = = = = = = SUBROUTINE NGREAD_STEODATA(NGUSER) IMPLICIT NONE

include 'parametr' include 'ngparinc' include 'ngtdminc' include 'ngsteoinc' include 'ogglobal'

INTEGER*4 I,J ! COUNTERS INTEGER*4 SEC ! SECTOR ID INTEGER*4 NGUSER ! INPUT UNIT NUMBER

INTEGER*4 STYR1,STYR2 ! 1ST & LAST STEO YRS (I.E.:5 & 6) INTEGER*4 ST1ST,STLAST ! 1ST & LAST STEO YRS (I.E.:1994,1995) INTEGER*4 CYR ! STEO YEAR LOOP ID INTEGER*4 RTOVALUE INTEGER*4 STEO_NEMS ! LOCAL HOLDER OF GLOBAL STEO BENCHMARK SWITCH !

-----------
STEO_NG = RTOVALUE('STEONG ',0) STINPUT_SCAL = RTOVALUE('STSCALNG',0) STEO_NEMS = RTOVALUE('STEOBM ',0) IF (STEO_NEMS.EQ.1) STEO_NG = 1 IF (STEO_NG .EQ. 0) STINPUT_SCAL = 0

!==================== ! READ IN STEO DATA !====================

! STEO YEAR LNG IMPORTS, BY ENTRY POINT CALL NEXTDATA(NGUSER)READ(NGUSER,*) STLNGRGN,(STLNGRG(I),I=1,STLNGRGN) READ(NGUSER,*) STLNGYRN DO J=1,STLNGYRN READ(NGUSER,*) STLNGYR(J), (STLNGIMP(I,J),I=1,STLNGRGN) ENDDO

CALL NEXTDATA(NGUSER) !CC READ(NGUSER,911) STPHAS_YR, STINPUT_SCAL READ(NGUSER,911) STPHAS_YR ! STINPUT_SCAL SET ABOVE 911 FORMAT(20X,I4,/20X,I4)

!CC STINPUT_SCAL = RTOVALUE('STSCALNG',0) ! overrides data read

CALL NEXTDATA(NGUSER) READ(NGUSER,912) (STEOYRS(CYR),CYR=1,STEO_YEA R) 912 FORMAT(26X,<STEO_YEAR>(6X,I4)) READ(NGUSER,*) (STSCAL_CAN(CYR),CYR=1,STEO_YEAR)

ST1ST = STEOYRS(1) STLAST = STEOYRS(STEO_YEAR) STYR1 = ST1ST

- IBASYR+1 STYR2 = STLAST

- IBASYR+1

! READ SCALE FACTORS FOR STEO BENCHMARKING

CALL NEXTDATA(NGUSER) READ(NGUSER,913) (STSCAL_PFUEL(CYR),CYR=ST1ST,STLAST) READ(NGUSER,913) (STSCAL_LPLT(CYR),CYR=ST1ST,STLAST) READ(NGUSER,913) (STSCAL_WPR(CYR),CYR=ST1ST,STLAST) READ(NGUSER,914) WPR4CAST_FLG READ(NGUSER,913) (STSCAL_DISCR(CYR),CYR=ST1ST,STLAST) READ(NGUSER,913) (STSCAL_SUPLM(CYR),CYR=ST1ST,STLAST) READ(NGUSER,913) (STSCAL_NETSTR(CYR),CYR=ST1ST,STLAST) READ(NGUSER,*) ! skip a line DO SEC=1,DSEC REA D(NGUSER,913) (STSCAL_FPR(SEC,CYR),CYR=ST1ST,STLAST) ENDDO DO SEC=1,DSEC READ(NGUSER,913) (STSCAL_IPR(SEC,CYR),CYR=ST1ST,STLAST) ENDDO 913 FORMAT(28X,<STEO_YEAR>(1X,F9.4)) 914 FORMAT(60X,A3)

CALL NEXTDATA(NGUSER) READ(NGUSER,915) (STQGPTR(CYR),CYR=STYR1,STYR2) ! TCF READ(NGUSER,915) (STQLPIN(CYR),CYR=STYR1,STYR2) ! TCF CALL NEXTDATA(NGUSER) READ(NGUSER,915) (STOGWPRNG(CYR),CYR=STYR1,STYR2) ! NOMINAL$/MCF READ(NGUSER,915) (STPNGRS(CYR),CY R=STYR1,STYR2) ! NOMINAL $/MCF READ(NGUSER,915) (STPNGCM(CYR),CYR=STYR1,STYR2) ! NOMINAL $/MCF READ(NGUSER,916) STPIN_FLG,(STPNGIN(CYR),CYR=STYR1,STYR2) ! NOMINAL $/MCF READ(NGUSER,915) (STPNGEL(CYR),CYR=STYR1,STYR2) ! NOMINAL $/MCF CALL NEXTDATA(NGUSER)READ(NGUSER,915) (STOGPRSUP(CYR),CYR=STYR1,STYR2) ! TCF READ(NGUSER,915) (NNETWITH(CYR),CYR=STYR1,STYR2) ! TCF READ(NGUSER,*) ! skip a line READ(NGUSER,915) (STDISCR(CYR),CYR=STYR1,STYR2) ! TCF READ(NGUSER,915) (STENDCON(CYR),CYR=STYR1,STYR2) ! TCF 915 FORMAT(27X,<STEO_YEAR>(4X,F6.3)) 916 FORMAT(24X,A3,<STEO_YEAR>(4X,F6.3))

! CONVERT FROM TCF TO BCF & NOMINAL TO REAL $/MCF.

DO CYR = STYR1,STYR2 STQGPTR(CYR) = STQGPTR(CYR) * 1000. STQLPIN(CYR) = STQLPIN(CYR) * 1000. NNETWITH(CYR) = NNETWITH(CYR) * 1000. STOGPRSUP(CYR) = STOGPRSUP(CYR) * 1000. ! SNG + COAL + OSUP STOGWPR NG(CYR) = STOGWPRNG(CYR) / (oMC_PCWGDP(CYR)/oMC_PCWGDP(

- 2)) STPNGRS(CYR) = STPNGRS(CYR) / (oMC_PCWGDP(CYR)/oMC_PCWGDP(

- 2))

STPNGCM(CYR) = STPNGCM(CYR) / (oMC_PCWGDP(CYR)/oMC_PCWGDP(

- 2)) STPNGIN(CYR) = STPNGIN(CYR) / (oMC_PCWGDP(CYR)/o MC_PCWGDP(

- 2)) STPNGEL(CYR) = STPNGEL(CYR) / (oMC_PCWGDP(CYR)/oMC_PCWGDP(

- 2)) STPNGEL(CYR) = STPNGEL(CYR) * oCFNGU(CYR)

! REPLACE OSUP_TOT FOR STEO YEARS IN SUBROUTINE NGSTEO_OSUP ! CHANGE REPRESENTATION OF DISCR FROM (DMD

- SUP) TO (SUP

- DMD)

STDISCR(CYR) =

- 1. * STDISCR(CYR) * 1000. STENDCON(CYR) = STENDCON(CYR) * 1000. ENDDO

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! ! LOOPS THRU DATA FILE UNTIL NEXT RECORD TO BE READ IS FOUND ! ! STATUS: COMPLETE ! ! = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! SUBROUTINE NEXTDATA(UNITNUM) IMPLICIT NONE

include 'parametr' include 'ngparinc' include 'ngitminc'

INTEGER*4 UN ITNUM ! UNIT NUMBER CHARACTER*1 CH ! BEGINNING OF DATA FLAG

!

-------------

! READ UNTIL @ IN 1ST COLUMNCH = 'A' DO WHILE (CH .NE. '@') READ(UNITNUM,10) CH ENDDO 10 FORMAT(A1)

RETURN END

!================================================================ ! ! SET VARIABLES TO INITIAL VALUES ! ! STATUS: COMPLETE ! ! OUTPUT VARIABLES: ARC_FIXTAR = 0 ! INTRAST_TAR = 0 (INTRAREG_TAR SET BY PTM) ! ACTPCAP = 0 ! !================================================================

SUBROUTINE NGSET_INIT IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngitminc' include 'ngcdmdin c' include 'ngsteoinc' include 'ogglobal'

INTEGER*4 NET ! PK/OP NETWORK INTEGER*4 SEC ! SEC ID INTEGER*4 A ! ARC ID INTEGER*4 YR ! YEAR ID INTEGER*4 N ! NODE ID INTEGER*4 I ! COUNTER INTEGER*4 RTOVALUE ! NEMS FUNC FOR RUNTIME PARAMETERS INTEGER*4 JENDYR ! LAST YEAR VALUE CORRESPONDS TO IENDYR EXTERNAL RTOVALUE !

------------

JENDYR = RTOVALUE('IJUMPCAL',2030)

! SET CO NSTANT DMD VARIABLE CONST_DMD
CONST_DMD = RTOVALUE('NGDEMAND',0)

! SET FIXED TARIFFS FOR PIPE, STORAGE, & SUPPLY = 0.0

DO NET=1,NETWORK DO A=1,NARCS DO YR=IBASYR,JENDYRARC_FIXTAR(NET,A,YR) = 0.0 ENDDO ENDDO ENDDO

! SET INTRA STATE TARIFFS = 0.0

DO N=1,DNODES INTRAST_TAR(N) = 0.0 DO NET=1,NETWORK DO YR=IBASYR,JENDYR DISCR(NET,N,YR) = 0.0 ENDDO ENDDO ENDDO

! SET ACTUAL CAPACITY ALONG ALL ARCS = 0.0

DO A=1,NARCS ACTPCAP(A) = 0.0 DO NET=1,NETWORK FLOW(NET,A) = 0.0 ENDDO ENDDO DO A=1,SARCS SACTPCAP(A) = 0.0 DO YR=IBASYR,JENDYR SAFLOW(A,YR) = 0.0 ENDDO ENDDO

! SET INITIAL STEO SCALE FACTORS FOR PIPEFUEL, LEASE & PLANT, ! WELLHEAD PR, END

- USE PRICE (F & I)

DO YR=IBASYR,JENDYR SCALE_LP(YR) = 1.0 SCALE_PF(YR) = 1.0 SCALE_WPR(YR) = 1.0 SCALE_SUPLM(YR) = 1.0 DO SEC=1,DSEC SCALE_FPR(SEC,YR) = 0.0 SCALE_IPR(SEC,YR) = 0.0 ENDDO SCALE_DISCR(YR) = 0.0 SCALE_NETSTR(YR) = 0.0 ENDDO

DO N=1,uSNODES RPSHIFT(N) = 0.0 DO YR=IBASYR,LHISYR HIST_RPSHIFT(N,YR)=0.0 ENDDO ENDDO! SET INITIAL CGBENCH FOR DEMAND NODES

DO NET=1,NETWORK DO N=1,DNODES CGBENCH(NET,N) = 0.0 ENDDO ENDDO
! SET INITIAL PFUEL_FAC FOR ALL TNODES

DO NET=1,NETWORK DO N=1,TNODES PFUEL_FAC(NET,N) = .05 ENDDO ENDDO

! INITIALIZE GLOBAL ANGTS VARIABLE

oOGQANGTS = 0.0

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! ! TRANSFER HIST HPKUTZ & HOPUTZ TO PKUTZ & OPUTZ ! ! STATUS: ! ! CALLED BY: NGMAIN ! ! = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! SUBROUTINE NGSET_UTZ IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'nghistinc' include 'ngitminc' include 'ngtdminc'

INTEGER*4 L ! COUNTERS

!

----------

IF (MODYR .LT. LHISYR) THEN DO L=1,NARCS PKUTZ(L) = HPKUTZ(L,MODYR) OPUTZ(L) = HOPUTZ(L,MODYR) ENDDO ELSE IF (MODYR .EQ. LHISYR) THEN DO L=1,NARCSPKUTZ(L) = HPKUTZ(L,MODYR) OPUTZ(L) = .99 ENDDO ELSE DO L=1,NARCS PKUTZ(L) = HPKUTZ(L,LHISYR) OPUTZ(L) = HOPUTZ(L,LHISYR) ENDDO ENDIF

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! ! UPDATE CURPCAP AND SET PCAP AND FLOW FOR PTM PROCESSING ! CURPCAP ! PTCURPCAP ! PTCURPSTR ! SACTPCAP ! PTPIPFLOW ! PTSTRFLOW ! ! STATUS: ! ! CALLED BY: NGMAIN ! ! = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! SUBROUTINE NGSET_PTMVAR IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngtdminc' include 'ngitminc' include 'ngptmitm' include 'nghistinc' include 'ngcdmdinc' include 'ogglobal'

INTEGER*4 L,A,N,K ! COUNTERS INTEGER*4 DEST ! NODE ON TREE (DEST NODE) INTEGER*4 SRC ! SOURCE NODE ALONG ARC INTEGER*4 STID ! STORAGE ID (1

- 14) !

-------------

! UPDATE CURPCAP (FOR PRIMARY ARCS ONLY)DO A=1 ,NARCS SRC = ARC_2NODE(A,1) DEST= ARC_2NODE(A,2)

! IF DEMANDS ARE FALLING, DELAY CANADIAN CAP ADDITIONS ! ??? may want to put this under a conditional to apply ! ??? only if CNCAPSW=0

IF (SRC .GT. DNODES) THEN IF (MOD YR.GT.NOBLDYR+2) THEN IF ( (oQNGAS(11,CURIYR

- 1)

- oQNGAS(11,CURIYR

- 2)) .LT. 0.0) THEN IF (CURIYR.LT.LASTYR) THEN

DO K=LASTYR+IBASYR

- 1,MODYR+1,

- 1 PLANPCAP(A,K) = PLANPCAP(A,K

- 1) ENDDO ENDIF PLANPCAP(A,MODYR) = 0.0 ENDIF ENDIF ENDIF
! NOTE: CURPCAP FOR SUP UPDATED IN NGSET_MAXPCAP

CURPCAP(A,MODYR) = ACTPCAP(A) + PLANPCAP(A,MODYR)

! UPDATE PTCURPCAP & PTCURPSTR FOR PRIMARY ARCS

IF ((SRC .LE. TNODES) .AND. (DEST .LE. TNODES)) THEN ! pipeline PTCURPCAP(SRC,DEST) = CURPCAP(A,MODYR) ELSE IF(SRC .GT. (TNODES+SNODES)) THEN ! storage STID = SRC

- (TNODES+SNODES) PTCURPSTR(STID) = CURPCAP(A,MODYR) ENDIF ENDDO

! UPDATE PTCURPCAP AND SACTPCAP FOR SECONDARY ARCS ! NOTE: 1990 SET WHEN SPLANPCAP DATA ARE READ IN ! N OTE: INCLUDES INTRAREGIONAL (SRC=DEST) PLANNED ADDITIONS

DO A=1,SARCS SRC = SARC_2NODE(A,1) DEST= SARC_2NODE(A,2) IF (MODYR .GT. IBASYR) THEN SACTPCAP(A) = SACTPCAP(A) + SPLANPCAP(A,MODYR) PTCURPCAP(SRC,DE ST) = SACTPCAP(A) IF ((SRC.EQ.DEST) .AND. (DEST.LE.DNODES)) THEN ! check against PK cap equivalent PTCURPCAP(SRC,DEST) = AMAX1(PTCURPCAP(SRC,DEST), &

(INTRA_FLO(PKNET,DEST,MODYR

- 1) / & (PKSHR_YR * PTPKUTZ(SRC,DEST))))! check against OP cap

equivalent PTCURPCAP(SRC,DEST) = AMAX1(PTCURPCAP(SRC,DEST), &

(IN TRA_FLO(OPNET,DEST,MODYR

- 1) / & ((1.

- PKSHR_YR) * PTOPUTZ(SRC,DEST)))) SACTPCAP(A) = PTCURPCAP(SRC,DEST) ENDIF ENDIF ENDDO

! SET PTPIPFLOW VARIABLE FOR USE BY PTM

IF (MODYR .EQ. IBASYR) THEN DO A=1,NARCS SRC = ARC_2NODE(A,1) DEST= ARC_2NODE(A,2) IF ((SRC.LE.TNODES) .AND. (DEST.LE.TNODES)) THEN PTPIPFLOW(SRC,DEST) = HAFLOW(A,MODYR) DO K=FHISYR,LHISYR

- 1 HPTPIPFLOW(A,K) = HAFLOW(A,K) ENDDO DO N=1,NETWORK PTNETFLOW(N,SRC,DEST) = FLOW(N,A) ENDDO ENDIF ENDDO DO A=1,SARCS SRC = SARC_2NODE(A,1) DEST= SARC_2NODE(A,2) PTPIPFLOW(SRC,DEST) = SAFLOW(A,MODYR) IF (SRC .EQ. DEST .AND. DEST.LE.DNODES) THEN DO K=FHISYR,LHISYR

- 1 HPTPIPFLOW(NARCS+SRC,K) = SAFLOW(A,K) ENDDO ENDIF ENDDO

ELSE IF(MODYR .LE. LHISYR+1) THEN DO A=1,NARCS SRC = ARC_2NODE(A,1) DEST= ARC_2NODE(A,2) IF ((SRC.LE.TNODES) .AND. (DEST.LE.TNODES)) THEN PTPIPFLOW(SRC,DEST) = HAFLOW(A,MODYR

- 1) DO N=1,NETWORK PTNETFLOW(N,SRC,DEST) = FLOW(N,A) ENDDO ENDIF ENDDO DO A=1,SARCS SRC = SARC_2NODE(A,1) DEST= SARC_2NODE(A,2) PTPIPFLOW(SRC,DEST) = SAFLOW(A,MODYR

- 1) IF ((SRC.EQ.DEST) .AND. (DEST.LE.DNODES)) THEN DO N=1,NETWORKPTNETFLOW(N,SRC,DEST) = INTRA_FLO(N,DEST,MODYR

- 1) ENDDO ENDIF ENDDO

ELSE DO A=1,NARCS SRC = ARC_2NODE(A,1) DEST= ARC_2NODE(A,2) IF ((SRC.LE.TNODES) .AND. (DEST.LE.TNODES)) THEN PTPIPFLOW(SRC,DEST) = 0.0 DO N=1,NETWORK PTNETFLOW(N,SRC,DEST) = FLOW(N,A) PTPIPFLOW(SRC,DEST) = PTPIPFLOW(SRC,DES T) + FLOW(N,A) ENDDO ENDIF ENDDO DO A=1,SARCS SRC = SARC_2NODE(A,1) DEST= SARC_2NODE(A,2) PTPIPFLOW(SRC,DEST) = SAFLOW(A,MODYR

- 1) ENDDO ENDIF ! SET REVE NUE FROM FLOWS DO A=1,NARCS SRC = ARC_2NODE(A,1) DEST= ARC_2NODE(A,2) IF ((SRC.LE.TNODES) .AND. (DEST.LE.TNODES)) THEN PTPIP_REV(SRC,DEST) = & ARC_ENDFEE(PKNET,A) * PTNETFLOW(PKNET,SRC,DEST) + & ARC_ENDFEE(OPNET,A) * PTNETFLOW(OPNET,SRC,DEST) ENDIF ENDDO

IF (NGDBGITR(2,17)) THEN DO SRC=1,TNODES DO N=1,NETWORK WRITE(NGOPTM,11) MODYR,N,SRC,(PTNETFLOW(N,SRC,DEST), & DEST=1,TN ODES) ENDDO WRITE(NGOPTM,11) MODYR,N,SRC,(PTPIPFLOW(SRC,DEST), & DEST=1,TNODES) WRITE(NGOPTM,12) MODYR,N,SRC,(PTPIP_REV(SRC,DEST), & DEST=1,TNODES) ENDDO ENDIF

11 FORMAT(1X,'PTNETFLOW: ' ,I4,I4,I4,12F7.1,/ &

1X,'PTNETFLOW: ',8X,12F7.1) 12 FORMAT(1X,'PTPIP_REV: ',I4,I4,I4,12F7.1,/ &

1X,'PTPIP_REV: ',8X,12F7.1)

! SET PTSTRFLOW VARIABLE FOR USE BY PTMIF (MODYR .EQ. IBASYR) THEN DO A=1,NARCS SRC = ARC_2NODE(A,1) DEST= ARC_2NODE(A,2) IF (SRC.GT.(TNODES+SNODES) ) THEN STID = SRC

- (TNODES+SNODES) ! 1

- 14 PTSTRFLOW(STID) = HAFLOW(A,MODYR) ENDIF ENDDO

ELSE IF(MODYR .LE. LHISYR+1) THEN DO A=1,NARCS SRC = ARC_2NODE(A,1) DEST= ARC_2NODE(A,2) IF (SRC.GT.(TNODES+SNODES) ) THEN STID = SRC

- (TNODES+SNODES) ! 1

- 14 PTSTRFLOW(STID) = HAFLOW(A,MODYR

- 1) ENDIF ENDDO

ELSE DO A=1,NARCS SRC = ARC_2NODE(A,1) DEST= ARC_2NODE(A,2) IF (SRC.GT.(TNODES+SNODES) ) THEN STID = SRC

- (TNODES+SNODES) ! 1

- 14 PTSTRFLOW(STID) = FLOW(PKNET,A) ! peak only ENDIF ENDDO ENDIF ! SET REVENUE FROM FLOWS DO A=1,NARCS SRC = ARC_2NODE(A,1) DEST= ARC_2NODE(A,2) IF (SRC.GT.(TNODES+SNODES) ) THEN STID = SRC

- (TNODES+SNODES) ! 1

- 14 PTSTR_REV(STID) = ARC_ENDFEE(PKNET,A) * PTSTRFLOW(STID) ! peak only ENDIF ENDDO

IF (NGDBGITR(2,17)) THEN DO STID=1,STN ODES WRITE(NGOPTM,13) MODYR,STID,PTSTRFLOW(STID), & PTSTR_REV(STID) ENDDO ENDIF 13 FORMAT(1X,'PTSTRFLOW,_REV: ',I4,I4,12F7.1)

RETURN END

!================================================= ===============!

! SET ALASKAN CONSUMPTION AND END

- USE PRICE LEVELS ! DEFINE ALASKAN WELLHEAD PRICE AND PRODUCTION LEVELS ! ! STATUS: COMPLETE ! ! CALLED BY: NGITM_PRE ! ! FREQUENCY: EVERY NEMS ITERATION AND YEAR ! ! INPUT VARIABLES: ! OGPNGIMP(6,YR)

- PRICE AT CAN/US BORDER IN WASHINGTON STATE ! OGQANGTS(YR)

- QUANTITY FLOWING IN ANGTS AT CAN/US BORDER ! OGQNGEXP(10,YR)

- EXPORTS TO JAPAN ! QGFELGR,OGIELGR,OGCELGR(NNGEM,YR)

- FIRM, INTER, COMP EU CONSUMP ALK ! ! OUTPUT VAR IABLES: ! OGPRDNG(MNUMOR,MNUMYR) ! ALASKA ONLY (10

- 12) ! OGWPRNG(MNUMOR,MNUMYR) ! ALASKA ONLY (10

- 12) ! AKQTY_F(5) ! AKQTY_I(5) ! AKPR_F(5) ! AKPR_I(5) ! QALK_PIP ! QALK_LAP ! ! ASSUMPTIONS: !

- ALL NONUTILITY DEMAND IS F IRM ! !================================================================

SUBROUTINE NGDMD_ALK IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngtdminc' include 'ngitminc' include 'nghistinc' include 'ngcdmdinc' include 'ngakinc' include 'ogglobal'

INTEGER*4 I,J ! COUNTER

REAL*4 AK_CONS_S ! TOT END

- USE CONSUMPTION IN S AK REAL*4 QALK_LAP_N ! LEASE AND PLANT CONS IN THE NORTH REAL*4 QALK_LAP_NLAG ! LEASE AND PLANT LAG TERM REAL*4 QALK_LAP_S ! LEASE AND PLANT CONS IN THE SOUTH REAL*4 QALK_LAP_A ! LEASE AND PLANT CONS REL TO AN GTSREAL*4 QALK_PIP_N ! PIPE FUEL CONS IN THE NORTH REAL*4 QALK_PIP_S ! PIPE FUEL CONS IN THE SOUTH REAL*4 QALK_PIP_A ! PIPE FUEL CONS REL TO ANGTS REAL*4 AK_PROD(3) ! PROD S,N,ANGTS REAL*4 AK_WPRC(3) ! WELL PRICE S,N,ANGTS REAL*4 AKQTY(DSEC) ! F+I CONS BY SECTOR FOR REPORT REAL*4 EXPJAP ! LNG EXPORTS FROM AK TO JAP AN REAL*4 WPRLAG ! LAGGED AK WELLHEAD PRICE "SOUTH" REAL*4 PREV_AKQTY(DSEC

- 1,IBASYR:IENDYR) ! AK DMD FOR T

- 1 (BCF) REAL*4 PREV_AKPR(2,IBASYR:IENDYR) ! AK PRICE FOR LAGGED YEARS (87$/MCF), RS&CM REAL*4 AKGT L_LAP ! LEASE AND PLANT ASSOCIATED W/GTL (ASSUME NO PIPE) REAL*4 YEAR ! YEAR VARIABLE FOR ESTIMATIONS (1967=0) REAL*4 AVG_HDD ! AVG OF PREVIOUS HDD REAL*4 CNT_HDD ! COUNT FOR COMPUTING AVG_HDD
LOGICAL FIRSTIM /.TRUE./ ! SET PREV_AKQTY = HAKQTY_F (ONLY ONCE) LOGICAL FIRSTIM2 /.TRUE./ ! A SECOND FIRST TIME THROUGH SWITCH !

------------------------------------

! INITIALIZATIONS (ONLY ELEC ASSUMED TO HAVE NONCORE CONSUMPTION)

DO I=1,DSEC AKQTY_I(I) = 0.0 END DO

! VALUES FROM OTHER NEMS MODULES
AKQTY_F(5) = oQGFELGR(NNGEM,CURIYR) / oCFNGU(CURIYR) AKQTY_I(5) = oQGIELGR(NNGEM,CURIYR) / oCFNGU(CURIYR) EXPJAP = oOGQNGEXP(10,CURIYR)

! FOR HISTORICAL YEARS, USE HISTORICAL ARRAYS TO SET ALASKA P & Q

IF (MODYR .GT. EHISYR) THEN

! ASSIGN LAGGED VALUES

WPRLAG = oOGWPRNG(12,CURIYR

- 1)

IF (FIRSTIM) THEN DO J=IBASYR,EHISYR DO I=1,DSEC

- 1 PREV_AKQTY(I,J) = HAKQTY_F(I,J) IF (I.LE.2) PREV_AKPR(I,J) = HAKPR_F(I,J) ENDDO ENDDO QALK_LAP_NLAG = HQALK_LAP(EHISYR) FIRSTIM = .FALSE. ENDIFIF (CURITR .EQ. 1) THEN DO I=1,DSEC

- 1 PREV_AKQTY(I,MODYR

- 1) = AKQTY_F(I) IF (I.LE.2) PREV_AKPR(I,MODYR

- 1) = AKPR_F(I) ENDDO IF (MODYR.GT.EHISYR+1) QALK_LAP_NLAG = QALK_LAP_N ENDIF

! SET NORTH ALASKA VALUES

!!!!! QALK_LAP_N = 197.94 + 35.189 * ALOG(REAL(MODYR

- 1989)) ! excel log trend line data 1990

- 2005, R2=.7866

!!!!! QALK_LAP_N = ((51524.24) + (126.3955 * MODYR) + (0.945190 * QALK_LAP_NLAG))/1000.

QALK_LAP_N = ((0.9 43884 * QALK_LAP_NLAG) + (0.038873 * (oOGPRCOAK(1,CURIYR) + oOGPRCOAK(2,CURIYR) + oOGPRCOAK(3,CURIYR))))

AK_PROD(2) = QALK_LAP_N ! assume bulk of north cons is l&p, other modeled as total alaska even though south

QALK_PIP_N = 0.0

! ES TABLISH WELLHEAD PRICES ! SET PRICE FOR ANGTS AS A SET EXOGENOUSLY

!!!!! AK_WPRC(1) = AK_F(1) + (AK_F(2) * (MODYR

- 1969)) & !!!!!

- ( AK_F(3) * (WPRLAG

- (AK_F(1) + (AK_F(2)*(MODYR

1969

- 1)) ) ) )

!!!!! AK_WPRC(1) = (0.652 076*(WPRLAG)) + (0.033365*(oIT_WOP(CURIYR,1)))

AK_WPRC(1) = (WPRLAG**0.934077) * (oIT_WOP(CURIYR,1)**(0.280760*(1

- 0.934077)))

!!!!! AK_WPRC(1) = AMIN1(AK_WPRC(1),oOGWPRNG(13,CURIYR))

oOGWPRNG(12,CURIYR) = AK_WPRC(1) AK_WPRC(2) = AK_WPRC(1) AK_WPRC(3) = FR_PMINWPR(1)

! ESTABLISH END

- USE PRICES (SET ALL TO FIRM PRICE)
!!!! AKPR_F(2) = exp( 0.282 + (0.975*alog(PREV_AKPR(2,MODYR

- 1)))

- (0.347*alog(PREV_AKPR(2,MODYR

- 2))) & !!!! + (0.081*alog(AK_WPRC(1)) ) )
!!!! AKPR_F(1) = exp( (0.617*alog(PREV_AKPR(1,MODYR

- 1))) + (0.335*alog(PREV_AKPR(1,MODYR

- 2))) & !!!!

- (0.117*alog(PREV_AKPR(1,MODYR

- 3))) + (0.440*alog(AKPR_F(2))) & !!!!

- (0.199*alog(PREV_AKPR(2,MODYR

- 1))) )AKPR_F(1) = AK_WPRC(1) + AK_RM AKPR_F(2) = AK_WPRC(1) + AK_CM AKPR_F(3) = AK_WPRC(1) + AK_IN AKPR_F(4) = AKPR_F(2) AKPR_F(5) = AK_WPRC(1) + AK_EM DO I=1,DSEC AKPR_I(I) = AKPR_F(I) END DO

! S ET TOTAL CONSUMPTION ARRAYS

YEAR = REAL(MODYR

- 1967)

!!!! AK_HDD(MODYR) = exp(6.917

- (0.002*YEAR) + (0.255*alog(AK_HDD(MODYR

- 1)))) ! do 5 year average instead

AVG_HDD = 0.0 CNT_HDD = 0.0 DO I=MODYR

- 5,MODYR

- 1 CNT_HDD = CNT_HDD + 1 AVG_HDD = AVG_HDD + AK_HDD(I) ENDDO AK_HDD(MODYR) = AVG_HDD / CNT_HDD

AK_RN(MODYR) = exp(

- 2.677 + (0.888*alog(AK_RN(MODYR

- 1)))

- (0.185*alog(AK_RN(MODYR

- 2))) & + (0.626*alog(AK_POP(MODYR))))

!!!! AK_RN(MODYR) = 2.020549 + (1.541130 * AK_RN(MODYR

- 1)) + (

- 0.551130 * AK_RN(MODYR

- 2))

!!!! AK_CN(MODYR) = exp(

- 6.081 + (0.422*alog(AK_CN(MODYR

- 1))) + (1.182*alog(AK_POP(MODYR))))

AK_CN(MODYR) = 0.932946 + (0.937471 * AK_CN(MODYR

- 1))

!!!! AKQTY_F(1) = exp(8.874 + (0.257*alog(PREV_AKQTY(1,MODYR

1)*1000.))

- (0.356*alog(PREV_AKQTY(1,MODYR

- 2)*1000.)) & !!!!

- (0. 240*alog(PREV_AKQTY(1,MODYR

- 4)*1000.)) + (0.902*alog(AK_RN(MODYR))) & !!!!

- (0.664*(alog(AKPR_F(1))

- alog(PREV_AKPR(1,MODYR

- 1)))))/1000.

!!!! AKQTY_F(2) = exp( (

- 0.014*YEAR) + (0.483*alog(PREV_AKQTY(2,MODYR

1)*1000.)) + (0.430* alog(AK_CN(MODYR))) & !!!! + (0.483*alog(AK_HDD(MODYR))) )/1000.

!!!! AKQTY_F(2) = ((6.379368*YEAR) + (0.640961 * (PREV_AKQTY(2,MODYR

1)*1000.)) + (792.2762*(AK_CN(MODYR))))/1000.

!!!! AKQTY_F(2) = (exp(9.083810 * (1

- 0.588526)) * ((PREV_AKQTY(2,MODYR

- 1)*1000.)**(0.588526)) * & !!!! ((AK_CN(MODYR))**(0.370609 * (1

- 0.588526))))/1000.AKQTY_F(2) = (exp(9.425307 * (1

- 0.736334)) *

(AK_CN(MODYR)**(0.205020)) * (AK_CN(MODYR

- 1)**(

- 0.736334 * 0.205020)) * & ((PREV_AKQTY(2,MODYR

- 1)*1000.)**(0.736334)))/1000.

!!!! AKQTY_F(1) = EXP(AK_C(1)) * & !!!! (PREV_AKQTY(1,MODYR

- 1)**AK_C(2)) * & !!!! (AK_RN(MODYR)**AK_C(3)) * & !!! ! (AK_RN(MODYR

- 1)**AK_C(4)) !!!! AKQTY_F(2) = EXP(AK_D(1)) * & !!!! (PREV_AKQTY(2,MODYR

- 1)**AK_D(2)) * & !!!! (AK_CN(MODYR)**AK_D(3)) * & !!!! (AK_CN(MODYR

- 1)**AK_D(4)) * & !!!! (PREV_AKQTY(2,MODYR

- 2)**AK_D(5)) * & !!!! (AK_CN(MODYR

- 2)**AK_D(6)) !!!! AKQTY_F(1) = ((4672.9 * (1

- 0.354119)) + (129.5041 * ((AK_RN(MODYR))

- (0.354119 * (AK_RN(MODYR

- 1))))) + & !!!! (0.354119 * (PREV_AKQTY(1,MOD YR

- 1))))/1000.

AKQTY_F(1) = (exp(6.983794 * (1

- 0.364042)) * (AK_RN(MODYR))**(0.601932 * (1

- 0.364042)) * & (PREV_AKQTY(1,MODYR

- 1)*1000)**(0.364042))/1000.

!!!! AKQTY_F(2) = (exp(9.31728 * (1

- 0.896211 + 0.23222) ) * (AK_CN(MODYR)**0.251339) * & !!!! (AK_CN(MODYR

- 1)**(0.251339 * (1

- 0.896211 + 0.23222))) * (AK_CN(MODYR

- 2)**(0.23222 * 0.251339)) * & !!!! ((PREV_AKQTY(2,MODYR

- 1)*1000)**0.896211) * ((PREV_AKQTY(2,MODYR

- 2)*1000)**(

- 0.23 222)))/1000.

AKQTY_F(3) = AK_QIND_S(MODYR) AKQTY_F(4) = 0.0

! SET SOUTH ALASKA VALUES

AK_CONS_S = 0.0 DO I=1,DSEC AK_CONS_S = AK_CONS_S + AKQTY_F(I) + AKQTY_I(I) ENDDO

!!!! QALK_LAP_S = (AK_CONS_S + EXPJAP) * AK_PCTLSE(2)

QALK_LAP_S = 0.0 ! bulk in north, modeled as total QALK_PIP_S = (AK_CONS_S + EXPJAP) * AK_PCTPIP(2) * FE_PFUEL_FAC(MODYR)

AK_PROD(1) = AK_CONS_S + EXPJAP + QALK_LAP_S + QALK_PIP_S

- AK_DISCR(MODYR)

! ESTABLISH ANGTS RELATED VALUES ! AK_PROD(3) = N. ANGTS ONLY

oOGQANGTS(CURIYR) = QAK_ALB(MODYR) / (1.

- AK_PCTLSE(3)

- AK_PCTPLT(3)

- (AK_PCTPIP(3)*FE_PFUEL_FAC(MODYR)))

AK_PROD(3) = oOGQANGTS(CURIYR)QALK_LAP_A = AK_PROD(3) * (AK_PCTLSE(3) + AK_PCTPLT(3)) QALK_PIP_A = AK_PROD(3) * AK_PCTPIP(3) * FE_PFUEL_FAC(MODYR)

! SET PIPELINE AND LEASE AND PLANT FUEL VALUES ! (USED LATER IN SETTING GLOBAL NEMS ARRAYS)

QALK_LAP = QALK_LAP_N + QALK_LAP_S + Q ALK_LAP_A QALK_PIP = QALK_PIP_N + QALK_PIP_S + QALK_PIP_A

! ACCOUNT FOR GTLs HERE BECAUSE US L&P CONSISTENT W/ANGTS, ! ASSUME NO PIPELINE FUEL W/GTL ! ADD GTL CONSUMPTION TO INDUSTRIAL CONSUMPTION IN THE NORTH

AKGTL_LAP = oAKGTL_NGCNS(CURIYR) * (AK_PCTLSE(3)+AK_PCTPLT(3)) AK_PROD(3) = AK_PROD(3) + oAKGTL_NGCNS(CURIYR) + AKGTL_LAP QALK_LAP = QALK_LAP + AKGTL_LAP

! ASSIGN SOLUTION VALUES TO OGSM PRODUCTION ARRAYS

oOGPRDNG(10,CURI YR) = 0.0 oOGPRDNG(11,CURIYR) = AK_PROD(2) + AK_PROD(3) oOGPRDNG(12,CURIYR) = AK_PROD(1)

! ASSIGN NORTH PRICE, DEPENDING ON ANGTS

IF (AK_PROD(3).GT.0.01) THEN oOGWPRNG(11,CURIYR) = AK_WPRC(3) ELSE oOGWP RNG(11,CURIYR) = AK_WPRC(2) END IF oOGWPRNG(10,CURIYR) = oOGWPRNG(11,CURIYR)

ELSE ! DO IN HISTORICAL YEARS DO I=1,DSEC

- 1 AKQTY_F(I) = HAKQTY_F(I,MODYR) AKQTY_I(I) = HAKQTY_I(I,MODYR) A KPR_F(I) = HAKPR_F(I,MODYR) AKPR_I(I) = HAKPR_I(I,MODYR) ENDDO
AKQTY_F(5) = oQGFELGR(NNGEM,CURIYR) / oCFNGU(CURIYR) AKQTY_I(5) = oQGIELGR(NNGEM,CURIYR) / oCFNGU(CURIYR) AKPR_F(5) = HAKPR_F(5,MODYR) AKPR_I(5) = HAKPR_I(5,MODYR)

DO I=10,12 ! AK ARRAY POSITIONS J=I

- 9 ! HIST ARRAY POS 1

- 3 oOGPRDNG(I,CURIYR) = HAKPRDNG(J,MODYR) oOGWPRNG(I,CURIYR) = HAKWPRNG(J,MODYR) ENDDO AK_WPRC(1) = oOGWPRNG(12,CURIYR) AK_WPRC(2) = oOGWPRNG(11,CURIYR) AK_WPRC(3) = oOGWPRNG(11,CURIYR)! SET PIPELINE AND LEASE AND PLANT FUEL VALUES

! (USED LATER IN SETTING GLOBAL NEMS ARRAYS)

AK_PROD(3) = 0.0 AK_ PROD(2) = oOGPRDNG(11,CURIYR)

- AK_PROD(3) AK_PROD(1) = oOGPRDNG(12,CURIYR)

QALK_PIP = HQALK_PIP(MODYR) QALK_LAP = HQALK_LAP(MODYR)

ENDIF

! REPORT

IF (NGDBGITR(1,15)) THEN DO I=1,DSEC AKQTY(I) = AKQTY_F(I) + AKQTY_I(I) ENDDO IF (FIRSTIM2) THEN WRITE(NGUNIT,990) 990 FORMAT(1X,'ALK QRS QCM QIN QTR', &

' QEU PIP LAP LAPN LPLAG DISC ', & 'QSOUTH PSOUTH PNORTH PANGTS WSOUTH WNORTH ', &

' WANGTS PRS PCM PIN PTR PEU HDD ') FIRSTIM2 = .FALSE.

ENDIF WRITE(NGUNIT,1000) MODYR,(AKQTY(I),I=1,5),QALK_PIP ,QALK_LAP,QALK_LAP_N,QALK_LAP_NLAG, &

AK_DISCR(MODYR),AK_CONS_S,(AK_PROD(I),I=1,3), & (AK_WPRC(I),I=1,3),(AKPR_F(I),I=1,5),AK_HDD(MODYR) 1000 FORMAT(' ALK',I4,23F9.2) ENDIF

RETURN END

!========================== ======================================== ! ! TRANSFERS NEMS END

- USE DMDS INTO NGTDM DMD VARIABLES ! BASQTY_F, BASQTY_I, ZNGQTY_F, ZNGQTY_I, ! BASUQTY_F, BASUQTY_I, ZNGUQTY_F, ZNGUQTY_I ! ! STATUS: UNDER CONSTRUCTION ! ! CALLED BY: NGITM_PRE ! ! FREQUENCY: EVERY ITERATION OF EVERY YEAR ! ! INPUT VARIABLES: ! QGFELGR, QGIELGR ! QGFRS, QGFCM, QGFIN, QGFTR ! QGIRS, QGICM, QGIIN, QGITR! AKQTY_F, AKQTY_I

! NG_CENSHR ! QGFTRFV, QGFTRPV ! ! OUTPUT VARIABLES: ! BASQTY_F(5,12) ZNGQTY_F(5,12) ! BASQTY_I(5,12) ZNGQTY_I(5,12) ! BASUQTY_F(21) ZNGUQTY_F(21) ! BASUQTY_I(21) ZNGUQTY_I(21) ! BASQ_TRFV(12) ! BASQ_TRPV(12) ! ! NOTES: ! ! !============================================= ================== SUBROUTINE NGSET_BASDMD IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngtdminc' include 'ngitminc' include 'ngcdmdinc' include 'ngakinc' include 'nghistinc' include 'ogglobal'

INTEGER*4 SEC ! SECTOR ID INTEGER*4 J,K,N ! COUNTERS INTEGER*4 FIRM/1/ ! ID FOR FIRM MARKET INTEGER*4 INTRP/2/ ! ID FOR INTRP MARKET

REAL*4 FV_SHARE ! FLEET/PERSONAL VEHICLE SHARE REAL*4 ANN ! SUM OF PK & OP EMM CONSUMPTION (ANNUAL) REAL*4 ESHR_F(NNGEM

- 1) ! ELEC CORE PKSHR BASED ON EMM SEASONAL CONSUMPTION REAL*4 ESHR_I(NNGEM

- 1) ! ELEC NONC PKSHR BASED ON EMM SEASO NAL CONSUMPTION REAL*4 BASN_PKSHR_UF(NNGEM

- 1) ! BASE YR NGTDM ELEC PKSHR CONS CORE REAL*4 BASN_PKSHR_UI(NNGEM

- 1) ! BASE YR NGTDM ELEC PKSHR CONS NONCORE REAL*4 BASE_PKSHR_UF(NNGEM

- 1) ! BASE YR EMM ELEC PKSHR CONS CORE REAL* 4 BASE_PKSHR_UI(NNGEM

- 1) ! BASE YR EMM ELEC PKSHR CONS CORE REAL*4 TOTAL

!

-------------

DO N=1,DNODES DO SEC=1,DSEC

- 1 BASQTY_F(SEC,N) = 0.0 BASQTY_I(SEC,N) = 0.0ENDDO ENDDO

! TRANSFER CONSUMPTION LEVELS TO NGTDM ARRAYS !??? ALSO MAKE SURE MAX GAS SHR IS LESS THAN GOIL TOTAL ! ! UTILITY BY 20 SUBREGIONS

-- ALASKA EXCLUDED

DO J = 1,NNGEM

- 1 ! SUBREGION ID 1

- 16 N = EMMSUB_NG(J) ! DMD NODES 1

- 12 !CC BASQTY_F(5,N) = BASQTY_F(5,N) + oQGFELGR(J,CURIYR) / oCFNGU(CURIYR) !CC BASQTY_I(5,N) = BASQTY_I(5,N) + oQGIELGR(J,CURIYR) / oCFNGU(CURIYR)

BASUQTY_F(J) = oQGFELGR(J,CURIYR) / oCFNGU(CURIYR) BASUQTY_I(J) = oQGIELGR(J,CURIYR) / oCFNGU(CU RIYR) BASUQTY_I(J) = BASUQTY_I(J) + oQGCELGR(J,CURIYR) / oCFNGU(CURIYR) END DO

! NONUTILITY BY CENSUS

DO N = 1,DNODES ! DMD NODES 1

- 12 J = NG_CENMAP(N) BASQTY_F(1,N) = BASQTY_F(1,N) + oQGFRS(J,CURIYR) / oCF NGC(CURIYR) BASQTY_F(2,N) = BASQTY_F(2,N) + oQGFCM(J,CURIYR) / oCFNGC(CURIYR) BASQTY_F(3,N) = BASQTY_F(3,N) + (oQGFIN(J,CURIYR) + &

oQGFHM(J,CURIYR)) / oCFNGC(CURIYR) BASQTY_F(4,N) = BASQTY_F(4,N) + oQGFTR(J, CURIYR) / oCFNGC(CURIYR)
BASQTY_I(1,N) = BASQTY_I(1,N) + oQGIRS(J,CURIYR) / oCFNGC(CURIYR) BASQTY_I(2,N) = BASQTY_I(2,N) + oQGICM(J,CURIYR) / oCFNGC(CURIYR) BASQTY_I(3,N) = BASQTY_I(3,N) + (oQGIIN(J,CURIYR) + &

oQGIHM(J,CURIYR)) / oCFNGC(CURIYR) BASQTY_I(4,N) = BASQTY_I(4,N) + oQGITR(J,CURIYR) / oCFNGC(CURIYR)

! FLEET/PERSONAL VEHICLES (BCF) BASQ_TRFV_F(N) = oQGFTRFV(J,CURIYR) / oCFNGC(CURIYR) BASQ_TRPV_F(N) = oQGFTRPV(J,CURIYR) / oCFNGC(CURIYR)

IF (J .EQ. 9) THEN ! EXCLUDE ALASKA DO K=1,DSEC

- 1 ! NON

- UTILITY ONLY BASQTY_F(K,N) = BASQTY_F(K,N)

- AKQTY_F(K) BASQTY_I(K,N) = BAS QTY_I(K,N)

- AKQTY_I(K)

IF (K .EQ. 4) THEN ! FLEET/PERSONAL VEHICLES FV_SHARE = oQGFTRFV(J,CURIYR) / &

(oQGFTRFV(J,CURIYR) + oQGFTRPV(J,CURIYR)) BASQ_TRFV_F(N) = BASQ_TRFV_F(N)

- &

FV_SHARE * AKQTY_F(K) BASQ_TRPV_F(N) = BASQ_TRPV_F(N)

- &

(1.

- FV_SHARE) * AKQTY_F(K) ENDIF ENDDO ENDIFENDDO

! FURTHER BREAKOUT OF NONUTILITY CONSUMPTION

DO K=1,DSEC

- 1 DO N=1,DNODES ! DMD NODES 1

- 12 BASQTY_F(K,N)=BASQTY_F(K,N) * NG_CENSHR(K,N) BASQTY_I(K,N)=BASQTY_I(K,N) * NG_CENSHR(K,N)

IF (K .EQ. 4) THEN ! FLEET/PERSONAL VEHICLES BASQ _TRFV_F(N) = BASQ_TRFV_F(N) * NG_CENSHR(K,N) BASQ_TRPV_F(N) = BASQ_TRPV_F(N) * NG_CENSHR(K,N) BASQTY_F(K,N) = BASQ_TRFV_F(N) + BASQ_TRPV_F(N) ENDIF ENDDO ENDDO

! SET INITIAL VALUES FOR ZNGQ* AND CALC AERADJ = (NGA

- MODEL DEMANDS)

IF (MODYR .LE. EHISYR) THEN

DO N=1,DNODES DO SEC=1,DSEC

- 1 ZNGQTY_I(SEC,N) = 0.0 ENDDO ZNGQTY_F(1,N) = HQRS(N,MODYR) ! RES ZNGQTY_F(2,N) = HQCM(N,MODYR) ! COM ZNGQTY_F(3,N) = HQIN(N,MODYR) ! IND ZNGQTY_F(4,N) = HQTR(N,MODYR) ! TRAN DISCR_AERADJ(N,MODYR) = 0.0 DO SEC=1,DSEC

- 1 DISCR_AERADJ(N,MODYR) = DISCR_AERADJ(N,MODYR) + ZNGQTY_F(SEC,N)

EN DDO ENDDO

DO J=1,NNGEM

- 1 ZNGUQTY_F(J) = HQEUGR(J,MODYR) ! ELEC UTIL ZNGUQTY_I(J) = 0.0 DISCR_AERADJ(EMMSUB_NG(J),MODYR) = DISCR_AERADJ(EMMSUB_NG(J),MODYR) + ZNGUQTY_F(J)

ENDDO

DO N=1,DNODES DO SEC=1,DSEC

- 1 DISCR_AERADJ(N,MODYR) = DISCR_AERADJ(N,MODYR)

- & BASQTY_F(SEC,N)

- BASQTY_I(SEC,N) ENDDO ENDDO

DO J=1,NNGEM

- 1 DISCR_AERADJ(EMMSUB_NG(J),MODYR ) = DISCR_AERADJ(EMMSUB_NG(J),MODYR)

- &BASUQTY_F(J)

-

BASUQTY_I(J)

ENDDO

! total = 0.0 ! do j=1,dnodes ! write(6,*) ' discr_aeradj 1 ',modyr,j,discr_aeradj(j,modyr) ! total = total + discr_aeradj(j,modyr) ! enddo ! write(6,*) ' tot discr_aeradj ',modyr, total

ELSE

DO N=1,DNODES DO SEC=1,DSEC

- 1 ZNGQTY_F(SEC,N) = BASQTY_F(SEC,N) ZNGQTY_I(SEC,N) = BASQTY_I(SEC,N) ENDDO ENDDO

DO J=1,NNGEM

- 1 ZNGUQTY_F(J) = BASUQTY_F(J) ZNGUQTY_I(J) = BASUQTY_I(J) ENDDO

ENDIF
! SET SEASONAL VALUES FOR BASQTY_SF, BASQTY_SI ! * * * * * * * * * * * * * * * * * * * * * * * * ! NOTE: BASQTY_* IS DEFINED FOR NON

- UTIL SEC ONLY ! BASUQTY_* IS DEFINED FOR UTILITY SECTOR ! * * * * * * * * * * * * * * * * * * * * * * * *

DO N=1,DNODES DO SEC=1,DSEC

- 1 ! NON

- UTIL S ECTORS ONLY BASQTY_SF(PKNET,SEC,N) = PKSHR_DMD(SEC,N) * BASQTY_F(SEC,N) BASQTY_SF(OPNET,SEC,N) = (1.

- PKSHR_DMD(SEC,N)) * & BASQTY_F(SEC,N) BASQTY_SI(PKNET,SEC,N) = PKSHR_DMD(SEC,N) * BASQTY_I( SEC,N) BASQTY_SI(OPNET,SEC,N) = (1.

- PKSHR_DMD(SEC,N)) * & BASQTY_I(SEC,N) ENDDO SEC = 4 ! TRANSPORTATION BASQ_TRFV_SF(PKNET,N) = PKSHR_DMD(SEC,N) * BASQ_TRFV_F(N) BASQ_TRPV_SF(OPNET,N) = (1.

- PKSHR_DMD(SEC,N)) * & BASQ_TRPV_F(N) ENDDO

! ADJUST UTILITY PKSHRS BASED ON SEASONAL CONSUMPTION FROM EMM ! FIRST SET BASE YEAR LEVELS USING FIRST FORECAST YEAR

IF (MODYR.G T.EHISYR .AND. CURITR.EQ.1) THEN DO J=1,NNGEM

- 1 PKSHR_UDMD_F(J) = AMAX1(0.15, PKSHR_UDMD_F(J))PKSHR_UDMD_I(J) = AMAX1(0.15, PKSHR_UDMD_I(J)) IF (PKSHR_UDMD_F(J).LE.0.32) & PKSHR_UDMD_F(J) = PKSHR_UDMD_F( J) * 1.005 IF (PKSHR_UDMD_I(J).LE.0.32) & PKSHR_UDMD_I(J) = PKSHR_UDMD_I(J) * 1.005 ENDDO ENDIF

GO TO 100 ! TEMPORARY UNTIL EMM IS READY TO TEST

IF (MODYR.GT.EHISYR) THEN IF (MODYR.EQ.EHISYR+1) THEN DO J=1,NNGEM

- 1 ! CORE BASN_PKSHR_UF(J) = PKSHR_UDMD_F(J) ANN = oSQGFELGR(J,CURIYR,PKNET) + oSQGFELGR(J,CURIYR,OPNET) IF (ANN .GT. 0.000001) THEN BASE_PKSHR_UF(J) = oSQGFELGR(J,CURIYR,PKNET) / ANN ELSE BASE_PKSHR_UF(J) = 1.1 ! SET > 1 AS A FLAG ENDIF ! NONCORE BASN_PKSHR_UI(J) = PKSHR_UDMD_I(J) ANN = oSQGIELGR(J,CURIYR,PKNET) + oSQGIELGR(J,CURIYR,OPNET) IF (ANN .GT. 0.000001) THEN BASE_PKSHR_U I(J) = oSQGIELGR(J,CURIYR,PKNET) / ANN ELSE BASE_PKSHR_UI(J) = 1.1 ! SET > 1 AS A FLAG ENDIF ENDDO !CCC WRITE(NGUNIT,1100) MODYR,(BASN_PKSHR_UF(J),J=1,NNGEM

- 1) !CCC WRITE(NGUNIT,1101) MODYR,(BASN_ PKSHR_UI(J),J=1,NNGEM

- 1) !CCC WRITE(NGUNIT,1102) MODYR,(BASE_PKSHR_UF(J),J=1,NNGEM

- 1) !CCC WRITE(NGUNIT,1103) MODYR,(BASE_PKSHR_UI(J),J=1,NNGEM

- 1) 1100 FORMAT(1X,I4,' SEMM, BASN_UF ',20F6.4) 1101 FORMAT(1X,I4,' SEMM, BASN_UI ',20F6. 4) 1102 FORMAT(1X,I4,' SEMM, BASE_UF ',20F6.4) 1103 FORMAT(1X,I4,' SEMM, BASE_UI ',20F6.4)

ELSE ! CORE DO J=1,NNGEM

- 1 ANN = oSQGFELGR(J,CURIYR,PKNET) + oSQGFELGR(J,CURIYR,OPNET) IF (ANN .GT. 0.000001) THEN IF (BASE_PKSHR_UF(J) .LE. 1.0) THEN ESHR_F(J) = oSQGFELGR(J,CURIYR,PKNET) / ANN IF (ESHR_F(J).EQ.1.0 .OR. ESHR_F(J).EQ.0.0) WRITE(6,*) & ' ATTN NGTDM

-- PKSHR_UF, REG=',J,' YR=',MODYR, & ' ESHR=',ESHR_F(J) IF (ESHR_F(J) .GE. BASE_PKSHR_UF(J)) THEN PKSHR_UDMD_F(J) = 1.

- (1.

- BASN_PKSHR_UF(J)) * & ( 1.

- ESHR_F(J)) / (1.

- BASE_PKSHR_UF(J)) ELSE PKSHR_UDMD_F(J) = BASN_PKSHR_UF(J) * &ESHR_F(J) / BASE_PKSHR_UF(J)
ENDIF ELSE WRITE(6,*) ' ATTN NGTDM

-- PKSHR_UF, REG=',J,' YR=',MODYR ENDIF ENDIF ! NONCORE ANN = oSQGIELGR(J,CURIYR,PKNET) + oSQGIELGR(J,CURIYR,OPNET) IF (ANN .GT. 0.000001) THEN IF (BASE_PKSHR_UI(J) .LE. 1.0) THEN ESHR_I(J) = oSQGIELGR(J,CURIYR,PKNET) / ANN IF (ESHR_I(J).EQ.1.0 .OR. ESHR_I(J).EQ.0.0) WRITE(6,*) & ' ATTN NGTD M

-- PKSHR_UI, REG=',J,' YR=',MODYR, & ' ESHR=',ESHR_I(J) IF (ESHR_I(J) .GE. BASE_PKSHR_UI(J)) THEN PKSHR_UDMD_I(J) = 1.

- (1.

- BASN_PKSHR_UI(J)) * & (1.

- ESHR_I(J)) / (1.

- BASE_PKS HR_UI(J)) ELSE PKSHR_UDMD_I(J) = BASN_PKSHR_UI(J) * & ESHR_I(J) / BASE_PKSHR_UI(J)
ENDIF ELSE WRITE(6,*) ' ATTN NGTDM

-- PKSHR_UI, REG=',J,' YR=',MODYR ENDIF ENDIF ENDDO !CCC WRITE(NGUNIT,1104) MODYR,(ESHR_F(J),J=1,NNGEM

- 1) !CCC WRITE(NGUNIT,1105) MODYR,(ESHR_I(J),J=1,NNGEM

- 1) !CCC WRITE(NGUNIT,1106) MODYR,(PKSHR_UDMD_F(J),J=1,NNGEM

- 1) !CCC WRITE(NGU NIT,1107) MODYR,(PKSHR_UDMD_I(J),J=1,NNGEM

- 1) 1104 FORMAT(1X,I4,' SEMM, ESHR_F ',20F6.4) 1105 FORMAT(1X,I4,' SEMM, ESHR_I ',20F6.4) 1106 FORMAT(1X,I4,' SEMM, UDMD_F ',20F6.4) 1107 FORMAT(1X,I4,' SEMM, UDMD_I ',20F6.4)

EN DIF ENDIF

100 CONTINUE ! TEMPORARY UNTIL EMM IS READY TO TEST

! SET SEASONAL ELECTRIC UTILITY CONSUMPTION LEVELS

DO J=1,NNGEM

- 1 ! UTILITY SUBREGIONS 1

- 16 BASUQTY_SF(PKNET,J) = PKSHR_UDMD_F(J) * BASUQTY_F(J) BAS UQTY_SF(OPNET,J) = (1.

- PKSHR_UDMD_F(J)) * & BASUQTY_F(J) BASUQTY_SI(PKNET,J) = PKSHR_UDMD_I(J) * BASUQTY_I(J) BASUQTY_SI(OPNET,J) = (1.

- PKSHR_UDMD_I(J)) * & BASUQTY_I(J) ENDDO

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =!

! SET DEBUG MAPPING ARRAY EACH ITERATION ! NGDBGITR ! ! STATUS: ! ! CALLED BY: NGMAIN ! ! = = = = = = = = = = = = = = = = = = = = = = = = = = = = SUBROUTINE NGSET_DBGITR IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngtdminc'

INTEGER*4 I,J,K ! COUNTERS INTEGER*4 SRC ! SOURCE NODE ALONG ARC INT EGER*4 DEST ! NODE ON TREE (DEST NODE)

!

-----------

! SET REPORT FLAGS IN NGDBGITR FOR CURRENT ITERATION ONLY

! NGDBGCNTL OPTIONS : 0

- NO REPORT GENERATED ! 1

- REPORT 1ST ITERATION ONLY ! 2

- REPORT LAST ITERATION ONLY ! 3

- REPORT 1ST AND LAST ITERATION ! 4

- GENERATE ALL REPORTS

! IF (PRTDBGG .EQ. 0) NGWRITE = 0! COMMENTED OUT FOR TRACE RPTS

! THE NEXT TWO IF BLOCKS FIRS T SET ALL NGDBGITR(I,J) TO FALSE ! THEN EACH NGDBGITR IS SET TO TRUE IF CERTAIN CONDITIONS ARE ! MET DO I=1,4 DO J=1,20 NGDBGITR(I,J) = .FALSE. ENDDO ENDDO IF (PRTDBGG .NE. 0) THEN

WRITE(NGUNIT ,*) 'NGTDM: CURIYR=',CURIYR,' CURITR=',CURITR WRITE(NGOPTM,*) 'NGTDM: CURIYR=',CURIYR,' CURITR=',CURITR WRITE(NGOERR,*) 'NGTDM: CURIYR=',CURIYR,' CURITR=',CURITR WRITE(NGODTM,*) 'NGTDM: CURIYR=',CURIYR,' CURITR=',CURITR WRITE(NG OBAL,*) 'NGTDM: CURIYR=',CURIYR,' CURITR=',CURITR

DO I=1,4 ! SET SWITCHES FOR AFM,PTM,CEM,DTM DO J=1,20 IF (NGDBGRPT(I,J)) THEN IF (NGDBGCNTL(I,J).EQ.0) THEN ELSEIF(NGDBGCNTL(I,J).EQ.4) THENNGDBGITR(I,J) = .TRUE. ELSEIF ((NGDBGCNTL(I,J).EQ.5).AND.(CURITR.GE.MAXITR)) & THEN NGDBGITR(I,J) = .TRUE. ELSEIF ((NGDBGCNTL(I,J).EQ.3).AND. & ((CURITR.EQ.1).OR.(FCRL.EQ.1))) THEN NGDBGITR(I,J)= .TRUE. ELSEIF ((NGDBGCNTL(I,J).EQ.2).AND.(FCRL.EQ.1)) THEN NGDBGITR(I,J) = .TRUE. ELSE IF ((NGDBGCNTL(I,J).EQ.1).AND.(CURITR.EQ.1)) THEN NGDBGITR(I,J) = .TRUE. ENDIF ENDIF ENDIF ENDDO ! J=1,20 ENDDO ! I=1,4 ENDIF ! IF (PRTDBGG .NE. 0)

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! ! DTM CODE FORECAST YE AR (NEW ALGORITHM) ! ! STATUS: ! ! CALLED BY: NGTDM ! ! CALLS NGDTM_FORECAST_DTARF ! NGDTM_FORECAST_TRNF ! NGDTM_DTARI ! ! NOTES:

- DISTRIBUTOR TARIFFS FOR FIRM, INTERRUPTIBLE, PEAK, & OFF

- PEAK !

- INCLUDES INTERRUPT CONTRIBUTION TO FIRM REV. REQ. ! ! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

SUBROUTINE NGTDM_DTMFORE IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' i nclude 'ngdtminc'

!

---------------
CALL NGDTM_FORECAST_DTARF ! EXCLUDES TRANS. ! DTMEQU CALL NGDTM_FORECAST_TRNF ! TRANS DTAR_F CALL NGDTM_DTARI ! SET I DIST. TARIFFRETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! ! SETS DTAR FROM T

- 1 TO DTAR_SFPREV, DTAR_SIPREV ! ! STATUS: ! ! CALLED BY: NGTDM_DTM ! ! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

SUBROUTINE NGDTM_SETPREV IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngitminc' include 'ngtdminc' include 'nghistinc'

!

--------------- ! LOCAL VARIABLES !

--------------- INTEGER*4 NET ! NETWORK ID (1= PK, 2=OP) INTEGER*4 J,K ! COUNTER INTEGER*4 NREG ! REGION COUNTER INTEGER*4 NSEC ! SECTOR COUNTER REAL*4 ICNT ! COUNTER !

---------------

DO NREG=1,DNODES DO NSEC=1,DSEC

- 1 ! NONUTILITY DO NET=1,NETWORK DTAR_SFPREV2(NET,NSEC,NREG) = & DTAR_SFPREV(NET,NSEC,NREG) DTAR_SIPREV2(NET,NSEC,NREG) = & DTAR_SIPREV(NET,NSEC,NREG) DTA R_SFPREV(NET,NSEC,NREG) = & DTAR_SF(NET,NSEC,NREG) DTAR_SIPREV(NET,NSEC,NREG) = & DTAR_SI(NET,NSEC,NREG) IF (MODYR .EQ. EHISYR+1) THEN ICNT = 0.0 DTAR_SFPREV(NET,NSEC,NREG) = 0.0 DTAR_SIPREV(NET,NSEC,NREG) = 0.0 IF (NSEC.EQ.3) THEN DO K=EHISYR

- 3,EHISYR ICNT = ICNT + 1. DTAR_SFPREV(NET,NSEC,NREG) = DTAR_SFPR EV(NET,NSEC,NREG) + HDTAR_SF(NET,NSEC,NREG,K)DTAR_SIPREV(NET,NSEC,NREG) = DTAR_SIPREV(NET,NSEC,NREG)

+ HDTAR_SI(NET,NSEC,NREG,K)

ENDDO ELSE DO K=EHISYR,EHISYR ICNT = ICNT + 1. DTAR_SFPREV(NET,NSEC,NREG) = DTAR_SFPREV(NET,NSEC,NREG) + HDTAR_SF(NET,NSEC,NREG,K) DTAR_SIPREV(NET,NSEC,NREG) = DTAR_SIPREV(NET,NSEC,NREG) + HDTAR_SI(NET,NSEC,NREG,K)

ENDDO ENDIF DTAR_SFPREV(NET,NSEC,NREG) = DTAR_SFPREV(NET,NSEC,NREG) / ICNT DTAR_SIPREV(NET,NSEC,NREG) = DTAR_SIPREV(NET,NSEC,NREG) / ICNT

IF (NSEC.EQ.4) THEN

HDTAR_SF(NET,NSEC,NREG,EHISYR) = 0.0 HDTAR_SI(NET,NSEC,NREG,EHISYR) = 0.0 ICNT = 0 DO K=EHISYR

- 5,EHISYR

- 1 ICNT = ICNT + 1 HDTAR_SF(NET,NSEC,NREG,EHISYR) = HDTAR_SF(NET,NSEC,NREG,EHISYR) + HDTAR_SF(NET,NSEC,NRE G,K) HDTAR_SI(NET,NSEC,NREG,EHISYR) = HDTAR_SI(NET,NSEC,NREG,EHISYR) + HDTAR_SI(NET,NSEC,NREG,K)

ENDDO HDTAR_SF(NET,NSEC,NREG,EHISYR) = HDTAR_SF(NET,NSEC,NREG,EHISYR) / ICNT

HDTAR_SI(NET,NSE C,NREG,EHISYR) = HDTAR_SI(NET,NSEC,NREG,EHISYR) / ICNT

ENDIF ENDIF
BASQTY_SFPREV2(NET,NSEC,NREG) = BASQTY_SFPREV(NET,NSEC,NREG) BASQTY_SIPREV2(NET,NSEC,NREG) = BASQTY_SIPREV(NET,NSEC,NREG) BASQ TY_SFPREV(NET,NSEC,NREG) = BASQTY_SF(NET,NSEC,NREG) BASQTY_SIPREV(NET,NSEC,NREG) = BASQTY_SI(NET,NSEC,NREG) ENDDO BASQTY_FPREV(NSEC,NREG) = BASQTY_F(NSEC,NREG) BASQTY_IPREV(NSEC,NREG) = BASQTY_I(NSEC,NREG) ENDDO ENDDO

DO J=1,NNGEM

- 1 ! UTILITY SUBREGIONS 1

- 16 DO NET=1,NETWORK UDTAR_SFPREV(NET,J) = UDTAR_SF(NET,J) UDTAR_SIPREV(NET,J) = UDTAR_SI(NET,J) IF (MODYR .EQ. EHISYR+1) THEN ICNT = 0.0 UDTAR_SFPREV(NET,J) = 0.0 UDTAR_SIPREV(NET,J) = 0.0 DO K=EHISYR,EHISYRICNT = ICNT + 1. UDTAR_SFPREV(NET,J) = UDTAR_SFPREV(NET,J) + HUDTAR_SF(NET,J,K)

UDTAR_SIPREV(NET,J) = UDTAR_SIPREV(NET,J) + HUDTAR_SI(NET,J,K)

ENDDO ! IF (J.EQ.(NNGEM

- 1)) THEN ! K = 2001 ! ICNT = ICNT

- 1. ! UDTAR_SFPREV(NET,J) = UDTAR_SFPREV(NET,J)

- HUDTAR_SF(NET,J,K) ! UDTAR_SIPREV(NET,J) = UDTAR_SIPREV(NET,J)

- HUDTAR_SI(NET,J,K) ! ENDIF

UDTAR_SFPREV(NET,J) = UDTAR_SFPREV(NET,J) / ICNT UDTAR_SIPREV(NET,J) = UDTAR_SIPREV(NET,J) / ICNT
ENDIF BASUQTY_SFPREV( NET,J) = BASUQTY_SF(NET,J) BASUQTY_SIPREV(NET,J) = BASUQTY_SI(NET,J) ENDDO

BASUQTY_FPREV(J) = BASUQTY_F(J) BASUQTY_IPREV(J) = BASUQTY_I(J) ENDDO

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! ! DETERMINE HISTORICAL DISTRIBUTOR TARIFFS ! ! STATUS: ! ! CALLED BY: NGTDM_DTM ! ! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

SUBROUTINE NGDTM_HISDIST IMPLICIT NO NE

include 'parametr' include 'ncntrl' include 'ngparinc' !CCC INCLUDE (NGHISINC) include 'nghistinc' include 'ngitminc' include 'ngtdminc'

!

--------------- ! LOCAL VARIABLES !

--------------- INTEGER*4 NET ! NETWORK ID (1=PK, 2=OP) INTEGER*4 J,K ! COUNTERINTEGER*4 NREG ! REGION COUNTER INTEGER*4 NSEC ! SECTOR COUNTER REAL*4 ATAR(NETWORK,DNODES) ! AVER AGE IND TAR (OVER F&I) !

---------------

DO NET=1,NETWORK DO NREG=1,DNODES ! NONUTILITY NSEC=1 DTAR_SF(NET,NSEC,NREG) = & HPGFRSGR(NET,NREG,MODYR)

- HCGPR(NET,NREG,MODYR) DTAR_SI(NET,NSEC,NREG) = & HPGIRSGR(NET,NREG,MODYR)

- HCGPR(NET,NREG,MODYR) NSEC=2 DTAR_SF(NET,NSEC,NREG) = & HPGFCMGR(NET,NREG,MODYR)

- HCGPR(NET,NREG,MODYR) DTAR_SI(NET,NSEC,NREG) = & HPGICMGR(NET,NREG,MODYR)

- HCGPR(NET,NREG,MODYR) NSEC=3 DTAR_SF(NET,NSEC,NREG) = & HPGFINGR(NET,NREG,MODYR)

- HCGPR(NET,NREG,MODYR) DTAR_SI(NET,NSEC,NREG) = & HPGIINGR(NET,NREG,MODY R)

- HCGPR(NET,NREG,MODYR) NSEC=4 DTAR_SF(NET,NSEC,NREG) = & HPGFTRGR(NET,NREG,MODYR)

- HCGPR(NET,NREG,MODYR) DTAR_SI(NET,NSEC,NREG) = & HPGITRGR(NET,NREG,MODYR)

- HCGPR(NET,NREG,MODYR)

DTAR_TRFV_SF(NET,NREG) = DTAR_SF(NET,NSEC,NREG) DTAR_TRPV_SF(NET,NREG) = DTAR_SF(NET,NSEC,NREG)

DO NSEC=1,DSEC

- 1 ! PUT INFO INTO HIST VAR HDTAR_SF(NET,NSEC,NREG,MODYR) = DTAR_SF(NET,NSEC,NREG) HDTAR_SI(NET,NSEC,NREG,MODYR) = DTAR_SI(NET,NSEC,NREG) ENDDO

NSEC=3 ATAR(NET,NREG) = ((DTAR_SF(NET,NSEC,NREG)*BASQTY_SF(NET,NSEC,NREG)) + (DTAR_SI(NET,NSEC,NREG)*BASQTY_SI(NET,NSEC,NREG))) / & (BASQTY_SF(NET,NSEC,NREG) + BASQTY_SI(NET,NSEC,NREG)) ENDDO WRITE(NGODTM,10) MODYR,NET,(ATAR(NET,NREG),NREG=1,DNODES) 10 FORMAT(' DTARIND ',I5,I2,1X,<DNODES>F7.3)

DO J=1,NNGEM

- 1 ! UTILITY SUBREGION S 1

- 16 NREG = EMMSUB_NG(J) UDTAR_SF(NET,J) = & HPGFELGR(NET,J,MODYR)

- HCGPR(NET,NREG,MODYR) UDTAR_SI(NET,J) = & HPGIELGR(NET,J,MODYR)

- HCGPR(NET,NREG,MODYR) HUDTAR_SF(NET,J,MODYR) = UDTAR_SF(NET,J) HUDTAR_SI(NET,J,MODYR) = UDTAR_SI(NET,J) ENDDOENDDO

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! ! WRITE HISTORICAL DISTRIBUTOR TARIFFS ! ! STATUS: ! ! CALLED BY: NGTDM_DTM ! ! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

SUBROUTINE NGDTM_HISOUT IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'nghistinc' include 'ngitminc' include 'ngtdminc'

!

--------------- ! LOCAL VARIABLES !

--------------- INTEGER*4 NET ! NETWORK ID (1=PK, 2=OP) INTEGER*4 J ! COUNTER INTEGER*4 NREG ! REGION CO UNTER INTEGER*4 NSEC ! SECTOR COUNTER INTEGER*4 YR ! YEAR COUNTER

CHARACTER*15 HEAD15 !

---------------

10 FORMAT(1X,A15,<IJUMPYR>(6X,I4)) 120 FORMAT(2X,"SEC NET NODE ") 130 FORMAT(2X,I2,2X,I2,2X,I2,4X,<IJUMPYR>F10.3) 140 FORMAT(2X,I2,2X,I2,7X,<IJUMPYR>F10.3)

!

------ HEAD15="<HDTAR_SF> " WRITE(NGOHIST,10) HEAD15, (YR,YR=FHISYR,LHISYR) WRITE(NGOHIST,120)

DO NSEC=1,DSEC

- 1 DO NET=1,NETWORK DO NREG=1,DNODES WRITE(NGOHIST,130) NSEC,NET,NREG,(HDTAR_SF(NET,NSEC,NREG,YR),
& YR=FHISYR,LHISYR)ENDDO WRITE(NGOHIST,*) ENDDO ENDDO

HEAD15 ="<HDTAR_SI> " WRITE(NGOHIST,10) HEAD15, (YR,YR=FHISYR,LHISYR) WRITE(NGOHIST,120)

DO NSEC=1,DSEC

- 1 DO NET=1,NETWORK DO NREG=1,DNODES WRITE(NGOHIST,130) NSEC,NET,NREG,(HDTAR_SI(NET,NSEC,NREG,YR),
& YR=FHISYR,LHISYR)

ENDDO WRITE(NGOHIST,*) ENDDO ENDDO
HEAD15="<HUDTAR_SF> " WRITE(NGOHIST,10) HEAD15, (YR,YR=FHISYR,LHISYR) WRITE(NGOHIST,120)

DO NET=1,NETWORK DO NREG=1,NNGEM

- 1 WRITE(NGOHIST,140) NET,NREG,(HUDTAR_SF(NET,NREG,YR), & YR=FHISYR,LHISYR) ENDDO WRITE(NGOHIST,*) ENDDO
HEAD15="<HUDTAR_SI> " WRITE(NGOHIST,10) HEAD15, (YR ,YR=FHISYR,LHISYR) WRITE(NGOHIST,120)

DO NET=1,NETWORK DO NREG=1,NNGEM

- 1 WRITE(NGOHIST,140) NET,NREG,(HUDTAR_SI(NET,NREG,YR), & YR=FHISYR,LHISYR) ENDDO WRITE(NGOHIST,*) ENDDO

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! ! DETERMINE INTERRUPTIBLE DISTRIBUTOR TARIFFS ! ! STATUS: ! ! CALLED BY: NGTDM_DTM!

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

SUBROUTINE NGDTM_DTARI IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'nghistinc' include 'ngitminc'

!

--------------- ! LOCAL VARIABLES !

--------------- INTEGER*4 NET ! NETWORK ID (1=PK, 2=OP) INTEGER*4 J ! COUNTER INTEGER*4 NREG ! REGION COUNTER INTEGER*4 NSEC ! SECTOR COUNTER !

---------------

DO NET=1,NETWORK DO NREG=1,DNODES DO NSEC=1,DSEC

- 1 ! NONUTILITY IF (NSEC .NE. 3) THEN ! RES,COMM,TRAN DTAR_SI(NET,NSEC,NREG) = DTAR_SF(NET,NSEC,NREG) ! ELSE ! INDUSTRIAL ! DTAR_SI(NET ,NSEC,NREG) = HDTAR_SI(NET,NSEC,NREG,EHISYR)

ENDIF ENDDO ENDDO ! ! WHEN "HISTORICAL" EU TARIFF IS UNREASONABLY LOW (PROBABLY DUE TO SPECIAL ! CIRCUMSTANCES), GRADUALLY INCREASE THE TARIFF TO A REASONABLE MIN ! VALUE THROUGH ENDYR ! !??? IF (UTILID_FLG .EQ. 1) THEN !??? NSEC = 5 !??? IF (HDTAR_SI(NET,NSEC,NREG,EHISYR) .LT. 0.05) THEN !??? DTAR_SI(NET,NSEC,NREG) = HDTAR_SI(NET,NSEC,NREG,EHISYR)+ !??? 1 ( (0.05

- HDTAR_SI(NET,NSEC,NREG,EHISYR )) / !??? 2 REAL(ENDYR

- EHISYR) ) * REAL(MODYR

- EHISYR) !??? ENDIF !??? ENDIF

! INTERUPTIBLE ADJUSTMENTS HANDLED IN FIRM ADJUSTMENT AREA

!CC DO J=1,NNGEM

- 1 ! UTILITY SUBREGIONS 1

- 16 !CC UDTAR_SI(NET,J) = HUDTAR_SI(NET,J,EHISYR) !CC ENDDO ENDDO

RETURNEND

! = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! ! SUBROUTINE TO FORECAST FIRM DIST. TARIFFS ! ! STATUS: ! ! CALLED BY: NGTDM_DTM ! ! NOTES: ! ! = = = = = = = = = = = = = = = = = = = = = = = = = = = =
SUBROUTINE NGDTM_FORECAST_DTARF IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ogglobal' include 'nghistinc' include 'ngitminc' inclu de 'ngdtminc' include 'ngtdminc' include 'ngsteoinc' include 'ngakinc'

!

--------------- ! LOCAL VARIABLES

INTEGER*4 NET ! NETWORK ID (1=PK, 2=OP) INTEGER*4 I,J,K ! COUNTER INTEGER*4 NREG ! REGION COUNTER INTEGER*4 NSEC ! SECTOR COUNTER INTEGER*4 NGT ! NGTDM REGION INTEGER*4 MAP ! INDEX FOR EMM/NGTDM MAPPING

REAL*4 CHQTY ! % CHNG IN QTY FOR SEC REAL*4 COST ! COST INDICATOR FOR RESIDENTIAL TARIFF REAL*4 COSTLAG ! LAGGED VALUE OF COST REAL*4 HDYWHT ! HANDY

- WHITMAN CONSTRUCTION COST INDEX FOR GAS P LANTS (1996=100) REAL*4 GASCUST(DNODES) ! NUMBER OF RESIDENTIAL GAS CUSTOMERS REAL*4 QRS_PER(DNODES) ! CONSUMPTION PER RESIDENTIAL GAS CUSTOMER REAL*4 QRS_PERLAG(DNODES) ! LAST YR'S QRS_PER REAL*4 QCUR(NETWO RK) ! IND CONS (F+I) IN CURRENT YEAR, BY PK & OP REAL*4 QLAG(NETWORK) ! IND CONS (F+I) LAST YEAR, ANNUALREAL*4 QLAG2(NETWORK) ! IND CONS (F+I) THREE YEARS AGO,

ANNUAL REAL*4 TARLAG(NETWORK) ! IND DISTRIBUTOR TARIFF (AVG F&I) LAST YEAR, FOR PK & OP REAL*4 TARLAG2(NETWORK) ! IND DISTRIBUTOR TARIFF (AVG F&I) THREE YEARS AGO, FOR PK & OP REAL*4 TAR ! IND DISTRIBUTOR TARIFF (AVG F&I) CURRENT YEAR, ANNUAL RE AL*4 PKADJ ! HOLDING VARIABLE FOR PEAK TERMS IN RESIDENTIAL TARIFF EQUATION REAL*4 EL_RS_CAP(NNGEM

- 1) ! CAPACITY FOR ELEC GEN TO CONSUME RESID REAL*4 EL_RS_CAPLAG(NNGEM

- 1) ! LAGGED VALUE FOR EL_RS_CAP REAL*4 OTHR(DNODES) ! NONELEC NG DELIVERIES REAL*4 OTHRLAG(DNODES) ! NONELEC NG DELIVERIES LAST YEAR REAL*4 HDD(NETWORK,NNGEM

- 1) ! HEATING DEGREE DAYS REAL*4 HDDLAG(NETWORK,NNGEM

- 1) ! HEATING DEGREE DAYS LA ST YEAR REAL*4 SHARE(DNODES) ! SHARES FOR CONVERTING 9 CD REG FLOORSPACE TO 12 NGTDM REGIONS REAL*4 FLRSPC(MNUMCR

- 2) ! FLOORSPACE BY 9 CENSUS REGIONS REAL*4 FLRSPCPREV(MNUMCR

- 2) ! FLOORSPACE FROM PREVIOUS YEAR BY 9 CENSUS REGIONS REAL*4 FLRSPC12(DNODES) ! FLOORSPACE BY 12 NGTDM REGIONS REAL*4 FLRSPC12PREV(DNODES) ! FLOORSPACE FROM PREVIOUS YEAR BY 12 NGTDM REGIONS REAL*4 NUMRSPK,NUMRSPKLAG ! TEMP HOLD VALUES

REAL*4 BETA_V1 (NNGEM

- 1) ! REGIONAL COEFFICIENTS FOR ELEC MARKUP EQS PEAK PER, VERSION 1 REAL*4 BETA_V2(NNGEM

- 1) ! REGIONAL COEFFICIENTS FOR ELEC MARKUP EQS OFFPK PER, VERISION 2 REAL*4 BETA_V3(NNGEM

- 1) ! REGIONAL COEFFICIENTS FOR ELEC MARKUP EQS COMBINED, VERSION 3 REAL*4 BETA_V4(NNGEM

- 1) ! REGIONAL COEFFICIENTS FOR ELEC MARKUP EQS PEAK PER, VERSION 4 REAL*4 BETA_V5(NNGEM

- 1) ! REGIONAL COEFFICIENTS FOR ELEC MARKUP EQS OFFPK PER, VERISION 5 REAL*4 BETA_ V6(NNGEM

- 1) ! REGIONAL COEFFICIENTS FOR ELEC MARKUP EQS COMBINED, VERSION 6 REAL*4 BETA_V7(NNGEM

- 1) ! REGIONAL COEFFICIENTS FOR ELEC MARKUP EQS PEAK PER, VERSION 7 REAL*4 BETA_V8(NNGEM

- 1) ! REGIONAL COEFFICIENTS FOR ELEC MARKUP EQS OFFPK PER, VERISION 8 REAL*4 BETA_V9(NNGEM

- 1) ! REGIONAL COEFFICIENTS FOR ELEC MARKUP EQS COMBINED, VERSION 9

REAL*4 PIDNODES1(DNODES),PIDNODESPK1(DNODES,NETWORK),PIDNODES2(DNODES),PIDNODESP K2(DNODES,NETWORK), &

PIDNODES3(DNODES),PIDNODESPK3(DNODES,NETWORK),PIDNODES4(DNODES),PIDNODESP K4(DNODES,NETWORK)REAL*4

PINREG1(DNODES),PINREGPK1(DNODES,NETWORK),PINREG2(DNODES),PINREGPK2(DNODE S,NETWORK), &

PINREG3(DNODES),PINREGPK3(DNODES,NETWORK),PINREG 4(DNODES),PINREGPK4(DNODE S,NETWORK), &

PINREG10(DNODES),PINREGPK10(DNODES,NETWORK),PINREG11(DNODES),PINREGPK11(D NODES,NETWORK), &

PINREG12(DNODES),PINREGPK12(DNODES,NETWORK),PINREG13(DNODES),PINREGPK13(D NODES,NETWORK), &

PINREG14(DNODES),PINREGPK14(DNODES,NETWORK),PINREG15(DNODES),PINREGPK15(D NODES,NETWORK), &

PINREG16(DNODES),PINREGPK16(DNODES,NETWORK) REAL*4 PCMREG1(DNODES),PCMREGPK1(DNODES,NETWORK),PCMREG2(DNODES), PCMREG10(DNODES), &

PCMREGPK10(DNODES,NETWORK),PCMREG11(DNODES),PCMREGPK11(DNODES,NETWORK), &

PCMREG12(DNODES),PCMREGPK12(DNODES,NETWORK),PCMREG13(DNODES),PCMREGPK13(D NODES,NETWORK) REAL*4 PRSREG1(DNODES),PRSREG2(DNODES),PRSREGPK2(DNODES,NETWORK), &

PRSREG3(DNODES),PRSREGPK3(DNODES,NETWORK),PRSREG4(DNODES),PRSREGPK4(DNODE S,NETWORK), &

PRSREG10(DNODES),PRSREGPK10(DNODES,NETWORK),PRSREG11(DNODES),PRSREGPK11(D NODES,NETWORK), &

PRSREG12(DNODES),PRSREGPK12(DNODES,N ETWORK), PRSREG13(DNODES),PRSREGPK13(DNODES,NETWORK), &

PRSREG14(DNODES),PRSREGPK14(DNODES,NETWORK),PRSREG15(DNODES),PRSREGPK15(D NODES,NETWORK), &

PRSREG16(DNODES),PRSREGPK16(DNODES,NETWORK),PRSREG17(DNODES),PRSREGPK17(D NODES,NETW ORK), &

PRSREG18(DNODES),PRSREGPK18(DNODES,NETWORK),PRSREG19(DNODES),PRSREGPK19(D NODES,NETWORK) REAL*4 PELREG1(NNGEM

- 1),PELREG2(NNGEM

- 1),PELREG3(NNGEM

1),PELREG4(NNGEM

- 1),PELREG5(NNGEM

- 1), &

PELREG6(NNGEM

- 1),PELREG20(NNGEM

- 1),PELREG21(NNGEM

1),PELREG22(NNGEM

- 1),PELREG23(NNGEM

- 1), &

PELREG24(NNGEM

- 1),PELREG25(NNGEM

- 1),PELREG26(NNGEM

1),PELREG27(NNGEM

- 1),PELREG28(NNGEM

- 1), &

PELREG29(NNGEM

- 1),PELREG30(NNGEM

- 1),PELREG31(NNGEM

1),PELREG32(NNGEM

- 1),PELREG33(NNGEM

- 1),PELREG34(NNGEM

- 1)

LOGICAL FIRST /.TRUE./ LOGICAL ONCE /.TRUE./DATA SHARE

/1.00,1.00,1.00,1.00,0.66,1.00,1.00,0.59,0.24,0.34,0.41,0.75/

! RATIO = ELEC/NONELEC

DATA BETA_V1 /

- 1.34226,

- 0.921071,

- 0.881376,

- 2.12084,

- 1.25052,

- 0.752780,0.0000,

- 1.21938, &

- 0.647285,

- 0.974289,

- 0.813633,0.0000,

- 0.906389,

- 0.460844,

- 0.776803,0.0000/ DATA BETA_V2 /

- 1.56664,

- 0.918916,

- 0.525 536,

- 1.53066,

- 1.05638,

- 0.935291,

- 0.785985,

- 0.937241, &

- 0.705233,

- 0.924732,

- 0.582494,0.0000,

- 0.609463,

- 0.486087,

- 0.491374,0.0000/ DATA BETA_V3 /

- 1.71347,

- 1.13636,

- 0.922744,

- 0.207802,

- 1.40664,

- 0.976328,

- 0.623446,

- 0.934725, &

- 0.825823,

- 1.02681,

- 0.726892,0.0000,

- 1.01488,

- 0.539097,

- 0.867936,0.0000/ ! RATIO = ELEC
DATA BETA_V4 /

- 1.28806,

- 0.979515,

- 0.819119,

- 2.13120,

- 1.21061,

- 0.676188,0.0000,

- 0.617860, &

- 0.555317,

- 0.879790,

- 1.36119,0.0000,

- 0.853451,

- 0.259074,

- 0.666118,0.0000/ DATA BETA_V5 /

- 1.16624,

- 0.697767,0.0000,

- 1.20339,

- 0.681518,

- 0.568878,

- 0.396906,

- 0.324781, &

- 0.308801,

- 0.565523,

- 1.10357,0.0000,0.0000,0.0000,0.0000,0.0000/ DATA BETA_V6 /

- 1.65566,

- 1.152 02,

- 0.897591,

- 2.07809,

- 1.38845,

- 0.940195,

- 0.575482,

- 0.588389, &

- 0.786230,

- 0.975018,

- 0.950354,0.0000,

- 0.983431,

- 0.396577,

- 0.814522,0.0000/

! RATIO = ELEC/TOTAL
DATA BETA_V7 /

- 1.38787,

- 0.923729,

- 0.819404,

- 2.08152,

- 1.20874,

- 0.6952 92,0.0000,

- 1.24241, &

- 0.572490,

- 0.941692,

- 0.891595,0.0000,

- 0.909328,

- 0.524280,

- 0.783290,0.0000/ DATA BETA_V8 /

- 1.58163,

- 0.903272,

- 0.370202,

- 1.41175,

- 0.948817,

- 0.835571,

- 0.647748,

- 0.915467, &

- 0.556283,

- 0.87436 5,

- 0.620275,0.0000,

- 0.565492,

- 0.532905,

- 0.446128,0.0000/ DATA BETA_V9 /

- 1.73961,

- 1.12716,

- 0.824678,

- 2.01202,

- 1.34498,

- 0.891688,

- 0.500186,

- 0.918691, &

- 0.711819,

- 0.963417,

- 0.743110,0.0000,

- 0.998724,

- 0.556525,

- 0.846856,0.0000/

DATA PINREG1/0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/
DATA ((PINREGPK1(I,J),I=1,DNODES),J=1,NETWORK)/0.778030,0.474943,0.0,0.0,0.0,0 .0,

- 0.351311,0.0,0.0,0.0,0.0,0.0, &

0.0,0.0,0.0,0.0,0.0,0. 0,0.0,0.0,0.0,0.0,0.0,0.0/DATA PINREG2/

- 37.5470,

- 37.4677,

- 37.0067,

- 37.9532,

- 37.8694,

- 37.7483,

-

36.7309,

- 37.5331,

- 37.4052,

- 37.3143,

- 37.1575,

- 36.8498/
DATA ((PINREGPK2(I,J),I=1,DNODES),J=1,NETWORK)/1.24067,0.624370,0.0,0.413260,0 .412388,0.196128,

- 0.867092,0.0,0.0,0.0,0.0,0.0, &

0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/

DATA PINREG3/0.500296,0.447637,0.716739,0.0,0.0,0.320975,0.0,0.497641,0.633953 ,0.769202,0.920892,1.00437/
DATA ((PINREGPK3(I,J),I=1,DNODES),J=1,NETWORK)/1.26088,0.701011,0.0,0.463488,0 .541012,0.0,0.0,0.0,0.0,0.0,0.0,0.0, &

0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/

DATA PINREG4/

- 19.3546,

- 19.2 819,

- 18.8420,

- 19.7656,

- 19.6809,

- 19.5533,

- 18.6368,

- 19.3402,

- 19.2126,

- 19.1122,

- 18.9626,

- 18.6743/
DATA ((PINREGPK4(I,J),I=1,DNODES),J=1,NETWORK)/1.2448,0.632116,0.0,0.419443,0. 423262,0.203922,

- 0.808245,0.0,0.0,0.0,0.0,0.0, &

0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/

DATA PINREG10/0.0,0.0,0.240744,0.0,0.0,0.0,0.0,0.0,0.235949,0.379695,0.460239, 0.559692/
DATA ((PINREGPK10(I,J),I=1,DNODES),J=1,NETWORK)/0.0,0.609774,0.0,0.0,0.291471, 0.0,0.0 ,0.0,0.0,0.0,0.0,0.0, &

0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/

DATA PINREG11/0.0,0.0,0.239711,0.0,0.0,0.0,0.0,0.0,0.232161,0.335802,0.426246, 0.527077/
DATA ((PINREGPK11(I,J),I=1,DNODE S),J=1,NETWORK)/0.0,0.613560,0.0,0.0,0.300840, 0.0,0.0,0.0,0.0,0.0,0.0,0.0, &

0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/

DATA PINREG12/0.0,0.0,0.204883,0.0,0. 0,0.0,0.0,0.0,0.325879,0.403724,0.596436, 0.802269/
DATA ((PINREGPK12(I,J),I=1,DNODES),J=1,NETWORK)/0.0,0.612658,0.0,0.0,0.329322, 0.0,0.0,0.0,0.0,0.0,0.0,0.0, &

0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 ,0.0,0.0/DATA

PINREG13/0.0,0.0,0.184401,0.0,0.0,0.0,0.0,0.0,0.294703,0.0,0.530435,0.741 636/
DATA ((PINREGPK13(I,J),I=1,DNODES),J=1,NETWORK)/0.0,0.565514,0.0,0.0,0.276685, 0.0,0.0,0.0,0.0,0.0,0.0,0.0, &

0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/

DATA PINREG14/0.0,0.0,0.203182,0.0,0.0,0.0,0.0,0.0,0.326413,0.0,0.597030,0.801 976/
DATA ((PINREGPK14(I,J),I=1,DNODES),J=1,NETWORK)/0.0,0.611241,0.0,0.0,0.330115, 0.0,0.0,0.0,0.0,0.0,0.0,0 .0, &

0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/

DATA PINREG15/0.664368,0.0,0.0,

- 0.565428,0.0,

- 0.248102,0.0,0.0,0.0,0.0,0.395943,0.605914/
DATA ((PINREGPK15(I,J),I=1,DNODES) ,J=1,NETWORK)/0.0,0.418090,0.0,0.354066,0.0, 0.203711,

- 0.411782,0.0,0.263996,0.0,0.0,0.0, &

0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/

DATA PINREG16/0.0,0.0,0.0,

- 0.352047,0.0,0.0,0.0,0.0,0.0,0 .0,0.0,0.639336/
DATA ((PINREGPK16(I,J),I=1,DNODES),J=1,NETWORK)/0.0,0.0,0.0,0.0,0.0,0.0,0.0,0. 0,0.0,0.0,0.0,0.0, &

0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/

DATA PCMREG1/

- 29.1058,

- 28. 6198,

- 28.7396,

- 29.2867,

- 28.6876,

- 28.9823,

- 28.9907,

- 29.3766,

- 29.1245,

- 29.0861,

- 29.2976,

- 28.4892/
DATA ((PCMREGPK1(I,J),I=1,DNODES),J=1,NETWORK)/0.522577,0.351341,0.0,0.223029, 0.0,0.0,

- 0.135934,0.0,0.0,0.0,0.0,0.0, &

0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/

DATA PCMREG2/1.40853,1.52326,1.09411,0.859596,1.33202,1.18675,0.943641,0.75373 4,1.16287,1.30842,1.03857,1.54720/

DATA PCMREG10/

- 10.2416,

- 10.4087,

- 10.7437,

- 10.6493,

- 10.5632,

- 10.251 7,

- 10.7456,

- 10.3196,

- 10.0886,

- 10.3329,

- 9.89589,

- 10.2479/
DATA ((PCMREGPK1(I,J),I=1,DNODES),J=1,NETWORK)/0.536963,0.342376,0.0,0.246201, 0.119203,0.0,

- 0.151000,0.0,0.0,

- .238201,0.0,0.0, &

0.0,0.0,0.0,0 .0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/DATA PCMREG11/0.0,

- 0.326308,

- 0.610797,

- 0.481121,

- 0.307471,0.0,

-

0.589616,

- 0.198443,0.181097,0.0,0.340494,0.0/
DATA ((PCMREGPK11(I,J),I=1,DNODES),J=1,NETWORK)/0.521381,0.331471,0.0,0.168313 ,0.094251,0.0,0.0,0.0, 0.0,0.0,0.0,0.0, &

0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/

DATA PCMREG12/0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/ DATA ((PCMREGPK12(I,J),I=1,DNODES),J=1,NETWORK)/

- 9.206441,

- 9. 538810,

- 10.18695,

- 9.881515,

- 9.924059,

- 9.729576,

- 10.38056,

- 9.808747,

- 9.538406,

- 10.23105,

- 9.608446,

- 9.743229, &

- 9.720599,

- 9.875480,

- 10.16163,

- 10.11913,

- 10.03923,

- 9.780027,

- 10.20153,

- 9.771664,

- 9.601109,

- 9. 976541,

- 9.462631,

- 9.775257/

DATA PCMREG13/0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/ DATA ((PCMREGPK13(I,J),I=1,DNODES),J=1,NETWORK)/

- 4.498378,

- 4.852790,

- 5.471895,

- 5.266668,

- 5.054427,

- 4.975067,

- 5.517942,

- 5.253175,

- 4.795673,

- 5.051970,

- 4.899 262,

- 4.817270, &

- 13.87098,

- 14.12193,

- 14.49560,

- 14.29389,

- 14.37939,

- 13.98336,

- 14.50539,

- 13.81237,

- 13.71773,

- 14.29647,

- 13.50724,

- 14.05762/

DATA PRSREG1/

- 7.01587,

- 7.2898 0,

- 7.82791,

- 7.76602,

- 7.43430,

- 7.63823,

- 7.81227,

- 7.85452,

- 7.32764,

- 7.20998,

- 7.45169,

- 7.82967/

DATA PRSREG2/

- 5.42553,

- 5.36095,

- 5.85875,

- 5.91231,

- 5.57122,

- 5.85199,

- 5.83342,

- 6.07015,

- 5.64672,

- 5.48893,

- 5.76728,

- 5.89443/
DATA ((PRSREGPK2(I,J),I=1,DNOD ES),J=1,NETWORK)/0.288223,0.0,0.0,0.0,0.0,0.0,

- 0.233427,0.0,0.0,

- 0.266180,0.0,0.0, &

0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/

DATA PRSREG3/

- 12.3856,

- 12.3246,

- 12.8268,

- 12.8782,

- 12.5316,

- 12.80 81,

- 12.7830,

- 13.0346,

- 12.6091,

- 12.4263,

- 12.7189,

- 12.8488/
DATA ((PRSREGPK3(I,J),I=1,DNODES),J=1,NETWORK)/0.279017,0.0,0.0,0.0,0.0,0.0,

- 0.245880,0.0,0.0,

- 0.269254,0.0,0.0, &

0.0,0.0,0.0,0.0,0.0,0.0,0. 0,0.0,0.0,0.0,0.0,0.0/

DATA PRSREG4/

- 12.0191,

- 11.9660,

- 12.4283,

- 12.5193,

- 12.2127,

- 12.4957,

- 12.4688,

- 12.6239,

- 12.2955,

- 12.1718,

- 12.3754,

- 12.5244/
DATA ((PRSREGPK4(I,J),I=1,DNODES),J=1,NETWORK)/2.93027,2.66903,2.54665,2.64305 ,2.74943,2.74925,2.510 90,2.60165,2.76000,2.70869,2.69835,2.80511, &

0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/

DATA PRSREG10/

- 8.75895,

- 9.19767,

- 9.1976512,

- 9.58600,

- 9.21750,

- 9.42139,

- 9.68360,

- 9.64927,

- 9.00265,

- 8.861 42,

- 9.15670,

- 9.75403/DATA

((PRSREGPK10(I,J),I=1,DNODES),J=1,NETWORK)/0.0,0.0,0.0,0.0,0.0,0.0,0.0,0. 0,0.0,0.0,0.0,0.0, &

0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/

DATA PRSREG11/

- 8.32882 , - 8.68625,

- 8.97709,

- 8.82556,

- 8.66002,

- 8.33244,

- 8.94163,

- 8.53044,

- 8.14259,

- 8.32153,

- 7.97423,

- 8.36613/
DATA ((PRSREGPK11(I,J),I=1,DNODES),J=1,NETWORK)/0.515589,0.330374,0.0,0.164734 ,0.092573,0.0,0.0,0.0,0.0,0.0,0.0,0.0, &

0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/

DATA PRSREG12/

- 15.6575,

- 15.6173,

- 16.1196,

- 16.1454,

- 15.7505,

- 16.0857,

- 16.0741,

- 16.3189,

- 15.8617,

- 15.7269,

- 15.9966,

- 16.1518/
DATA ((PRSREGPK12(I,J),I=1,DNOD ES),J=1,NETWORK)/0.278294,0.0,0.0,0.0,0.0,0.0,

- 0.246500,0.0,0.0,

- 0.268050,0.0,0.0, &

0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/

DATA PRSREG13/

- 13.8676,

- 13.8335,

- 14.2801,

- 14.3720,

- 14.0390,

- 14. 3847,

- 14.3693,

- 14.4878,

- 14.1318,

- 14.1151,

- 14.2723,

- 14.4167/
DATA ((PRSREGPK13(I,J),I=1,DNODES),J=1,NETWORK)/3.03640,2.77537,2.65287,2.7692 6,2.88417,2.89798,2.63317,2.70209,2.86557,2.80954,2.82785,2.88262, &

0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/

DATA PRSREG14/

- 5.87975,

- 5.83948,

- 6.31284,

- 6.35259,

- 5.96901,

- 6.30601,

- 6.31104,

- 6.53819,

- 6.08373,

- 5.98841,

- 6.22784,

- 6.38441/
DATA ((PRSREGPK14(I,J),I=1,DNODES),J=1,NETWORK)/0.293990, 0.0,0.0,0.0,0.0,0.0,

- 0.223868,0.0,0.0,

- 0.259818,0.0,0.0, &

0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/

DATA PRSREG15/

- 13.2055,

- 13.1715,

- 13.6521,

- 13.6883,

- 13.2963,

- 13.6261,

- 13.6201,

- 13.868 9,

- 13.4125,

- 13.2794,

- 13.5408,

- 13.7010/
DATA ((PRSREGPK15(I,J),I=1,DNODES),J=1,NETWORK)/0.280037,0.0,0.0,0.0,0.0,0.0,

- 0.243325,0.0,0.0,

- 0.264072,0.0,0.0, &

0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0 ,0.0/

DATA PRSREG16/

- 11.7014,

- 11.6774,

- 12.0900,

- 12.1992,

- 11.8754,

- 12.2191,

- 12.2089,

- 12.3267,

- 11.9833,

- 11.9668,

- 12.1072,

- 12.2536/
DATA ((PRSREGPK16(I,J),I=1,DNODES),J=1,NETWORK)/3.21677,2.96175,2.81802,2.9428 0,3.06893,3.08703,2.82347,2.88348 ,3.06790,3.01147,3.01151,3.06145, &

0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/DATA PRSREG17/

- 7.70536,

- 8.03988,

- 8.55826,

- 8.46423,

- 8.09356,

-

8.33532,

- 8.54553,

- 8.57433,

- 7.99406,

- 7.90373,

- 8.13562,

- 8.58648/
DATA ((PRSREGPK17(I,J),I=1,DNODES),J=1,NETWORK)/0.0,0.0,0.0,0.0,0.0,0.0,0.0,0. 0,0.0,0.0,0.0,0.0, &

0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/

DATA PRSREG18/0. 0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/ DATA ((PRSREGPK18(I,J),I=1,DNODES),J=1,NETWORK)/

- 9.094757,

- 9.637560,

- 10.22515,

- 10.04009,

- 9.684263,

- 9.851383,

- 10.30541,

- 10.16442,

- 9.450454,

- 9.557417,

- 9.717208,

- 10.27530, &

- 9.406873,

- 9.710192,

- 10.22259,

- 10.09187,

- 9.781738,

- 9.962248,

- 10.10204,

- 10.12417,

- 9.565610,

- 9.297769,

- 9.658055,

- 10.28111/

DATA PRSREG19/0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/ DATA ((PRSREGPK19(I,J),I=1,DNODES),J=1,NE TWORK)/

- 6.947036,

- 7.422527,

- 8.021596,

- 7.864109,

- 7.473760,

- 7.664540,

- 8.052452,

- 7.987073,

- 7.308704,

- 7.283411,

- 7.523595,

- 7.954022, &

- 11.06556,

- 11.46569,

- 11.99084,

- 11.81121,

- 11.52214,

- 11.67063,

- 11.86662,

- 11 .80703,

- 11.19628,

- 10.93813,

- 11.32604,

- 12.06455/

DATA PELREG1/

- 1.47976,

- 0.945990,0.0,

- 1.36176,

- 0.886694,

- 0.534793,

- 0.344435,0.0, &

- 0.365065,

- 0.527724,

- 1.08364,0.0,

- 0.518477,0.0,

- 0.450492,0.0/
DATA PELREG2/

- 1.16989,

- 0.682294,0.0,

- 1.07422,

- 0.613316,

- 0.459005,

- 0.358621,0.0, &

- 0.289168,

- 0.543961,

- 0.944722,0.0,0.0,0.0,0.0,0.0/ DATA PELREG3/

- 1.55497,

- 1.12092,

- 0.908213,

- 2.31795,

- 1.38150,

- 0.612982,0.0,0.0, &

- 0.5342 68,

- 0.675546,

- 1.11489,0.0,

- 0.949028,0.0,

- 0.673534,0.0/ DATA PELREG4/

- 0.478020,0.0,0.0,

- 1.21003,

- 0.260395,0.0,0.0,0.0,0.0,

- 0.494172, &

- 0.785832,0.0,0.0,0.0,0.0,0.0/ DATA PELREG20/

- 1.13927,

- 0.678608,0.0,

- 1.02598,

- 0.569745,

- 0.3030 88,

- 0.244710, & ! original 0.0,

- 0.277428,

- 0.521992,

- 1.05019,0.0,0.0,0.0,0.0,0.0/ ! DATA PELREG20/

- 0.984684,

- 0.526917,0.0,

- 0.910382,

- 0.486451,

- 0.218335,

- 0.082058, & ! 1 stdv change ! 0.0,

- 0.139312,

- 0.404725 , - 0.812558,0.0,0.0,0.0,0.0,0.0/ ! DATA PELREG20/

- 1.061977,

- 0.602763,0.0,

- 0.968181,

- 0.528098,

- 0.260712,

- 0.163384, & ! 1/2 stdv ! 0.0,

- 0.208370,

- 0.463359,

- 0.931374,0.0,0.0,0.0,0.0,0.0/ DATA PELREG21/

- 1.39476,

- 0.930313,

- 0.647914,

- 2.05578,

- 1.10582,

- 0.362019,0.0,0.0, & ! original

- 0.457861,

- 0.643791,

- 0.991951,0.0,

- 0.815034,0.0,

- 0.553508,0.0/ ! DATA PELREG21/

- 1.134419,

- .713491,

- .431097,

- 1.818857,

- .875619,

- .219242,0.0,0.0, & ! 1 stdv change!

- .280617,

- .459388,

- .7178,0.0,

- .57916,0.0,

- .387301,0.0/

! DATA PELREG21/

- 1.264590,

- 0.821902,

- 0.540732,

- 1.937319,

- 0.990720,

- 0.290631,0.0,0.0, & ! 1/2 stdv !

- 0.369239,

- 0.551590,

- 0.854876,0.0,

- 0.697097,0.0,

- 0.470405,0.0 / ! DATA PELREG22/

- 0.575241,0.0,0.0,

- 1.21503,

- 0.261856,0.0,0.0,0.0,0.0,

- 0.500024, & ! original !

- 0.719617,0.0,0.0,0.0,0.0,0.0/ DATA PELREG22/

- .399727,0.0,0.0,

- 1.089887,

- .162256,0.0,0.0,0.0,0.0,

- .315763, & ! 1 stdv ch ange

- .456736,0.0,0.0,0.0,0.0,0.0/ ! DATA PELREG23/

- 0.473307,0.0,

- 0.422184,

- 0.970675,

- 0.210231,0.0,0.0,0.0, & ! original ! 0.0,

- 0.415691,

- 0.790706,0.0,0.0,0.0,0.0,0.0/ ! DATA PELREG23/

- 0.294253,0.0,

- 0. 311188,

- 0.826378,

- 0.111375,0.0,0.0,0.0, & ! +1 stdv ! 0.0,

- 0.216153,

- 0.552969,0.0,0.0,0.0,0.0,0.0/ DATA PELREG23/

- 0.652361,0.0,

- 0.53318,

- 1.114972,

- 0.309087,0.0,0.0,0.0, & !

- 1 stdv 0 .0,

- 0.615229,

- 1.028443,0.0,0.0,0.0,0.0,0.0/ ! DATA PELREG24/

- 0.380650,0.0,0.0,

- 0.880636,0.0,0.0,0.0,0.0,0.0,0.0, & ! original !

- 0.856325,0.0,0.0,0.0,0.0,0.0/ DATA PELREG24/

- 0.192097,0.0,0.0,

- 0.73102,0.0,0.0,0.0,0.0,0.0,0.0, & ! +1 stdv

- 0.603726,0.0,0.0,0.0,0.0,0.0/ ! DATA PELREG24/

- 0.569203,0.0,0.0,

- 1.030252,0.0,0.0,0.0,0.0,0.0,0.0, & !

- 1 stdv !

- 1.108924,0 .0,0.0,0.0,0.0,0.0/ ! DATA PELREG25/

- 0.496555,0.0,

- 0.352125,

- 0.872404,0.0,0.0,0.0, & ! original !

- 0.667624,0.0,

- 0.459666,

- 0.375593,0.0,0.0,0.0,0.0,0.0/ ! DATA PELREG25/

- 0.322315,0.0,

- 0.243934,

- 0.727997 ,0.0,0.0,0.0, & ! +1 stdv !

- 0.473274,0.0,

- 0.266021,

- 0.290568,0.0,0.0,0.0,0.0,0.0/ DATA PELREG25/

- 0.670795,0.0,

- 0.460316,

- 1.016811,0.0,0.0,0.0, & !

- l stdv

- 0 .861974,0.0,

- 0.653311,

- 0.460618,0.0,0.0,0.0,0.0,0.0/ ! DATA PELREG26/0.0,0.0,

- 0.289116,

- 0.796965,0.0,0.0,0.0,0.0, & ! original ! 0.0,

- 0.444817,

- 0.818877,0.0,0.0,0.0,0.0,0.0/ ! DATA PELREG26/0.0 ,0.0,

- 0.17759,

- 0.643987,0.0,0.0,0.0,0.0, & ! +1 stdv ! 0.0,

- 0.247668,

- 0.585407,0.0,0.0,0.0,0.0,0.0/ DATA PELREG26/0.0,0.0,

- 0.400642,

- 0.949943,0.0,0.0,0.0,0.0, & !

- 1 stdv 0.0,

- 0.641966,

- 1.052347,0.0,0.0,0.0,0.0,0.0/ ! DATA PELREG27/

- 0.857095,

- 0.413313,

- 0.750346,

- 1.26167,

- 0.531814,

- 0.348526,0.0,

- 0.928190, & ! original !

- 0.377732,

- 0.816085,

- 0.716664,0.0,

- 0.466736,

- 0.308948,

- 0.507144,0.0/ ! DATA PELREG27/

- 0.645666,

- 0.240119,

- 0.581747,

- 1.070025,

- 0.37077,

- 0.178029,0.0,

- 0.680899, & ! +1 stdv!

- 0.19106,

- 0.588975,

- 0.566326,0.0,

- 0.267861,

- 0.154199,

-

0.32584,0.0/
DATA PELR EG27/

- 1.068524,

- 0.586507,

- 0.918945,

- 1.453315,

- 0.692858,

- 0.519023,0.0,

- 1.175481, & !

- 1 stdv

- 0.564404,

- 1.043195,

- 0.867002,0.0,

- 0.665611,

- 0.463697,

- 0.688448,0.0/ DATA PELREG28/

- 0.941005,

- 0.582763,

- 0.543393,

- 0.455724,

- 0 .392527,

- 0.354943,0.0, & ! original 0.0,0.0,

- 0.488386,0.0,0.0,0.0,0.0,0.0,0.0/ DATA PELREG29/

- 0.898562,

- 0.523346,0.0,0.0,

- 0.302769,

- 0.275330,0.0,0.0,0.0, &

- 0.441434,0.0,0.0,0.0,0.0,0.0,0.0/
DATA PELREG30/

- 1.13568,

- 0.992880,

- 0.743193,

- 0.768670,

- 0.599603,

- 0.458295,0.0,0.0, & 0.0,

- 0.470313,

- 1.30053,0.0,0.0,0.0,0.0,0.0/ DATA PELREG31/

- 0.569051,0.0,0.0,

- 0.993607,0.0,0.0,0.0,0.0, &

! 2010 Version 1 Peak 0.0,

- 0.453206,

- 0.553142,0.0,0.0,0.0,0.0,0.0/ DATA PELREG32/

- 1.377838,

- 0.836857,0.0,

- 0.966333,

- 0.553732,

- 0.549285,

- 0.495265,0.0, & ! 2010 Version 1 off

- peak

- 0.349100,

- 0.625117,

- 1.148493,0.0,0.0,0.0,0.0,0.0/ DATA PELREG33/

- 0.573823,0.0,0.0,

- 0.983473,0.0,0.0,0.0,0.0, &

! 2010 Version 2 peak 0.0,

- 0.457204,

- 0.824368,0.0,0.0,0.0,0.0,0.0/ DATA PELREG34/

- 1.345278,

- 0.611693,0.0,

- 0.899242,

- 0.547988,

- 0.526282,

- 0.502548,0.0, & ! 2010 Vers ion 2 off

- peak

- 0.369785,

- 0.578870,

- 0.239587,0.0,0.0,0.0,0.0,0.0/

! 1 2 3 4 5 6 7 8 ! cents ch off pt 17 16 14 03 04 1 5 ! DATA PELREG5/

- 1.33589,

- 0.684010,0.0,

- 1.19540,

- 0.890821,

- 0.717860,

- 0.677710,

- 0.586044,& !

- 0.466799,

- 0.695745,

- 0.236143,0.0,

- 0.344618,

- 0.271268,

- 0.465912,0.0/ ! 9 10 11 12 13 14 1 5 16 ! cents ch off pt 15 14 11 03 15 13 02

! 1 2 3 4 5 6 7 8 9 10 DATA PELREG6/

- 0.324641,0.0,0.0,

- 1.00779,

- 0.211810,0.0,0.0,

- 0.508708,0.0,

- 0.27806 2,&

- 0.085703,0.99538,0.0,0.0,0.0,0.595994/ ! 11 12 13 14 15 16

! point estimates DATA PELREG5/

- 1.50589,

- 0.844010,0.0,

- 1.33540,

- 0.920821,

- 0.757860,

- 0.677710,

- 0.736044,&

- 0.616799,

- 0 .835745,

- 0.456143,0.0,

- 0.494618,

- 0.401268,

- 0.485912,0.0/! DATA PELREG6/

- 0.454641,0.0,0.0,

- 1.14779,

- 0.241810,0.0,0.0,

-

0.658708,0.0,

- 0.458062,& !

- 0.265703,1.02538,0.0,0.0,0.0,0.595994/

!

---------------

NSEC = 1

! CALCULATE COST TERMS FOR RES & COM TARIFF OR NUMBER OF CUSTOMERS FOR RES TARIFF

IF (FIRST) THEN FIRST = .FALSE. ! HDYWHT = HW_ADJ * EXP(HW_BETA0) * (oMC_WPI055(CURIYR

1)**HW_BETA1) * (HDYWHTLAG**HW_RHO) * & ! EXP(

- HW_RHO* HW_BETA0) * (oMC_WPI055(CURIYR

2)**(

- HW_RHO*HW_BETA1))

HDYWHT = HW_ADJ * EXP(HW_BETA0) * (oMC_WPI(CURIYR

- 1)**HW_BETA1) * (HDYWHTLAG**HW_RHO) * & EXP(

- HW_RHO*HW_BETA0) * (oMC_WPI(CURIYR

- 2)**(

- HW_RHO*HW_BETA1)) ! EM4 TRACK

- - not used

COSTLAG = 0.7 * (((oMC_RLRMPUAANS(CURIYR

1)/100.)+0.25)*HDYWHT*oMC_PCWGDP(7)/oMC_PCWGDP(CURIYR

- 1)) + & 0.3 * (oMC_ECIWSP(CURIYR

1)*oMC_PCWGDP(7)/oMC_PCWGDP(CURIYR

- 1))

HDYWHTLAG = HDYWHT

IF (MODYR.GE.oR ECSYEAR) THEN DO I=1,MNUMCR

- 3 GASCUST(I) = oRSGASCUST(oRECSYEAR,I) ENDDO GASCUST(9) = oRSGASCUST(oRECSYEAR,9)

- (AK_RN(oRECSYEAR)

- HI_RN(oRECSYEAR))*1000.

DO NREG=1,DNODES RECS_ALIGN(NREG) = NUMRS(NREG,oRECSYEAR) / (GASCUST(NG_CENMAP(NREG))*NUM_REGSHR(NREG))

ENDDO ENDIF

IF (MODYR.GE.oRECSYEAR+1) THEN ! only an issue if ehisyr, lhisyr not "normal"

DO I=1,MNUMCR

- 3 GASCUST(I) = oRSGASCUST(MODYR

- 1,I) ENDDO GASCUST(9) = oRSGASCUST(MODYR

- 1,9)

- (AK_RN(MODYR

- 1)

- HI_RN(MODYR

- 1))*1000.

DO NREG=1,DNODES NUMRS(NREG,MODYR

- 1) = GASCUST(NG_CENMAP(NREG)) * RECS_ALIGN(NREG) * NUM_REGSHR(NREG)

ENDDO ELSE WRITE(6,*) ' ATTN NG: UNABLE TO SET LAGS FOR RES TAR'ENDIF DO NREG=1,DNODES QRS_PERLAG(NREG) = (1000.*(BASQTY_SFPREV(1,NSEC,NREG)+BASQTY_SFPREV(2,NSEC,NREG))) / NUMRS(NREG, MODYR

- 1)

ENDDO ELSEIF (CURITR.EQ.1) THEN COSTLAG = COST HDYWHTLAG = HDYWHT DO NREG=1,DNODES QRS_PERLAG(NREG) = QRS_PER(NREG) ENDDO ENDIF
! HDYWHT = HW_ADJ * EXP(HW_BETA0) * (oMC_WPI055(CURI YR)**HW_BETA1) * (HDYWHTLAG**HW_RHO) * & ! EXP(

- HW_RHO*HW_BETA0) * (oMC_WPI055(CURIYR

1)**(

- HW_RHO*HW_BETA1)) HDYWHT = HW_ADJ * EXP(HW_BETA0) * (oMC_WPI(CURIYR)**HW_BETA1) * (HDYWHTLAG**HW_RHO) * & E XP(

- HW_RHO*HW_BETA0) * (oMC_WPI(CURIYR

- 1)**(

- HW_RHO*HW_BETA1)) ! EM4 TRACK

-- not used

COST = 0.7 * (((oMC_RLRMPUAANS(CURIYR)/100.)+0.25)*HDYWHT*oMC_PCWGDP(7)/oMC_PCWGDP(CUR IYR)) + & 0.3 * (oMC_ECIWSP(CURIYR)*oMC_PCWGDP(7)/oMC_PCWGDP(CU RIYR))

!

-------------
IF (MODYR.GE.oRECSYEAR) THEN ! only an issue if ehisyr, lhisyr not "normal"

DO I=1,MNUMCR

- 3 GASCUST(I) = oRSGASCUST(MODYR,I) ENDDO GASCUST(9) = oRSGASCUST(MODYR,9)

- (AK_RN(MODYR)

- HI_RN(MODYR))*1000.

DO NREG=1,DNODES NUMRS(NREG,MODYR) = GASCUST(NG_CENMAP(NREG)) * RECS_ALIGN(NREG) * NUM_REGSHR(NREG)

ENDDO ELSE WRITE(6,*) ' ATTN NG: UNABLE TO SET NUM CUST FOR RES TAR' ENDIF DO NREG=1 ,DNODES QRS_PER(NREG) = (1000.*(BASQTY_SF(1,NSEC,NREG)+BASQTY_SF(2,NSEC,NREG))) / NUMRS(NREG,MODYR) ENDDO

IF (CURITR.EQ.1.AND.MODYR.EQ.LHISYR+1) WRITE(NGOHIST,500) (NUMRS(NREG,LHISYR),NREG=1,DNODES) 500 FORMAT(1X,' <NUMRS LHISYR> ' ,<DNODES>F10.0)! SET NONUTILITY DISTRIBUTOR TARIFFS

DO NREG=1,DNODES DO NSEC=1,3 IF (NSEC.EQ.3) THEN QLAG = 0. DO NET=1,NETWORK QCUR(NET) = BASQTY_SF(NET,NSEC,NREG) + BASQTY_SI(NET,NSEC,NREG)

QLAG(NET) = BASQTY_SFPREV(NET,NSEC,NREG) + BASQTY_SIPREV(NET,NSEC,NREG)

QLAG2(NET) = BASQTY_SFPREV2(NET,NSEC,NREG) + BASQTY_SIPREV2(NET,NSEC,NREG)

TARLAG(NET) = ( (BASQTY_SFPREV(NET,NSEC,NREG)*DTAR_SFPREV(NET,NSEC,NREG)) + &
(BASQTY_SIPREV(NET,NSEC,NREG)*DTAR_SIPREV(NET,NSEC,NREG)) ) / & (BASQTY_SFPREV(NET,NSEC,NREG) + BASQTY_SIPREV(NET,NS EC,NREG))

TARLAG2(NET) = ( (BASQTY_SFPREV2(NET,NSEC,NREG)*DTAR_SFPREV2(NET,NSEC,NREG)) + &
(BASQTY_SIPREV2(NET,NSEC,NREG)*DTAR_SIPREV2(NET,NSEC,NREG)) ) / & (BASQTY_SFPREV2(NET,NSEC,NR EG) + BASQTY_SIPREV2(NET,NSEC,NREG))

ENDDO ENDIF DO NET=1,NETWORK !!!! IF (DTAR_SFPREV(NET,NSEC,NREG).GT.0.0) THEN

IF (NSEC.EQ.3) THEN

! industrial

IF (OPTIND.EQ.5) THEN TAR = IN_CNST + IN_ALP(NREG) + IN_PKALP(NREG,NET) + & (IN_LNQ * QCUR(NET)) + (IN_RHO * TARLAG(NET)) &

- (IN_RHO * ( IN_CNST + IN_ALP(NREG) + IN_PKALP(NREG,NET) + (IN_LNQ * QLAG(NET)) ) )

ELSEIF (OP TIND.EQ.6) THEN TAR = IN_CNST + IN_ALP(NREG) + IN_PKALP(NREG,NET) + & (IN_LNQ * QCUR(NET)) + (IN_DIST * oPDSIN(NG_CENMAP(NREG),CURIYR

- 1)) + (IN_RHO * TARLAG(NET)) &

- (IN_RHO * ( IN_CNST + IN_ALP(NR EG) + IN_PKALP(NREG,NET) + & (IN_DIST * oPDSIN(NG_CENMAP(NREG),CURIYR

2)) +(IN_LNQ * QLAG(NET)) ) )

ELSEIF (OPTIND.EQ.1) THEN TAR = 0.096182 + PINREG1(NREG) + PINREGPK1(NREG,NET) +
&

- 0.000251581*QCUR(NET) + 0.490900*TARLAG(NET)

- 0.490900*(0.096182 + PINREG1(NREG) + & PINREGPK1(NREG,NET)

- 0.000251581*QLAG(NET) ) ELSEIF (OPTIND.EQ.10) THENTAR =

- 0.033226 + PINREG10(NREG) + PINREGPK10(NREG,NET)

&

- 0.000313404*QCUR(NET) + 0.400115*TARLAG(NET) &

- 0.400115* (

- .033226 + PINREG10(NREG) + PINREGPK10(NREG,NET) &

- 0.00 0313404*QLAG(NET) )

ELSEIF (OPTIND.EQ.11) THEN TAR =

- 0.084758 + PINREG11(NREG) + PINREGPK11(NREG,NET)
&

- 0.000318284*QCUR(NET) + .041282*oPDSIN(NG_CENMAP(NREG),CURIYR

- 1) + .387088*TARLAG(NET) &

- .387088*(

- .084758 + PINREG11(NREG) + PINREGPK11(NREG,NET) &

- .000318284*QLAG(NET) + .041282*oPDSIN(NG_CENMAP(NREG),CURIYR

- 1) )

ELSEIF (OPTIND.EQ.12) THEN TAR = PINREG12(NRE G) + PINREGPK12(NREG,NET) &

- 0.000299699*QCUR(NET) + .498176*TARLAG(NET) &

- .498176*(PINREG12(NREG) + PINREGPK12(NREG,NET)
&

- .000299699*QLAG(NET) )

ELSEIF (OPTIND.EQ.13) THEN TAR = PINREG13(NREG) + PINREGPK13(NREG,NET) &

- 0.000360357*QCUR(NET) + .034688*oPDSIN(NG_CENMAP(NREG),CURIYR

- 1) + .494573*TARLAG(NET) &

- .494573*(PINREG13(NREG) + PINRE GPK13(NREG,NET)
&

- 0.000360357*QLAG(NET) + .034688*oPDSIN(NG_CENMAP(NREG),CURIYR

- 1) )

ELSEIF (OPTIND.EQ.14) THEN TAR = PINREG14(NREG) + PINREGPK14(NREG,NET) &

- 0.000294853* QCUR(NET) + .523668*TARLAG(NET) &

- .523668*(PINREG14(NREG) + PINREGPK14(NREG,NET)
&

- .000294853*QLAG(NET) )

ELSEIF (OPTIND.EQ.15) THEN TAR = 0.199135 + PINREG15(NREG) + PIN REGPK15(NREG,NET)
&

- 0.000317443*QCUR(NET) + 0.423561*TARLAG(NET) &

- 0.423561*(0.199135 + PINREG15(NREG) + PINREGPK15(NREG,NET) &

- 0.000317443*QLAG(NET) )

ELSEIF (OPTIND.EQ.16) THEN ! 2010 TAR = 0.202961 + PINREG16(NREG) &

- 0.000383*QCUR(NET) & + 0.475508*TARLAG(NET)

- 0.475508*(0.202961 + PINREG16(NREG)

- 0.000383*QLAG(NET)) & + 0.271802*TARLAG2(NET)

- 0.271802*(0.202961 + PINREG16(NREG)

- 0.000383*QLAG2(NET))

ENDIF

DTAR_SF(NET,NSEC,NREG) = TAR + FDIFF(MAP_NRG_CRG(NREG)) !!!!!!!!! DTAR_SF(NET,NSEC,N REG) = TAR + (DTAR_SFPREV(NET,NSEC,NREG)

- TARLAG(NET))DTAR_SI(NET,NSEC,NREG) = ((TAR*QCUR(NET))

-

(DTAR_SF(NET,NSEC,NREG)*BASQTY_SF(NET,NSEC,NREG))) & / BASQTY_SI(NET,NSEC,NREG)

! COMMERCIAL ELSEIF(NSEC.E Q.2) THEN

FLRSPC(1) = OMC_COMMFLSP(1,12,CURIYR)/1.2 FLRSPCPREV(1) = OMC_COMMFLSP(1,12,CURIYR

- 1)/1.2 FLRSPC(2) = OMC_COMMFLSP(2,12,CURIYR)/1.4 FLRSPCPREV(2) = OMC_COMMFLSP(2,12,CURIYR

- 1)/1.4 FLRSPC(3) = OMC_COMMFLSP(3,12,CURIYR)/1.25 FLRSPCPREV(3) = OMC_COMMFLSP(3,12,CURIYR

- 1)/1.25 FLRSPC(4) = OMC_COMMFLSP(4,12,CURIYR)/1.3 FLRSPCPREV(4) = OMC_COMMFLSP(4,12,CURIYR

- 1)/1.3 FLRSPC(5) = OMC_COMMFLSP(5,12,CURIYR)/1.2 FLRSPCPREV(5) = OMC_COMMFLSP(5,12,CURIYR

- 1)/1.2 FLRSPC(6) = OMC_COMMFLSP(6,12,CURIYR)/1.05 FLRSPCPREV(6) = OMC_COMMFLSP(6,12,CURIYR

- 1)/1.05 FLRSPC (7) = OMC_COMMFLSP(7,12,CURIYR)/1.3 FLRSPCPREV(7) = OMC_COMMFLSP(7,12,CURIYR

- 1)/1.3 FLRSPC(8) = OMC_COMMFLSP(8,12,CURIYR)/1.05 FLRSPCPREV(8) = OMC_COMMFLSP(8,12,CURIYR

- 1)/1.05 FLRSPC(9) = OMC_COMMFLSP(9,12,CURIYR)*1.05 FLRSPCPREV(9) = OMC_COMMFLSP(9,12,CURIYR

- 1)*1.05 DO I = 1,DNODES FLRSPC12(i) = FLRSPC(NG_CENMAP(I)) * SHARE(I) FLRSPC12PREV(i) = FLRSPCPREV(NG_CENMAP(I)) * SHARE(I) ENDDO

IF (OPTCOM.EQ.3) THEN DTAR_SF(NET,NSEC,NREG) = EXP(CM_ALP(NREG)+CM_PKALP(NREG,NET)) * & ((1000.*BASQTY_SF(NET,NSEC,NREG))**C M_LNQ) * & (DTAR_SFPREV(NET,NSEC,NREG)**CM_RHO) * & EXP(

- CM_RHO*(CM_ALP(NREG)+CM_PKALP(NREG,NET))) * & ((1000.*BASQTY_SFPREV(1,NSEC,NREG))**(

- CM_RHO*CM_LNQ)) ELSEIF (OPTCOM.EQ.4) THEN DTAR_SF(NET,NSEC,NREG) = CM_ADJ * EXP(CM_ALP(NREG)+CM_PKALP(NREG,NET)) * &
((1000.*(BASQTY_SF(1,NSEC,NREG)+BASQTY_SF(2,NSEC,NREG)))**CM_LNQ) * &
((DTAR_SFPREV(NET,NSEC,NREG)*oMC_PCWGDP(7)/oMC_P CWGDP(

- 2))**CM_RHO) * & EXP(

- CM_RHO*(CM_ALP(NREG)+CM_PKALP(NREG,NET))) * &

((1000.*(BASQTY_SFPREV(1,NSEC,NREG)+BASQTY_SFPREV(2,NSEC,NREG)))**(

- CM_RHO*CM_LNQ)) * & oMC_PCWGDP(

- 2)/oMC_PCWGDP(7)

ELSEIF (OPTCOM.EQ.1) THEN DTAR_SF(NET,NSEC,NREG) = EXP(PCMREG1(NREG) + PCMREGPK1(NREG,NET)) * &((BASQTY_SF(NET,NSEC,NREG)+BASQTY_SI(NET,NSEC,NREG))**(

- 0.334438*1.05)) *

& EXP((0.015522* 1.000)*FLOAT(MODYR)) * (DTAR_SFPREV(NET,NSEC,NREG)**0.224301) * & EXP(

- 0.224301*(PCMREG1(NREG)+PCMREGPK1(NREG,NET))) *
&
(BASQTY_SFPREV(NET,NSEC,NREG)+BASQTY_SIPREV(NET,NSEC,NREG))**(

- 0.224301*(

- 0.334438*1.05)) * & EXP(

- 0.224301*(0.015522*1.000)*(FLOAT(MODYR)

- 1.)) ELSEIF (OPTCOM.EQ.2) THEN DTAR_SF(NET,NSEC,NREG) = EXP(PCMREG2(NREG)) * &

((BASQTY_SF(NET,NSEC,NREG)+BASQTY_ SI(NET,NSEC,NREG))**

- 0.131423) * & (DTAR_SFPREV(NET,NSEC,NREG)**0.362777) * EXP(

- 0.362777*PCMREG2(NREG)) * &

(BASQTY_SFPREV(NET,NSEC,NREG)+BASQTY_SIPREV(NET,NSEC,NREG))**(

- 0.362777*

- 0.131423) ELSEIF ( OPTCOM.EQ.10) THEN DTAR_SF(NET,NSEC,NREG) = EXP(PCMREG10(NREG) + PCMREGPK10(NREG,NET)) * &

((BASQTY_SF(NET,NSEC,NREG)+BASQTY_SI(NET,NSEC,NREG))**(

- .458089) * & FLRSPC12(NREG)**(.854883) * (DTAR_SFPR EV(NET,NSEC,NREG)**0.232281) * & EXP(

- 0.232281*(PCMREG10(NREG)+PCMREGPK10(NREG,NET))) * &

(BASQTY_SFPREV(NET,NSEC,NREG)+BASQTY_SIPREV(NET,NSEC,NREG))**(

- 0.232281*(

- .458089)) * & FLRSPC12(NREG)**(

- .232281*.85483) ) ELSEIF (OPTCOM.EQ.11) THEN DTAR_SF(NET,NSEC,NREG) = EXP(

- 8.09180 + PCMREG11(NREG) + PCMREGPK11(NREG,NET)) * &

((BASQTY_SF(NET,NSEC,NREG)+BASQTY_SI(NET,NSEC,NREG))**(

- .255252) * & FLRSPC12(NREG)**(.654472) * (DTAR_SFPREV(NET,NSEC,NREG)**0.262602) * & EXP(

- 0.262602*(

- 8.09180 + PCMREG11(NREG)+PCMREGPK11(NREG,NET))) * &

(BASQTY_SFPREV(NET,NSEC,NREG)+BASQTY_SIPREV(NET,NSEC,NREG))**(

- 0.262602*(

- .255252)) * & FLRSPC12(NREG)**(

- .262602*.654472) ) ELSEIF (OPTCOM.EQ.12) THEN !2010 Version 1: DTAR_SF(NET,NSEC,NREG) = (((BASQTY_SF(NET,NSEC,NREG)+BASQTY_SI(NET,NSEC,NREG))/(FLRSPC12(NREG)))** (

- 0.486971)) * & ((FLRSPC12(NREG))**0.343227)* &

(EXP(PCMREG12(NREG) + PCMREGPK12(NREG,NET)))* & (DTAR_SFPREV(NET,NSEC,NREG)**0.246096)* &(((BASQTY_SFPREV(NET,NSEC,NREG)+BASQTY_SIPREV(NET,NSEC,NREG))/FLRSPC12PRE

V(NREG))**(0.246096*0.486971)) * &

((FLRSPC12PREV(NREG))**(

- 0.246096*0.343227)) * & (EXP(

- 0.246096*(PCMREG12(NREG) + PCMREGPK12(NREG,NET))))

ELSEIF (OPTCOM.EQ.13) THEN !2010 Version 2: IF (NET.EQ.1) THEN ! peak DTAR_SF(NET,NS EC,NREG) = (((BASQTY_SF(NET,NSEC,NREG)+BASQTY_SI(NET,NSEC,NREG))/(FLRSPC12(NREG)))** (

- 0.217322)) * & ((FLRSPC12(NREG))**0.218189)* & (EXP(PCMREG13(NREG) + PCMREGPK13(NREG,NET)))* & (DTAR_S FPREV(NET,NSEC,NREG)**0.284608)* &
(((BASQTY_SFPREV(NET,NSEC,NREG)+BASQTY_SIPREV(NET,NSEC,NREG))/FLRSPC12PRE V(NREG))**(0.284608*0.217322)) * & ((FLRSPC12PREV(NREG))**(

- 0.284608*0.218189)) * & (EXP(

- 0.284608*(PC MREG13(NREG) + PCMREGPK13(NREG,NET)))) ELSE !off

- peak DTAR_SF(NET,NSEC,NREG) = (((BASQTY_SF(NET,NSEC,NREG)+BASQTY_SI(NET,NSEC,NREG))/(FLRSPC12(NREG)))** (

- 0.613588)) * & ((FLRSPC12(NREG))**0.530831)* & (EXP(PCM REG13(NREG) + PCMREGPK13(NREG,NET)))* & (DTAR_SFPREV(NET,NSEC,NREG)**0.166956)* &
(((BASQTY_SFPREV(NET,NSEC,NREG)+BASQTY_SIPREV(NET,NSEC,NREG))/FLRSPC12PRE V(NREG))**(0.166956*0.613588)) * & ((FLRSPC12PREV (NREG))**(

- 0.166956*0.530831)) * & (EXP(

- 0.166956*(PCMREG13(NREG) + PCMREGPK13(NREG,NET)))) ENDIF ENDIF

! RESIDENTIAL

ELSE ! NSEC.EQ.1

IF (OPTRES.EQ.5) THEN DTAR_SF(NET,NSEC,NREG) = RS_ADJ * EXP(RS_ALP(NREG)+RS_PKALP(NREG,NET)) * &
((1000.*(BASQTY_SF(1,NSEC,NREG)+BASQTY_SF(2,NSEC,NREG)))**RS_LNQ) * (COST**RS_COST) * &
((DTAR_SFPREV(NET,NSEC,NREG)*oMC_PCWGDP(7)/oMC_PCWGD P(

- 2))**RS_RHO) * & EXP(

- RS_RHO*(RS_ALP(NREG)+RS_PKALP(NREG,NET))) * &
((1000.*(BASQTY_SFPREV(1,NSEC,NREG)+BASQTY_SFPREV(2,NSEC,NREG)))**(

- RS_RHO*RS_LNQ)) * & (COSTLAG**(

- RS_RHO*RS_COST)) * oMC_P CWGDP(

- 2)/oMC_PCWGDP(7) ELSEIF (OPTRES.EQ.6) THENDTAR_SF(NET,NSEC,NREG) = RS_ADJ *

EXP(RS_ALP(NREG)+RS_PKALP(NREG,NET)) * & (QRS_PER(NREG)**RS_LNQ) * &

( (DTAR_SFPREV(NET,NSEC,NREG)*oMC_PCWGDP(7)/oMC_PCWGDP(

- 2))**RS_RHO) * & EXP(

- RS_RHO*(RS_ALP(NREG)+RS_PKALP(NREG,NET))) * & ((QRS_PERLAG(NREG))**(

- RS_RHO*RS_LNQ)) * & oMC_PCWGDP(

- 2)/oMC_PCWGDP(7) ELSEIF (OPTRES.EQ.7) THEN DTAR_SF(NET,NSEC,NREG) = RS_ADJ * EXP(RS_ALP(NREG)+RS_PKALP(NREG,NET)) * &
((1000.*(BASQTY_SF(1,NSEC,NREG)+BASQTY_SF(2,NSEC,NREG)))**RS_LNQ) * (NUMRS(NREG,MODYR)**RS_COST) * &
((DTAR_SFPREV(NET,NSEC,NREG)*oMC_PCWGDP(7)/oMC_PCWGDP(

- 2))**RS_RHO) * & EXP(

- RS_RHO*(RS_ALP(NREG)+RS_PKALP(NREG,NET))) * &
((1000.*(BASQTY_SFPREV(1,NSEC,NREG)+BASQTY_SFPREV(2,NSEC,NREG))) **(

- RS_RHO*RS_LNQ)) * & (NUMRS(NREG,MODYR

- 1)**(

- RS_RHO*RS_COST)) * oMC_PCWGDP(

- 2)/oMC_PCWGDP(7)

ELSEIF (OPTRES.EQ.8) THEN DTAR_SF(NET,NSEC,NREG) = EXP(RS_ALP(NREG)+RS_PKALP(NREG,NET)) * & ((1000.*BASQTY_SF(NET,NSEC,NREG))**RS_LNQ) * (NUMRS(NREG,MODYR)**RS_COST) * & (DTAR_SFPREV(NET,NSEC,NREG)**RS_RHO) * & EXP(

- RS_RHO*(RS_ALP(NREG)+RS_PKALP(NREG,NET))) * & ((1000.*BASQTY_SFPR EV(NET,NSEC,NREG))**(

- RS_RHO*RS_LNQ)) * & (NUMRS(NREG,MODYR

- 1)**(

- RS_RHO*RS_COST))

ELSEIF (OPTRES.EQ.9) THEN DTAR_SF(NET,NSEC,NREG) = EXP(RS_ALP(NREG)+RS_PKALP(NREG,NET)) * &

((1000. *BASQTY_SF(NET,NSEC,NREG)/NUMRS(NREG,MODYR))**RS_LNQ) * & (DTAR_SFPREV(NET,NSEC,NREG)**RS_RHO) * & EXP(

- RS_RHO*(RS_ALP(NREG)+RS_PKALP(NREG,NET))) * &
((1000.*BASQTY_SFPREV(NET,NSEC,NREG)/NUMRS(NR EG,MODYR

- 1))**(

- RS_RHO*RS_LNQ))

! ELSEIF (OPTRES.EQ.10) THEN ! IF (NET.EQ.1) THEN ! PKADJ = ((1000.*BASQTY_SF(NET,NSEC,NREG)/NUMRS(NREG,MODYR))**RS_COST) * &

! EXP(MODYR*RS_PARM) * & ! ((1000.*BASQTY_SFPREV(NET,NSEC,NREG)/NUMRS(NREG,MODYR

- 1))**(

- RS_RHO*RS_COST)) * &

! EXP(

- RS_RHO*FLOAT(MODYR

- 1)*RS_PARM) ! ELSE ! PKADJ = 1.0 ! ENDIFDTAR_SF(NET,NSEC,NREG) =

EXP(RS_ALP(NREG)+RS_PKALP(NREG,NET)) * &
((1000.*BASQTY_SF(NET,NSEC,NREG)/NUMRS(NREG,MODYR))**RS_LNQ) * & EXP(FLOAT(MODYR)*RS_ADJ) * & (DTAR_SFPREV(NET,NSEC,NREG )**RS_RHO) * & EXP(

- RS_RHO*(RS_ALP(NREG)+RS_PKALP(NREG,NET))) * &
((1000.*BASQTY_SFPREV(NET,NSEC,NREG)/NUMRS(NREG,MODYR

- 1))**(

- RS_RHO*RS_LNQ)) * & EXP(

- RS_RHO*(FLOAT(MODYR

- 1))*RS_ADJ) * PKADJ

ELSEIF (OPTRES.EQ.1) THEN DTAR_SF(NET,NSEC,NREG) = EXP(PRSREG1(NREG)) * &

((BASQTY_SF(NET,NSEC,NREG)+BASQTY_SI(NET,NSEC,NREG))**

- 0.661192) * & (NUMRS(NREG,MODYR)**0.782355) * (DTAR_SFPRE V(NET,NSEC,NREG)**0.373164) * & EXP(

- 0.373164*PRSREG1(NREG)) * &

((BASQTY_SFPREV(NET,NSEC,NREG)+BASQTY_SIPREV(NET,NSEC,NREG))**(

- 0.373164*

- 0.661192)) * & (NUMRS(NREG,MODYR

- 1)**(

- 0.373164*0.782355) ) ELSEIF (OPTRES.EQ.2) THEN DTAR_SF(NET,NSEC,NREG) = EXP(PRSREG2(NREG)+PRSREGPK2(NREG,NET)) * &
(((BASQTY_SF(NET,NSEC,NREG)+BASQTY_SI(NET,NSEC,NREG))/NUMRS(NREG,MODYR))*

*

- 0.662193) * & (DTAR_SFPREV(NET,NSEC,NREG)**0.255195) * EXP(

- 0.255195*(PRSREG2(NREG)+PRSREGPK2(NREG,NET))) * &
(((BASQTY_SFPREV(NET,NSEC,NREG)+BASQTY_SIPREV(NET,NSEC,NREG))/NUMRS(NREG, MODYR

- 1))**(

- 0.255195*

- 0.662193))

ELSEIF (OPTRES .EQ.3) THEN DTAR_SF(NET,NSEC,NREG) = EXP(PRSREG3(NREG)+PRSREGPK3(NREG,NET)) * &
(((BASQTY_SF(NET,NSEC,NREG)+BASQTY_SI(NET,NSEC,NREG))/NUMRS(NREG,MODYR))*

*

- 0.640736) * & EXP(0.00359432*FLOAT(MODYR)) * (DTAR_SFPREV(NET,NSEC,NREG)**0.253685) * & EXP(

- 0.253685*(PRSREG3(NREG)+PRSREGPK3(NREG,NET))) *
&
(((BASQTY_SFPREV(NET,NSEC,NREG)+BASQTY_SIPREV(NET,NSEC,NREG))/NUMRS( NREG, MODYR

- 1))**(

- 0.253685*

- 0.640736)) * & EXP(

- 0.253685*0.00359432*(FLOAT(MODYR)

- 1.)) ELSEIF (OPTRES.EQ.4) THEN IF (NET.EQ.1) THEN NUMRSPK = NUMRS(NREG,MODYR) NU MRSPKLAG = NUMRS(NREG,MODYR

- 1) ELSE NUMRSPK = 0.0 NUMRSPKLAG = 0.0ENDIF DTAR_SF(NET,NSEC,NREG) = EXP(PRSREG4(NREG)+PRSREGPK4(NREG,NET)) * &

( ((BASQTY_SF(NET,NSEC,NREG)+BASQTY_SI(NET,NSEC,NREG))/NUMRS(NREG,MODYR))*

*

- 0.746798) * & NUMRSPK**0.265761 * EXP(0.00286752*FLOAT(MODYR)) * (DTAR_SFPREV(NET,NSEC,NREG)**0.205207) * & EXP(

- 0.205207*(PRSREG4(NREG)+PRSRE GPK4(NREG,NET))) *
&
(((BASQTY_SFPREV(NET,NSEC,NREG)+BASQTY_SIPREV(NET,NSEC,NREG))/NUMRS(NREG, MODYR

- 1))**(

- 0.205207*

- 0.746798)) * & NUMRSPKLAG**(

- 0.205207*0.265761) * EXP(

- 0.205207*0.00286752*(FLOAT(MODYR)

- 1.))

ELSEIF (OPTRES.EQ.10) THEN DTAR_SF(NET,NSEC,NREG) = EXP(PRSREG10(NREG)) * &

((BASQTY_SF(NET,NSEC,NREG)+BASQTY_SI(NET,NSEC,NREG))**

- 0.695535) * & (NUMRS(NREG,MODYR)**0.913484) * (DTAR_SFPR EV(NET,NSEC,NREG)**0.427223) * & EXP(

- 0.427223*PRSREG10(NREG)) * &

((BASQTY_SFPREV(NET,NSEC,NREG)+BASQTY_SIPREV(NET,NSEC,NREG))**(

- 0.427223*

- 0.695535)) * & (NUMRS(NREG,MODYR

- 1)**(

- 0.427223*0.91348 4)) ELSEIF (OPTRES.EQ.11) THEN DTAR_SF(NET,NSEC,NREG) = EXP(PRSREG11(NREG)+PRSREGPK11(NREG,NET)) * &
(((BASQTY_SF(NET,NSEC,NREG)+BASQTY_SI(NET,NSEC,NREG))/NUMRS(NREG,MODYR))*

*

- 0.712066) * & (DTAR_SFPREV(NET,NSEC,NREG)**0.323857) * EXP(

- 0.323857*(PRSREG11(NREG)+PRSREGPK11(NREG,NET))) * &
(((BASQTY_SFPREV(NET,NSEC,NREG)+BASQTY_SIPREV(NET,NSEC,NREG))/NUMRS(NREG, MODYR

- 1))**(

- 0.323857*

- 0.712066))

ELSEIF (OPTRES.EQ.12) THEN DTAR_SF(NET,NSEC,NREG) = EXP(PRSREG12(NREG)+PRSREGPK12(NREG,NET)) * &
(((BASQTY_SF(NET,NSEC,NREG)+BASQTY_SI(NET,NSEC,NREG))/NUMRS(NREG,MODYR))*

*

- 0.670831) * & EXP(0.00508261*FLOAT(MODYR)) * (DTAR_SFPREV(NET,NSEC,NREG)**0.314448) * & EXP(

- 0.314448*(PRSREG12(NREG)+PRSREGPK12(NREG,NET))) * &
(((BASQTY_SFPREV(NET,NSEC,NREG)+BASQTY_SIPREV(NET,NSEC,NREG))/NUMRS(NREG, MODYR

- 1))**(

- 0.314448*

- 0.670831)) * & EXP(

- 0.314448*0.00508261*(FLOAT(MODYR)

- 1.)) ELSEIF (OPTRES.EQ.13) THEN IF (NET.EQ.1) THEN NUMRSPK = NUMRS(NREG,MODYR)NUMRSP KLAG = NUMRS(NREG,MODYR

- 1) ELSE NUMRSPK = 0.0 NUMRSPKLAG = 0.0 ENDIF DTAR_SF(NET,NSEC,NREG) = EXP(PRSREG13(NREG)+PRSREGPK13(NREG,NET)) * &
(((BASQTY_SF(NET,NSEC,NREG)+BASQTY_SI(NET,NSEC,NREG))/NUMRS(NREG,MODYR))*

*

- 0.840506) * & NUMRSPK**0.265761 * EXP(0.00331614*FLOAT(MODYR)) * (DTAR_SFPREV(NET,NSEC,NREG)**0.272413) * & EXP(

- 0.272413*(PRSREG13 (NREG)+PRSREGPK13(NREG,NET))) * &
(((BASQTY_SFPREV(NET,NSEC,NREG)+BASQTY_SIPREV(NET,NSEC,NREG))/NUMRS(NREG, MODYR

- 1))**(

- 0.272413*

- 0.840506)) * & NUMRSPKLAG**(

- 0.272413*0.273341) * EXP(

- 0.272413*0.00331614*(FLOAT(MODY R)

- 1.))

ELSEIF (OPTRES.EQ.14) THEN DTAR_SF(NET,NSEC,NREG) = EXP(PRSREG14(NREG)+PRSREGPK14(NREG,NET)) * &
(((BASQTY_SF(NET,NSEC,NREG)+BASQTY_SI(NET,NSEC,NREG))/NUMRS(NREG,MODYR))*

*

- 0.707463) * & (DTAR_SFPREV(NET,NSEC,NREG)**0.329051) * EXP(

- 0.329051*(PRSREG14(NREG)+PRSREGPK14(NREG,NET))) * &
(((BASQTY_SFPREV(NET,NSEC,NREG)+BASQTY_SIPREV(NET,NSEC,NREG))/NUMRS(NREG, MODYR

- 1))**(

- 0.329051*

- 0.707463))

ELSEIF (OPTRES.EQ.15) THEN DTAR_SF(NET,NSEC,NREG) = EXP(PRSREG15(NREG)+PRSREGPK15(NREG,NET)) * &
(((BASQTY_SF(NET,NSEC,NREG)+BASQTY_SI(NET,NSEC,NREG))/NUMRS(NREG,MODYR))*

*

- 0.674897) * & EXP(0.00383 180*FLOAT(MODYR)) * (DTAR_SFPREV(NET,NSEC,NREG)**0.315440) * & EXP(

- 0.315440*(PRSREG15(NREG)+PRSREGPK15(NREG,NET))) * &
(((BASQTY_SFPREV(NET,NSEC,NREG)+BASQTY_SIPREV(NET,NSEC,NREG))/NUMRS(NREG, MODYR

- 1) )**(

- 0.315440*

- 0.674897)) * & EXP(

- 0.315440*0.00383180*(FLOAT(MODYR)

- 1.)) ELSEIF (OPTRES.EQ.16) THEN IF (NET.EQ.1) THEN NUMRSPK = 1.0 NUMRSPKLAG = 1.0 ELSE NUMRSPK = 0.0 NUMRSPKLAG = 0.0 ENDIF DTAR_SF(NET,NSEC,NREG) = EXP(PRSREG16(NREG)+PRSREGPK16(NREG,NET)) * &(((BASQTY_SF(NET,NSEC,NREG)+BASQTY_SI(NET ,NSEC,NREG))/NUMRS(NREG,MODYR))*

*

- 0.857640) * &
(((BASQTY_SF(NET,NSEC,NREG)+BASQTY_SI(NET,NSEC,NREG))/NUMRS(NREG,MODYR))* *(NUMRSPK*0.290752)) * & EXP(0.00214124*FLOAT(MODYR)) * (DTAR_SFPREV(NET,NSEC,NREG)**0.265488) * & EXP(

- 0.265488*(PRSREG16(NREG)+PRSREGPK16(NREG,NET))) * &
(((BASQTY_SFPREV(NET,NSEC,NREG)+BASQTY_SIPREV(NET,NSEC,NREG))/NUMRS(NREG, MODYR

- 1))**(

- 0.265488*

- 0.857640)) * &

(((BASQTY_SFPREV(NET,NSE C,NREG)+BASQTY_SIPREV(NET,NSEC,NREG))/NUMRS(NREG, MODYR

- 1))**(

- 0.265488*.290752*NUMRSPKLAG)) * & EXP(

- 0.265488*0.00214124*(FLOAT(MODYR)

- 1.)) ELSEIF (OPTRES.EQ.17) THEN DTAR_SF(NET,NSEC,NREG) = EXP(PRSREG 17(NREG)) * &

((BASQTY_SF(NET,NSEC,NREG)+BASQTY_SI(NET,NSEC,NREG))**

- 0.697622) * & (NUMRS(NREG,MODYR)**0.841119) * (DTAR_SFPREV(NET,NSEC,NREG)**0.432484) * & EXP(

- 0.432484*PRSREG17(NREG)) * &

((BASQTY_SFPREV(NET,NSEC,NREG)+BASQTY_SIPREV(NET,NSEC,NREG))**(

- 0.432484*

- 0.697622)) * & (NUMRS(NREG,MODYR

- 1)**(

- 0.432484*0.841119)) ! ELSEIF (OPTRES.EQ.18) THEN !2010 Version 1: ! DTAR_SF(N ET,NSEC,NREG) = ((1000*(BASQTY_SF(NET,NSEC,NREG)+BASQTY_SI(NET,NSEC,NREG))/(NUMRS(NREG,MO DYR)))**(

- 0.748481)) * & ! ((NUMRS(NREG,MODYR)/1000)**0.215217)* & ! (EXP(PRSREG18(NREG)+PRSREGPK18(NREG,NET)))* & ! (DTAR_SFPREV(NET,NSEC,NREG)**0.230802)* & ! ((1000*(BASQTY_SFPREV(NET,NSEC,NREG)+BASQTY_SIPREV(NET,NSEC,NREG))/NUMRS( NREG,MODYR

- 1))**(0.230802*0.748481)) * & ! ((NUMRS(NREG,MODYR

- 1)/1000)**(

- 0.230802 *0.215217)) *
& ! (EXP(

- 0.230802*(PRSREG18(NREG)+PRSREGPK18(NREG,NET))))

ELSEIF (OPTRES.EQ.18) THEN !2010 Version 1: DTAR_SF(NET,NSEC,NREG) = (((BASQTY_SF(NET,NSEC,NREG)+BASQTY_SI(NET,NSEC,NREG))/(NUMRS(NREG,MODYR)) )**(

- 0.748481) ) * &

((NUMRS(NREG,MODYR))**0.215217)* & (EXP(PRSREG18(NREG)+PRSREGPK18(NREG,NET)))* & (DTAR_SFPREV(NET,NSEC,NREG)**0.230802)* &
(((BASQTY_SFPREV(NET,NSEC,NREG)+BASQTY_SIPREV(NET,NSEC,NREG))/NUMRS(NREG, MODYR

- 1))**(0.230802*0.748481) ) * &

((NUMRS(NREG,MODYR

- 1))**(

- 0.230802*0.215217)) * &(EXP(

-

0.230802*(PRSREG18(NREG)+PRSREGPK18(NREG,NET))))

ELSEIF (OPTRES.EQ.19) THEN !2010 Version 2: IF (NET.EQ.1) THEN ! peak DTAR_ SF(NET,NSEC,NREG) = (((BASQTY_SF(NET,NSEC,NREG)+BASQTY_SI(NET,NSEC,NREG))/(NUMRS(NREG,MODYR)) )**(

- 0.607267)) * & ((NUMRS(NREG,MODYR))**0.162972)* & (EXP(PRSREG19(NREG)+PRSREGPK19(NREG,NET)))* & (DTAR_SFPREV(NET,N SEC,NREG)**0.231296)* &
(((BASQTY_SFPREV(NET,NSEC,NREG)+BASQTY_SIPREV(NET,NSEC,NREG))/NUMRS(NREG, MODYR

- 1))**(0.231296*0.607267)) * & ((NUMRS(NREG,MODYR

- 1))**(

- 0.231296*0.162972)) * & (EXP(

- 0.231296*(PRSREG19(NR EG)+PRSREGPK19(NREG,NET)))) ELSE !off

- peak DTAR_SF(NET,NSEC,NREG) = (((BASQTY_SF(NET,NSEC,NREG)+BASQTY_SI(NET,NSEC,NREG))/(NUMRS(NREG,MODYR)) )**(

- 0.814968)) * & ((NUMRS(NREG,MODYR))**0.282301)* & (EXP(PRSREG19 (NREG)+PRSREGPK19(NREG,NET)))* & (DTAR_SFPREV(NET,NSEC,NREG)**0.202612)* &
(((BASQTY_SFPREV(NET,NSEC,NREG)+BASQTY_SIPREV(NET,NSEC,NREG))/NUMRS(NREG, MODYR

- 1))**(0.202612*0.814968)) * & ((NUMRS(NREG,MODYR

- 1 ))**(

- 0.202612*0.282301)) * & (EXP(

- 0.202612*(PRSREG19(NREG)+PRSREGPK19(NREG,NET)))) ENDIF ENDIF ENDIF ENDDO ENDDO ENDDO

! SET UTILITY DISTRIBUTOR TARIFFS

! HOLD ELEC UTIL TARIFFS CONSTANT, EXCEPT WHEN HISTORICALLY ARE EXCEPTIONALLY ! LOW, PROBABLY DUE TO SPECIALLY ARRANGED DEALS NOT REFLECTIVE OF MARKET ! CONDITIONS. PHASE THESE MARGINS UP MORE IN LINE WITH REASONABLE VALUES

! EM4 TRACK

-- keep 0.95, Analyst Judge ment ! DO J=1,NNGEM

- 1 ! UTILITY SUBREGIONS 1

- 16 ! DO NET=1,NETWORK ! IF (MODYR .GT. LHISYR) THEN ! IF (UDTAR_SFPREV(NET,J) .LT.

- 1.00) THEN ! UDTAR_SF(NET,J) = UDTAR_SFPREV(NET,J) * 0.95 ! ELSE ! UDTAR_SF(NET,J) = UDTAR_SFPREV(NET,J) ! END IF ! IF (UDTAR_SIPREV(NET,J) .LT.

- 1.00) THEN! UDTAR_SI(NET,J) = UDTAR_SIPREV(NET,J) * 0.95

! ELSE ! UDTAR_SI(NET,J) = UDTAR_SIPREV(NET,J) ! END IF ! ENDIF ! ENDDO ! ENDDO

! ADJUST ELECTRIC "DISTRIBUTOR" TARIFFS TO ACCOUNT FOR INCREASED INTRASTATE ! DISTRIBUTION INFRASTRUCTURE TO HANDLE INCREASED ELEC. CONSUMPTION ! PARAMETERS SELECTED BY JBE BASED ON ANALYST JUDGEMENT

IF (MODYR.GT.EHISYR) THEN

DO NET=1,NETWORK OTHR = 0.0 OTHRLAG = 0.0 DO NSEC=1,4 DO NGT=1,DNODES OTHR(NGT) = OTHR(NGT) + BASQTY_SF(NET,NSEC,NGT) + BASQTY_SI(NET,NSEC,NGT)

OTHRLAG(NGT) = OTHRLAG(NGT) + BASQTY_SFPREV(NET,NSEC,NGT) + BASQTY_SIPREV(NET,NSEC,NGT)

ENDDO ENDDO DO NREG=1,NNGEM

- 1 HDD(NET,NREG) = AHDD(NET,NREG) HDDLAG(NET,NREG) = AHDD(NET,NREG) IF ( MODYR.EQ.EHISYR+1) HDDLAG(NET,NREG) = HHDD(NET,NREG,EHISYR)

oQNG_NONELEC(NREG,CURIYR,NET) = OTHR(EMMSUB_NG(NREG)) ENDDO

IF (OPTELP.EQ.3) THEN DO NREG=1,NNGEM

- 1 NGT = EMMSUB_NG(NREG) I F (NET.EQ.PKNET) THEN UDTAR_SF(NET,NREG) = 0.17710 + BETA_V1(NREG) + (0.000180174*HDD(NET,NREG)) + & (oEL_MRKUP_BETA(1) * (BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG))/OTHR(NGT)) + & (0.186025 * UDTAR_SFPREV(NET,NREG))

- & (0.186025 * ( 0.17710 + BETA_V1(NREG) + (0.000180174*HDDLAG(NET,NREG)) + & (oEL_MRKUP_BETA(1) * (BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG))/OTHRLAG(NGT) ) ) )

ELSE UDTAR_SF(NET,NREG) = 0.188501 + BETA_V2(NREG) + & (oEL_MRKUP_BETA(2) * (BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG))/OTHR(NGT)) + & (0.317360 * UDTAR_SFPREV(NET,NREG))

- & (0.317360 * ( 0.188501 + BETA_V2(NREG) + &(oEL_MRKUP_BETA(2) *

(BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG))/OTHRLAG(NGT)) ) )

ENDIF ENDDO ELSEIF (OPTELP.EQ.4) THEN DO NREG=1,NNGEM

- 1 NGT = EMMSUB_NG(NREG) UDTAR_SF(NET,NREG) = 0.102081 + BETA_V3(NREG) + (0.000200214*HDD(NET,NREG)) + & ! ANN EU Q????

(0.170505 * (BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG))/OTHR(NG T)) + &

(0.291833 * UDTAR_SFPREV(NET,NREG))

- & (0.291833 * ( 0.102081 + BETA_V3(NREG) + (0.000200214*HDDLAG(NET,NREG)) + &

(0.170505 * (BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG))/OTHRLAG(NGT)) ) )

ENDDO ELSEIF (OPTELP.EQ.5) THEN ! RATIO = ELEC DO NREG=1,NNGEM

- 1 NGT = EMMSUB_NG(NREG) IF (NET.EQ.PKNET) THEN UDTAR_SF(NET,NREG) =

- 0.157099 + BETA_V4(NREG) + (0.000208182 *HDD(NET,NREG)) + & (oEL_MRKUP_BETA(1) * (BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG))) + & (0.176175 * UDTAR_SFPREV(NET,NREG))

- & (0.176175 * (

- 0.157099 + BETA_V4(NREG) + (0.000208182*HDDLAG(NET,NREG)) + & (oEL_MRKUP_BETA(1) * (BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG))) ) )

ELSE UDTAR_SF(NET,NREG) =

- 0.210296 + BETA_V5(NREG) + & (oEL_MRKUP_BETA(2) * (BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG))) + & (0.317430 * UDTAR_SFPREV(NET,NREG))

- & (0.317430 * (

- 0.210296 + BETA_V5(NREG) + & (oEL_MRKUP_BETA(2) * (BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET ,NREG))) ) )

ENDIF ENDDO

ELSEIF (OPTELP.EQ.6) THEN ! RATIO = ELEC/TOTAL DO NREG=1,NNGEM

- 1 NGT = EMMSUB_NG(NREG) IF (NET.EQ.PKNET) THEN UDTAR_SF(NET,NREG) =

- 0.106720 + BETA_V7(NREG) + (0.000195837*HDD(NET,NREG)) + & (oEL_MRKUP_BETA(1) * (BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG))/(OTHR(NGT)+BASUQTY_SF(NET,NRE G)+BASUQTY_SI(NET,NREG))) + & (0.170314 * UDTAR_SFPREV(NET,NREG))

- & (0.170314 * (

- 0.106720 + BETA_V7(NREG) + (0.000195837*HDDLAG(NET,NREG)) + &(oEL_MRKUP_BETA(1) *

(BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG))/(OTHRLAG(NGT)+BASUQTY _SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG)) ) ) )

ELSE UDTAR_SF(NET,NREG) = 0.030489 + BETA_V8(NREG) + & (oEL_MRKUP_BETA(2) * (BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG))/(OTHR(NGT)+BASUQTY_SF(NET,NRE G)+BASUQTY_SI(NET,NREG))) + & (0.3 11220 * UDTAR_SFPREV(NET,NREG))

- & (0.311220 * ( 0.030489 + BETA_V8(NREG) + & (oEL_MRKUP_BETA(2) * (BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG))/(OTHRLAG(NGT)+BASUQTY _SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG))) ) )

ENDIF ENDDO ELSEIF (OPTELP.EQ.7) THEN DO NREG = 1,NNGEM

- 1 IF (BASUQTY_SFPREV(NET,J).GT.0.0) THEN CHQTY = (BASUQTY_SF(NET,J)

- BASUQTY_SFPREV(NET,J)) / &

BASUQTY_SFPREV(NET,J) CHQTY = AMIN1(CHQTY, 2.) CHQTY = AMAX1(CHQTY,

- 2.) ELSE CHQTY = 0.0 ENDIF UDTAR_SF(NET,J) = UDTAR_SF(NET,J) + (CHQTY * 0. 27) ENDDO

ELSEIF (OPTELO.EQ.1.AND.NET.EQ.2) THEN DO NREG=1,NNGEM

- 1 UDTAR_SF(NET,NREG) =

- 0.439073 + PELREG1(NREG) + (0.000203505*HDD(NET,NREG)) + &

(0.000824786*(BASUQTY_SF(NET,NREG)+BASUQTY_ SI(NET,NREG)))
+ & (0.276063*UDTAR_SFPREV(NET,NREG))

- (0.276063 * &

(

- 0.439073 + PELREG1(NREG) + (0.000203505*HDDLAG(NET,NREG)) + &

(0.000824786*(BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG)))))

ENDDO ELSEIF (OPTELO.EQ.2.AND.NET.EQ.2) THEN DO NREG=1,NNGEM

- 1 UDTAR_SF(NET,NREG) =

- 0.278414 + PELREG2(NREG) + & (0.000671905*(BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG)))
+ & (0.2634 37*UDTAR_SFPREV(NET,NREG)) &

- 0.263437 * (

- 0.278414 + PELREG2(NREG) + &

(0.000671905*(BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG))) )

ENDDO ELSEIF (OPTELO.EQ.3.AND.NET.EQ.2) THEN DO NREG=1,NNGEM

- 1 NGT = EMMSUB_NG(NREG) ! UDTAR_SF(NET,NREG) = (0.051338+0.047) + PELREG5(NREG) + &!

((0.143507*0.70)*(BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG))/OTHR(NGT)) +
& ! (0.262643* UDTAR_SFPREV(NET,NREG)) & !

- 0.262643 * ((0.051338+.047) + PELREG5(NREG) + & ! ((0.143507*0.70)*(BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG))/OTHR LAG(NGT)) ) UDTAR_SF(NET,NREG) = (0.051338) + PELREG5(NREG) + &
((0.143507*0.70)*(BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG))/OTHR(NGT)) +
& (0.262643*UDTAR_SFPREV(NET,NREG)) &

- 0.262643 * ((0.051338) + PELREG5(NREG) + &

((0.143507*0.70)*(BASUQTY_SFPREV(N ET,NREG)+BASUQTY_SIPREV(NET,NREG))/OTHR LAG(NGT)) )

ENDDO ELSEIF (OPTELO.EQ.20.AND.NET.EQ.2) THEN DO NREG=1,NNGEM

- 1 UDTAR_SF(NET,NREG) =

- 0.298195 + 0.032857 + PELREG20(NREG)
+ & ! 1/2 stdv

(0.000739858*(BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG)))
+ & (0.290671*UDTAR_SFPREV(NET,NREG)) &

- 0.290671 * (

- 0.298195 + .032857 + PELREG20(NREG) + & ! 1/2 stdv

(0.000739858*(BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG))) ) ! UDTAR_SF(NET,NREG) =

- 0.298195 + 0.065714 + PELREG20(NREG) + & ! 1 stdv ! (0.000739858*(BASUQTY_SF(NET,NREG)+BASUQT Y_SI(NET,NREG)))
+ & ! (0.290671*UDTAR_SFPREV(NET,NREG)) & !

- 0.290671 * (

- 0.298195 +.065714 + PELREG20(NREG) + & ! 1 stdv ! (0.000739858*(BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG)) ) ) ! UDTAR_SF(NET,NREG) =

- 0.298195 + PELREG20(NREG) + & ! no adj ! (0.000739858*(BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG)))
+ & ! (0.290671*UDTAR_SFPREV(NET,NREG)) & !

- 0.290671 * (

- 0.298195 + PELREG20(NREG) + & ! no adj ! (0.000739858*(BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG))) )

ENDDO ELSEIF (OPTELP.EQ.1.AND.NET.EQ.1) THEN DO NREG=1,NNGEM

- 1 UDTAR_SF(NET,NREG) =

- 0.814441 + PELREG3(NREG) + (0.000399532*HDD(NET,NREG)) + &

(0.00204343*(BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG)))
+ &(0.135659*UDTAR_SFPREV(NET,NREG))

- (0 .135659 * & (

- 0.814441 + PELREG3(NREG) + (0.000399532*HDDLAG(NET,NREG)) + &

(0.00204343*(BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG)))))

ENDDO ELSEIF (OPTELP.EQ.2.AND.NET.EQ.1) THEN DO NREG=1,NNGEM

- 1 UDTAR_SF(NET,NREG) =

- 0.195220 + PELREG4(NREG) + & (0.00138713*(BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG)))
+ & (

- 0.206020*UDTAR_SFPREV(NET,NREG)) &

- 0.206020 * (

- 0.195220 + PEL REG4(NREG) + &

(0.00138713*(BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG))) )

ENDDO ELSEIF (OPTELP.EQ.11.AND.NET.EQ.1) THEN DO NREG=1,NNGEM

- 1 NGT = EMMSUB_NG(NREG) UDTAR_SF(N ET,NREG) = (

- 0.201039+0.023) + PELREG6(NREG) + &
((0.248175*0.70)*(BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG))/OTHR(NGT)) +
& (0.141027*UDTAR_SFPREV(NET,NREG)) &

- 0.141027 * ((

- 0.201039+0.023) + PELREG6(NREG) + &
((0.248175*0.70)*(BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG))/OTHR LAG(NGT)) ) ENDDO

ELSEIF (OPTELP.EQ.21.AND.NET.EQ.1) THEN DO NREG=1,NNGEM

- 1 UDTAR_SF(NET,NREG) = (

- 0.613456 + .080822) + PELREG21(NREG) + (0.000298333*HDD(NET,NREG)) + & ! 1/2 stdv

(0.00162273*(BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG)))
+ & (0.198411*UDTAR_SFPREV(NET,NREG))

- (0.1984 11 * &

((

- 0.613456+.080822) + PELREG21(NREG) + (0.000298333*HDDLAG(NET,NREG)) + & ! 1/2 stdv

(0.00162273*(BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG))))) ! UDTAR_SF(NET,NREG) = (

- 0.613456 + .161644) + PELREG21(NREG) + (0.000298333*HDD(NET,NREG)) + & ! 1 stdv ! (0.00162273*(BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG)))
+ & ! (0.198411*UDTAR_SFPREV(NET,NREG))

- (0.198411 * & ! ((

- 0.613456+.161644) + PE LREG21(NREG) + (0.000298333*HDDLAG(NET,NREG)) + & ! 1 stdv ! (0.00162273*(BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG))))) ! UDTAR_SF(NET,NREG) = (

- 0.613456) + PELREG21(NREG) + (0.000298333*HDD(NET,NREG)) + & ! no adj ! (0.00162273*(BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG)))
+ & ! (0.198411*UDTAR_SFPREV(NET,NREG))

- (0.198411 * &! ((

- 0.613456) + PELREG21(NREG) +

(0.000298333*HDDLAG(NET,NREG)) + & ! no adj ! (0.00162273*(BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG)))))

ENDDO ELSEIF (OPTELP.EQ.22.AND.NET.EQ.1) THEN DO NREG=1,NNGEM

- 1 UDTAR_SF(NET,NREG ) = (

- 0.156543) + PELREG22(NREG) + & (0.00108860*(BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG)))
+ & (0.223756*UDTAR_SFPREV(NET,NREG)) &

- 0.223756 * ((

- 0.156543) + PELREG22(NREG) + &

(0.00108860 *(BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG))) )

ENDDO ELSEIF (OPTELP.EQ.23.AND.NET.EQ.1) THEN DO NREG=1,NNGEM

- 1 ! UDTAR_SF(NET,NREG) = (

- 0.190692

- 0.02596) + PELREG23(NREG)
+ & ! (0.00000 131132*(BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG))) + & ! (0.236964*UDTAR_SFPREV(NET,NREG))

- (0.236964 * & ! ((

- 0.190692 + 0.02596) + PELREG23(NREG) + & ! 1/2 stdv ! (0.00000131132*(BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG))))) ! UDTAR_SF(NET,NREG) = (

- 0.190692

- 0.051920) + PELREG23(NREG) + & ! (0.00000131132*(BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG))) + & ! (0.236964*U DTAR_SFPREV(NET,NREG))

- (0.236964 * & ! ((

- 0.190692 + 0.051920) + PELREG23(NREG) + & ! 1/2 stdv ! (0.00000131132*(BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG)))))

UDTAR_SF(NET,NREG) = (

- 0.19 0692) + PELREG23(NREG) + &

(0.00000131132*(BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG))) + &

(0.236964*UDTAR_SFPREV(NET,NREG))

- (0.236964 * & ((

- 0.190692) + PELREG23(NREG) + & ! 1/2 stdv
(0.00000131132*(BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG)))))

ENDDO ELSEIF (OPTELP.EQ.24.AND.NET.EQ.1) THEN DO NREG=1,NNGEM

- 1 UDTAR_SF(NET,NREG) = (

- 0.298199) + PELREG24(NREG) + & (0.000001702*(BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG)))
+ & (0.300968*UDTAR_SFPREV(NET,NREG)) &

- 0.300968 * ((

- 0.298199) + PELREG24(NREG) + &

(0.000001702*(BASUQTY_SFPREV(NET,NREG)+BASUQTY _SIPREV(NET,NREG))) )

ENDDOELSEIF (OPTELP.EQ.25.AND.NET.EQ.1) THEN DO NREG=1,NNGEM

- 1 NGT = EMMSUB_NG(NREG) UDTAR_SF(NET,NREG) = (

- 0.264537

- 0.052096) + PELREG25(NREG) + &
(0.963446*((BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG))/OTHR(NGT))) + (0.211449*UDTAR_SFPREV(NET,NREG)) &

- 0.211449 * (

- 0.264537

- 0.052096 + PELREG25(NREG) + &

(0.963446*((BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(N ET,NREG))/OTHRLAG(NG T))) ) ENDDO

ELSEIF (OPTELP.EQ.26.AND.NET.EQ.1) THEN DO NREG=1,NNGEM

- 1 UDTAR_SF(NET,NREG) = PELREG26(NREG) + & (0.000000125*(BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG))) +
& (0.243972*UDTAR_SFPREV(NET,NREG))

- 0.243972 * (PELREG26(NREG) + &

(0.000000125*(BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG))) )

ENDDO ELSEIF (OPTELP.EQ.27.AND.NET.EQ.1) THEN DO NREG=1,N NGEM

- 1 UDTAR_SF(NET,NREG) = (0.133024

- 0.140954) + PELREG27(NREG)
+ & (0.734297*(share(dnodes))) + (0.183278*UDTAR_SFPREV(NET,NREG)) &

- 0.183278 * ((0.133024

- 0.140954) + PELREG27(NREG) + & (0.7342 97*(share(dnodes))) ) ENDDO ELSEIF (OPTELO.EQ.28.AND.NET.EQ.2) THEN DO NREG=1,NNGEM

- 1 UDTAR_SF(NET,NREG) = (

- 0.465467

- 0.077472) + PELREG28(NREG) + &

(0.510792*(share(dnodes))) + & (0.337095*UDTAR_SFPREV(NET,NREG))

- (0.337095 * & ((

- 0.465467

- 0.077472) + PELREG28(NREG) + & (0.510792*(share(dnodes))))) ENDDO ELSEIF (OPTELO.EQ.29.AND.NET.EQ.2) THEN DO NREG=1,NNG EM

- 1 UDTAR_SF(NET,NREG) = (

- 0.568747

- 0.072328) + PELREG29(NREG) + &

(0.674213*share(dnodes)) + & (0.367474*UDTAR_SFPREV(NET,NREG))

- (0.367474 * & ((

- 0.568747

- 0.072328) + PELREG29(NREG) + & (0.674213*(share(dnodes))))) ENDDO ELSEIF (OPTELO.EQ.30.AND.NET.EQ.2) THEN DO NREG=1,NNGEM

- 1 UDTAR_SF(NET,NREG) =

- 0.520699 + PELREG30(NREG) + & (0.000135140*HDD(NET,NREG)) + &(0.00000103747*(BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG))) + & (0.329826*UDTAR_SFPREV(NET,NREG))

- (0.329826 * & (

- 0.520699 + PELREG30(NREG) + (0.000298333*HDDLAG(NET,NREG)) + &

(0.00000103 747*(BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG)))))

ENDDO ! ELSEIF (OPTELP.EQ.31.AND.NET.EQ.1) THEN !2010 Version 1 Peak, no adj ! DO NREG=1,NNGEM

- 1 ! UDTAR_SF(NET,NREG) =

- 0.153777 + PELREG31(NREG) & ! + 0.000000704*(BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG))*1000 & ! + (0.281378*UDTAR_SFPREV(NET,NREG))

- 0.281378 * & ! (

- 0.153777 + PELREG31(NREG) & ! + 0.000000704*(BASUQTY_SF PREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG))*1000) ! ENDDO ! ELSEIF (OPTELO.EQ.32.AND.NET.EQ.2) THEN ! 2010 Version 1 Off

Peak, no adj ! DO NREG=1,NNGEM

- 1 ! UDTAR_SF(NET,NREG) =

- 0.153777 + PELREG32(NREG) & ! + 0.000000704*(BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG))*1000 & ! + (0.281378*UDTAR_SFPREV(NET,NREG))

- 0.281378 * & ! (

- 0.153777 + PELREG32(NREG) & ! + 0.000000704*(BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIP REV(NET,NREG))*1000) ! ENDDO

ELSEIF (OPTELP.EQ.31.AND.NET.EQ.1) THEN !2010 Version 1 Peak, + 1/2 sd DO NREG=1,NNGEM

- 1

UDTAR_SF(NET,NREG) =

- 0.153777 + 0.0299295 + PELREG31(NREG)
& + 0.000000704*(BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG))*1000 &

+ (0.281378*UDTAR_SFPREV(NET,NREG))

- 0.281378 * & (

- 0.153777 + 0.0299295 + PELREG31(NREG) &
+ 0.000000704*(BASUQTY_SFPREV(NET, NREG)+BASUQTY_SIPREV(NET,NREG))*1000)

ENDDO ELSEIF (OPTELO.EQ.32.AND.NET.EQ.2) THEN ! 2010 Version 1 Off

Peak, + 1/2 sd

DO NREG=1,NNGEM

- 1 UDTAR_SF(NET,NREG) =

- 0.153777 + 0.0299295 + PELREG32(NREG)
& + 0.000000704*(BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG))*1000 &

+ (0.281378*UDTAR_SFPREV(NET,NREG))

- 0.281378 * & (

- 0.153777 + 0.0299295 + PELREG32(NREG) &
+ 0.000000704*(BASUQTY_SFPREV(NET,NREG)+BA SUQTY_SIPREV(NET,NREG))*1000)

ENDDO! ELSEIF (OPTELP.EQ.33.AND.NET.EQ.1) THEN !2010 Version 2 Peak

! DO NREG=1,NNGEM

- 1 ! UDTAR_SF(NET,NREG) =

- 0.125330 + PELREG33(NREG) & ! + 0.073037*((BASUQTY_SF (NET,NREG)+BASUQTY_SI(NET,NREG))/(OTHR(NGT))) & ! + (0.294743*UDTAR_SFPREV(NET,NREG))

- 0.294743 * & ! (

- 0.125330 + PELREG33(NREG) & ! + 0.073037*((BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG))/(OTHRLAG(NG
T )))) ! ENDDO ! ELSEIF (OPTELO.EQ.34.AND.NET.EQ.2) THEN ! 2010 Version 2 Off

Peak ! DO NREG=1,NNGEM

- 1 ! UDTAR_SF(NET,NREG) =

- 0.125330 + PELREG34(NREG) & ! + 0.073037*((BASUQTY_SF(NET,NREG)+BASUQTY_ SI(NET,NREG))/(OTHR(NGT))) & ! + (0.294743*UDTAR_SFPREV(NET,NREG))

- 0.294743 * & ! (

- 0.125330 + PELREG34(NREG) & ! + 0.073037*((BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG))/(OTHRLAG(NG T)))) ! ENDDO

ELSEIF (OPTELP.EQ.33.AND.NET.EQ.1) THEN !2010 Version 2 Peak DO NREG=1,NNGEM

- 1 UDTAR_SF(NET,NREG) =

- 0.125330 + PELREG33(NREG) &
+ 0.073037*((BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG))/(BASUQTY_SF(NET,NRE G)+BASUQTY_SI(NET,NREG)+OTHR(NGT))) &

+ (0.294743*UDTAR_SFPREV(NET,NREG))

- 0.294743 * & (

- 0.125330 + PELREG33(NREG) &
+ 0.073037*((BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG))/(BASUQTY_SF PREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG)+OTHRLAG(NGT))))

ENDDO ELSEIF (OPTELO.EQ.34.AND.NET.EQ.2) THEN ! 2010 Version 2 Off

Peak DO NREG=1,NNGEM

- 1

UDTAR_SF(NET,NREG) =

- 0.125330 + PELREG34(NREG) &
+ 0.073037*((BASUQTY_SF(NET,NREG)+BASUQTY_SI(NET,NREG))/(BASUQTY_SF(NET,NRE G)+BASUQTY_SI(NET,NREG)+OTHR(NGT))) &

+ (0.294743*UDTAR_SFPREV(NET,NREG))

- 0.294743 * & (

- 0.125330 + PELREG34(NREG) &
+ 0.073037*((BASUQTY_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG))/(BASUQTY_SF PREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG)+OTHRLAG(NGT))))

ENDDO ENDIF DO NREG=1,NNGE M

- 1 UDTAR_SI(NET,NREG) = UDTAR_SF(NET,NREG) ENDDO ENDDO! OVERWRITE RESULTS FROM ABOVE WITH FOLLOWING FOR ELECTRIC GEN

IF (OPTELP.EQ.8.OR.OPTELP.EQ.9.OR.OPTELP.EQ.10) THEN DO J=1,NNGEM

- 1 NREG = NG_CENMAP(EMMSUB_NG(J)) MAP = EMMSUB_EL(J) EL_RS_CAP(J) = oUCAPOSU(MAP,CURIYR)+oUCAPOSN(MAP,CURIYR)+oUCAPOSC(MAP,CURIYR)

EL_RS_CAPLAG(J) = oUCAPOSU(MAP,CURIYR

- 1)+oUCAPOSN(MAP,CURIYR

1)+oUCAPOSC(MAP,CURIYR

- 1)

DO NET=1,NETWORK IF (OPTELP.EQ.8) THEN UDTAR_SF(NET,J) = EL_CNST + EL_ALP(J) + (EL_RESID * oPRSEL(NREG,CURIYR)) + & (EL_RHO * UDTAR_SFPREV(NET,J))

- (EL_RHO * (EL_CNST + EL_ALP(J) + & (EL_RESID * oPRSEL(NREG,CURIYR

- 1))))

ELSEIF (OPTELP.EQ.9) THEN UDTAR_SF(NET,J) = EL_CNST + EL_ALP(J) + (EL_RESID * oPRSEL(NREG,CURIYR)) + & (EL_PARM * EL_RS_CAP(J)*oPRSEL(NREG,CURIYR)) + & (EL_RHO * UDTAR_SFPREV(NET,J))

- (EL_RHO * (EL_CNST + EL_ALP(J) + & (EL_RESID * oPRSEL(NREG,CURIYR

1))+(EL_PARM*EL_RS_CAPLAG(J)*oPRSEL(NREG,CURIYR

- 1)) ) )

ELSEIF (OPTELP.EQ.10) THEN UDTAR_SF(NET,J ) = EL_CNST + EL_ALP(J) + (EL_RESID * oPRSEL(NREG,CURIYR)) + & (EL_PARM * EL_RS_CAP(J)) + & (EL_RHO * UDTAR_SFPREV(NET,J))

- (EL_RHO * (EL_CNST + EL_ALP(J) + & (EL_RESID * oPRSEL(NREG,CURIYR

1))+(EL_PARM*EL_RS_CAPLAG(J)) ) )

ENDIF UDTAR_SI(NET,J) = UDTAR_SF(NET,J) ENDDO ENDDO ENDIF ENDIF

! WRITE RESULTS

IF (FCRL.EQ.1) THEN IF (MODYR.EQ.LHISYR+1) THEN DO NET=1,NETWORK WRITE(NGODTM,1000) MODYR

- 1,NET,(J,J=1,NNGEM

- 1) WRITE(NGODTM,2100) NET,(BASUQTY_SFPREV(NET,J),J=1,NNGEM

- 1) 2100 FORMAT(1X,'FUTL_PQTY ',I2,1X,20F6.0)

W RITE(NGODTM,2200) NET,(UDTAR_SFPREV(NET,J),J=1,NNGEM

- 1) 2200 FORMAT(1X,'FUTL_PTAR ',I2,1X,20F6.2)

WRITE(NGODTM,2300) NET,(BASUQTY_SIPREV(NET,J),J=1,NNGEM

- 1)2300 FORMAT(1X,'IUTL_PQTY ',I2,1X,20F6.0) WRITE(NGODTM,2400 ) NET,(UDTAR_SIPREV(NET,J),J=1,NNGEM

- 1) 2400 FORMAT(1X,'IUTL_PTAR ',I2,1X,20F6.2)

ENDDO ENDIF DO NET=1,NETWORK WRITE(NGODTM,1000) MODYR,NET,(J,J=1,NNGEM

- 1) 1000 FORMAT(1X,'UTL',I4,1X,I2,2X,20I6)

W RITE(NGODTM,1100) NET,(BASUQTY_SF(NET,J),J=1,NNGEM

- 1) 1100 FORMAT(1X,'FUTL_QTY ',I2,1X,20F6.0)

WRITE(NGODTM,1200) NET,(UDTAR_SF(NET,J),J=1,NNGEM

- 1) 1200 FORMAT(1X,'FUTL_TAR ',I2,1X,20F6.2)

WRITE(NGODTM,1300) NET,(BASUQTY_SI( NET,J),J=1,NNGEM

- 1) 1300 FORMAT(1X,'IUTL_QTY ',I2,1X,20F6.0)

WRITE(NGODTM,1400) NET,(UDTAR_SI(NET,J),J=1,NNGEM

- 1) 1400 FORMAT(1X,'IUTL_TAR ',I2,1X,20F6.2)

ENDDO ENDIF

! WRITE STATEMENTS

IF (NGDBGITR(1,16) .AND. (FCRL.EQ.1)) THEN NSEC=3 DO NET=1,NETWORK WRITE(NGODTM,*) WRITE(NGODTM,13) MODYR,NSEC,NET, & (DTAR_SI(NET,NSEC,NREG), NREG=1,DNODES) ENDDO 13 FORMAT(2X,'DTAR_I= ',I4, 1X,2(I2,1X),12F9.3)

DO NSEC=1,DSEC

- 1 ! NONUTILITY DO NET=1,NETWORK WRITE(NGODTM,*) WRITE(NGODTM,15) MODYR, NSEC, NET, & (DTAR_SF(NET,NSEC,NREG), NREG=1,DNODES) WRITE(NGODTM,21) MODYR, NSEC, NET, & (DTAR_SFPREV(NET,NSEC,NREG), NREG=1,DNODES) WRITE(NGODTM,19) MODYR, NSEC, NET, & (BASQTY_SF(NET,NSEC,NREG), NREG=1,DNODES) WRITE(NGODTM,23) MODYR, NSEC, NET, & (BASQTY_SFPREV(NET,NSEC,NREG), NREG=1,DNODES) ENDDO ENDDO ! ! WRITE(NGUNIT,25) ! DO J=1,NNGEM

- 1 ! UTILITY SUBREGIONS 1

- 16 ! WRITE(NGUNIT,26) (UDTAR_SF(NET,J),NET=1,NETWORK), ! 1 (UDTAR_SFPREV(NET,J),NET=1,NETWORK), ! 2 (BASUQTY_SF(NET,J),NET=1,NETWORK), ! 3 (BASUQTY_SFPREV(NET,J),NET=1,NETWORK) ! ENDDO ! ENDIF15 FORMAT(2X,'DTAR_F= ',I4,1X,2(I2,1X),12F9.3)

19 FORMAT(2X,'QTY_F = ',I4,1X,2(I2,1X),12F9.1) 21 FORMAT(2X,'P_DTAR= ',I4,1X,2(I2,1X),12F9.3) 23 FORMAT(2X,'P_QTY = ',I4,1X,2(I2,1X),12F9.3) 25 FORMAT(10X,'UDTAR_SF UDTAR_SFPREV',5X, &

'BASUQTY_SF BASUQTY_SFPREV',/4X, & 'NET = 1 2 1 2 ',5X, &

' 1 2 1 2') 26 FORMAT(9X,2F6.3,2X,2F6.3,5X,2F6.3,2X,2F6.3)

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! ! SETS DTAR_F FOR FLEET VE HICLES AND PERSONAL VEHICLES ! ! STATUS: ! ! CALLED BY: NGTDM_DTM ! ! NOTES: ! ! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

SUBROUTINE NGDTM_FORECAST_TRNF IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngitminc' include 'nghistinc' include 'ngdtminc' include 'ngtdminc' include 'ogglobal'

INTEGER*4 NET !

INTEGER*4 NREG ! REGION COUNTER INTEGER*4 NSEC ! SECTOR COUNTER/ID INTEGER*4 YR_DECL ! # OF YEARS FOR DECLINE RATE INTEGER*4 COM/2/ ! COMMERCIAL SECTOR ID: 2

!

----------------

! MODYR MUST BE GREATER THAN EHISYR

YR_DECL = MODYR

- EHISYR

! SET DTAR

NSEC = 4 ! CNG VEHICLESDO NET=1,NETWORK DO NREG=1,DNODES

DTAR_TRFV_SF(NET,NREG) = HDTAR_SF(NET,NSEC,NREG,EHISYR) * & ((1.

- TRN_DECL)**YR_DECL) + RETAIL_COST(2) + & ((STAX(NREG) + FTAX) / (oMC_PCWGDP(CURIYR)/oMC_PCWGDP(

- 2))) ! convt tax to 87$

DTAR_TRPV_SF(NET,NREG) = HDTAR_SF(NET,NSEC,NREG,EHISYR) * & ((1.

- TRN_DECL)**YR_DECL) + CNG_RETAIL_MARKUP(NREG)+ RETAIL_COST(2) + &

((STAX(NREG) + FTAX) / (oMC_PCWGDP(CURIYR)/oMC_PCWGDP(

- 2))) ! convt tax to 87$

DTAR_SF(NET,NSEC,NREG)= & (DTAR_TRFV_SF(NET,NREG)* BASQ_TRFV_SF(NET,NREG)+ & DTAR_TRPV_SF(NET,NREG) * BASQ_TRPV_SF(NET,NREG)) / & (BASQ_TRFV_SF(NET,NREG) + BASQ_TRPV_SF(NET,NREG))

ENDDO ENDDO

RETURN END

!=============================================================== ! SET STATE AND FEDERAL TAXES FOR CNG VEHICLE DTAR CALC !====================== ========================================= SUBROUTINE NGDTM_TRNTAX IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngtdminc' include 'ngdtminc'

INTEGER*4 I ! COUNTER INTEGER*4 NREG ! REGION COUNTER

! SET TAXES

DO I=2,10 IF (TFDYR(I).GT.0) THEN IF (MODYR.GE.TFDYR(I

- 1) .AND. MODYR.LT.TFDYR(I)) THEN FTAX = TFD(I

- 1) GO TO 10 ENDIF ELSE FTAX = TFD(I

- 1) GO TO 10 ENDIF ENDDO 10 CONTINUEDO NREG=1,DNODES IF (MODYR .LT. TST2YR(NREG) .OR. TST2YR(NREG) .EQ. 0) THEN STAX(NREG) = TST1(NREG) ELSE STAX(NREG) = TST2(NREG ) ENDIF ENDDO

RETURN END

!************************************************************************

********* !NGTDM_CNGBUILD !purpose: This subroutine gives the decision by region of whether or not to invest !in new CNG infrastructure. The decision is made based on whether the projected !demand from the new infrastructure will be sufficient to meet the

revenue !requirement to cover the cost of the new infrastructure. The purpose of the decision !is to send the infrastructure to the TRAN module in case CNG for transportation !is a viable energy choice. All energy prices are per MMBTU and are !converted as necessary. Demand amounts are per TRIL BTU and are also converted. All dollar !amounts are in 1987$. O utputs are converted to the proper units for use in NEMS. ! !created: 08/2009

-- MTA ! !************************************************************************

********* SUBROUTINE NGTDM_CNGBUILD IMPLICIT NONE

include 'parametr' include 'ncntrl ' include 'ngparinc' include 'ngdtminc' include 'ngtdminc' include 'ogglobal'

! the following are functions that I define for use REAL :: NGTDM_CALCCNGDEMAND !projects the CNG demand increase for the next year

! variables that I get from global values or send to other parts REAL PETROL_PRC(MNUMCR) !the gasoline price per MMBTUREAL CNG_BASEPRC(MNUMCR) !price of CNG w/o

retail markup MMBTU REAL AVAIL(MNUMCR) !CNG availability REAL CNG_DEMAND(MNUMCR) !current demand for CNG in tril BTU

! variables local to this function INTEGER RGN_ITR, ITR !just counters INTEGER YEAR !the current model year REAL TEST_MARKUP !the suggested markup

REAL NCNGADD(MNUMCR) !the number of cng stations being planned on adding LOGICAL BUIL D_PLAN !true if something is built, false otherwise REAL TOTPUMPS !total number of CNG pumps in a region REAL RET_MARK(MNUMCR) !local retail markup th at will then get mapped to ngtdm regions REAL MAX_CNGMARKUP !the maximum retail markup for cng REAL REVENUE !revenue of the new pumps REAL DEMAND !projected demand after the pumps get built

YEAR = CURIYR + IBASYR

- 1

! loop through each region DO RGN_ITR=1,MNUMCR

- 2 !...get and convert the data that I need from the rest of nems !...the following come from NEMS AVAIL(RGN_ITR) = oCNGAVAIL(RGN_ITR,CURIYR) NCNGADD(RGN_ITR) = NSTAT(RGN_ITR)*MAX_CNG_BUILD PETROL_PRC(RGN_ITR) = oPMGTR(RGN_ITR, CURIYR) !per MMBTU CNG_BASEPRC(RGN_ITR) = oPGFTRPV(RGN_ITR, CURIYR)

- CNG_RETAIL _MARKUP(RGN_ITR) !per MMBTU CNG_DEMAND(RGN_ITR) = oQGFTRPV(RGN_ITR,CURIYR) !tril BTU MAX_CNGMARKUP = (PETROL_PRC(RGN_ITR)

- CNG_BASEPRC(RGN_ITR))*0.75

!...initialize the total number of pumps TOTPUMPS = A VAIL(RGN_ITR)*NSTAT(RGN_ITR)

!...now test to see if the revenue requirement every year can be met BUILD_PLAN = .TRUE. TOTPUMPS = TOTPUMPS+NCNGADD(RGN_ITR)IF(AVAIL(RGN_ITR) .GT. 1

- MAX_CNG_BUILD) BUILD_PLAN=.FALSE.

!...set the markup that will be tested TEST_MARKUP = MIN(5.,MAX_CNGMARKUP)

!...project the demand and compute the NPV of the revenue that stems from that demand DEMAND=CNG_DEMAND(RGN_ITR) REVENUE=0

DO ITR=1,CNG_HRZ DEMAND = DEMAND+NGTDM_CALCCNGDEMAND(0.,TOTPUMPS/NSTAT(RGN_ITR), PETROL_PRC(RGN_ITR)

- CNG_BASEPRC(RGN_ITR)

- TEST_MARKUP, RGN_ITR)

REVENUE = REVENUE + TEST_MARKUP*(DEMAND*1000000.)/TOTPUMPS/((1+CNG_WACC)**ITR)

ENDDO

!...if the revenue is not sufficient then don't build the pumps IF (REVENUE .LT. CNG_BUILDCOST) THEN BUILD_PLAN = .FALSE. ENDIF

!...add new pumps if they are being built IF(BUILD_PLAN .EQ. .TRUE.) THEN AVAIL(RGN_ITR) = AVAIL(RGN_ITR)+MAX_CNG_BUILD ENDIF oCNGAVAIL(RGN_ITR,CURIYR+1) = min(AVAIL(RGN_ITR),1.0)

!...retail markup is in 1987$/MCF RET_MARK(RGN_ITR) = 0. IF(AVAIL(RGN_ITR) .GE. MAX_CNG_BUILD) THEN RET_MARK(RGN_ITR) = TEST_MARKUP ENDIF

ENDDO

!. ..now create the retail markup for use in the rest of the model mapped to the NGTDM regions DO RGN_ITR=1,MNUMCR

- 2 !CNG_RETAIL_MARKUP(RGN_ITR) = MAX(CNG_RETAIL_MARKUP(RGN_ITR),RET_MARK(RGN_ITR)) CNG_RETAIL_MARKUP(RGN_ITR) = RET_MARK(RGN_ITR) !CNG_RETAIL_MARKUP(RGN_ITR)=0 ENDDO CNG_RETAIL_MARKUP(10) = CNG_RETAIL_MARKUP(5) CNG_RETAIL_MARKUP(11) = CNG_RETAIL_MARKUP(8) CNG_RETAIL_MARKUP(12) = CNG_RETAIL_MARKUP(9)! aggregate and print out results

DO RGN_ITR = 2,MNUMCR

- 2 CNG_DE MAND(1) = CNG_DEMAND(1)+CNG_DEMAND(RGN_ITR) AVAIL(1) = AVAIL(1)+AVAIL(RGN_ITR) ENDDO WRITE(NGUNIT,*) "CNG YEAR=", YEAR WRITE(NGUNIT,*) "GAS DEMAND=", CNG_DEMAND(1) WRITE(NGUNIT,*) "END AVAILABILITY=",AVAIL(1)/9.

RETURN END SUBROUTINE

!************************************************************************

********* !This is a function to compute the projected demand for compressed natural gas !given a proposed increase in availability. The equations that give the !increase in demand were estimated from experiments run on the TRAN module and then !estimated econometrically. The output is the increase in demand in trillion BTU. ! !created: 08/2009

-- MTA !************************************************************************

********* REAL FUNCTION NGTDM_CALCCNGDEMAND(SUBSIDY,AVAIL,PRICE_DIFF,RGN) IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngdtminc' include 'ngtdminc' include 'ogglobal'

REAL, INTENT(IN) :: SUBSIDY REAL, INTENT(IN) :: AVAIL REAL, INTENT(IN) :: PRICE_DIFF INTEGER, INTENT(IN)::RGN

REAL C(20) !just a holding variable REAL DMD REAL ART_PRC !artificial price for use here REAL X,Y !proportions for the interpolation

! the artificial price is used in this algorithm because that is how the demand was estimated ART_PRC = 36.4

- PRICE_DIFF! calculate the demand increase for the grid

! subsidy 0, artificial price 10 C(1) = 0.0122*LOG(AVAIL) + 0.7587 ! subsidy 0, artificial price 20 C(2) = 0.0113*LOG(AVAIL) + 0.752 ! subsidy 0, artificial price 30 C(3) = 0.0113*LOG(AVAIL) + 0.7511 ! subsidy 2000, artificial price 10 C(4) = 0.0437*LOG(AVAIL) + 2.4917 ! subsidy 2 000, artificial price 20 C(5) = 0.0398*LOG(AVAIL) + 2.1052 ! subsidy 2000, artificial price 30 C(6) = 0.0395*LOG(AVAIL) + 2.0655 ! subsidy 4000, artificial price 10 C(7) = 0.1105*LOG(AVAIL) + 23.813 ! subsidy 4000, artificial price 20 C(8) = 0.0982*LOG(AVAIL) + 20.959 ! subsidy 4000, artificial price 30 C(9) = 0.0965*LOG(AVAIL) + 20.307

! linearly interpolate between the points in the grid (this isn't the best method but is the most effective that ! we have so far). Improvements ma y be necessary to this later. DMD = C(3) !start with the most conservative IF((SUBSIDY .LE. 2000.) .AND. (SUBSIDY .GE. 0.)) THEN IF(ART_PRC .LE. 10.) THEN Y=1.

- SUBSIDY/2000. DMD = Y*C(1)+(1.

- Y)*C(4) ELSEIF(ART_PRC .LE. 20.) THEN X = 1.

- (ART_PRC

- 10.)/10. Y = 1.

- SUBSIDY/2000. DMD = X*Y*C(1)+(1.

- X)*Y*C(2)+X*(1.

- Y)*C(4)+(1.

- X)*(1.

- Y)*C(5) ELSEIF(ART_PRC .LE. 30) THEN X = 1.

- (ART_PRC

- 20.)/10. Y = 1.

- SUBSIDY/2000. DMD = X*Y*C(2)+(1.

- X)*Y*C(3)+X*(1.

- Y)*C(5)+(1.

- X)*(1.

- Y)*C(6) ENDIF ENDIF

IF((SUBSIDY .LE. 4000.) .AND. (SUBSIDY .GT. 2000.)) THEN IF(ART_PRC .LE. 10.) THEN Y=1.

- (SUBSIDY

- 2000.)/2000. DMD = Y*C(4)+(1.

- Y)*C(7) ELSEIF(ART_PR C .LE. 20.) THEN X = 1.

- (ART_PRC

- 10.)/10. Y = 1.

- (SUBSIDY

- 2000.)/2000. DMD = X*Y*C(4)+(1.

- X)*Y*C(5)+X*(1.

- Y)*C(7)+(1.

- X)*(1.

- Y)*C(8) ELSEIF(ART_PRC .LE. 30) THEN X = 1.

- (ART_PRC

- 20.)/10. Y = 1.

- (SUBSIDY

- 2000.)/2000. DMD = X*Y*C(5)+(1.

- X)*Y*C(6)+X*(1.

- Y)*C(8)+(1.

- X)*(1.

- Y)*C(9)ENDIF

ENDIF IF(SUBSIDY .GT. 4000.) THEN DMD = C(7) ENDIF

! scale depending on size of region (basically the demand equations were estimated for region 9) IF(RGN .EQ. 1) THEN DMD = DMD*0.26 ELSEIF(RGN .EQ. 2) THEN DMD = DMD*0.69 ELSEIF(RGN .EQ. 3) THEN DMD = DMD*0.76 ELSEIF(RGN .EQ. 4) THEN DMD = DMD*0.34 ELSEIF(RGN .EQ. 5) THEN DMD = DMD*1.24 ELSEIF(RGN .EQ. 6) THEN DMD = DMD*0.30 ELSEIF(RGN .EQ. 7) THEN DMD = DMD*0.70 ELSEIF(RGN .EQ. 8) THEN DMD = DMD*0.40 ELSEIF(RGN .EQ. 9) THEN DMD = DMD*1. ENDIF

NGTDM_CALCCNGDEMAND= DMD RETURN

END FUNCTION

! = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! ! PROCESSES NGTDM MODEL RESULTS TO GENERATE INFO FOR NEMS ! ! ! STATUS: COMPLETE ! ! CALLED BY: NGTDM ! ! CALLS: NGOUT_EMMPR ! NGOUT_SECPR ! NGOUT_SUPPLY ! NGOUT_OGIMPEXP ! NGOUT_PFUEL ! ! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

SUBROUTINE NGTDM_POST IMPLICIT NONE! THIS ROUTINE TRANSFERS VALUES FROM NGTDM ARRAYS TO NEMS ARRAYS

include 'parametr' include 'ncntrl' include 'ngpa rinc' include 'ngtdminc'

INTEGER*4 NSEC ! SECTOR ID COUNTER REAL*4 LP(NSUPSUB) ! LEASE AND PLANT !

-----------
! SET NG PRICES FOR ELECTRIC UTILITIES BY NGTDM/EMM REGIONS

CALL NGOUT_EMMPR

! END

- USE PRICES TO NEMS PROPER

CALL NGOUT_SECPR

! SUPPLY QTY TO OGSM AND PMM VARIABLES; LEASE & PLANT ! SET SCALE FACTOR FOR STEO YR L&P

CALL NGOUT_SUPPLY

IF (MODYR .GT. EHISYR) THEN CALL NGSTEO_BENCHLP ENDIF

! OUTPUT TO IMPO RT/EXPORT VALUES

CALL NGOUT_OGIMPEXP

! OUTPUT OTHER MISCELLANEOUS

CALL NGOUT_MISC

! PIPEFUEL ! SET SCALE FACTOR FOR STEO YR PFUEL

CALL NGOUT_PFUEL

IF (MODYR .GT. EHISYR) THEN CALL NGSTEO_BENCHPF ENDIF

! PHYSICAL PIPE AND STORAGE CAPACITY FOR FTAB REPORT

CALL NGOUT_PCAP

! PIPE CAPACITY ENTERING & EXITING NGTDM NODES 1

- 12

CALL NGFTAB_YRCAP
! SET SUPPLY CURVE PARAMETERS FOR EMM (W/SUP_MIN REPORT)CALL NGTDM_SUPTEST(NGUNIT)

RETUR N END ! = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! ! PUT RESULTING ELECTRIC UTILITY PRICES INTO APPROPRIATE ARRAYS: ! PGFELGR = FIRM ($87/MMBTU) ! PGIELGR = INTERRUPTIBLE ($87/MMBTU) ! PGCELGR = COMPETITIVE ($87/ MMBTU) ! ! STATUS: COMPLETE ! ! CALLED BY: ! ! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

SUBROUTINE NGOUT_EMMPR() IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngakinc' include 'ngitminc' include 'ogglobal'

INTEGER*4 J,NET ! COUNTERS INTEGER*4 SEC ! SECTOR ID !

----------------
! CONVERT FROM $/MCF TO $/MMBTU USING CFNGU

DO J=1,NNGEM

- 1 ! NGTDM/EMM S UBREGIONS oPGFELGR(J,CURIYR) = NGUPR_F(J) / oCFNGU(CURIYR) oPGIELGR(J,CURIYR) = NGUPR_I(J) / oCFNGU(CURIYR) oPGCELGR(J,CURIYR) = NGUPR_I(J) / oCFNGU(CURIYR) DO NET=1,NETWORK oSPGFELGR(J,CURIYR,NET) = NGUPR_SF(NET,J ) / oCFNGU(CURIYR) oSPGIELGR(J,CURIYR,NET) = NGUPR_SI(NET,J) / oCFNGU(CURIYR) ENDDO ENDDO

SEC=5 ! ALASKA UTIL oPGFELGR(NNGEM,CURIYR) = AKPR_F(SEC) / oCFNGU(CURIYR) oPGIELGR(NNGEM,CURIYR) = AKPR_I(SEC) / oCFNGU(CURIYR) oPGCELGR(NNGEM,CURIYR) = AKPR_I(SEC) / oCFNGU(CURIYR)

DO NET=1,NETWORK ! NO DISTINCTION ON SEASONAL FOR AK oSPGFELGR(NNGEM,CURIYR,NET) = AKPR_F(SEC) / oCFNGU(CURIY R) oSPGIELGR(NNGEM,CURIYR,NET) = AKPR_I(SEC) / oCFNGU(CURIYR) ENDDORETURN END ! = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! ! END

- USE SECTOR PRICE TO NEMS PROPER BY CENSUS REGIONS ($87/MMBTU) ! PGFEL PGIEL PGNEL ! PGFRS PGIRS PGNRS ! PGFCM PGICM PGNCM ! PGFIN PGIIN PGNIN ! PGFTR PGITR PGNTR ! PGFTRFV ! PGFTRPV ! ! STATUS: COMPLETE ! ! CALLED BY: ! ! = = = = = = = = = = = = = = = = = = = = = = = = = = = =
SUBROUTINE NGOUT_SECPR IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngtdminc' include 'ngitminc' include 'ngcdmdinc' include 'ngakinc' include 'ogglobal'

INTEGER*4 I,J,N ! REGION COUNTERS INTEGER*4 SEC ! END

- USE SECTOR ID INTEGER*4 TMPYR ! TEMPORARY PARAMETER FOR DEFINING LAST YEAR PARAMETER (TMPYR=IENDYR

- 2030+1)

REAL*4 ALLPQ(DSEC,MNUMC R

- 2) ! STORES P*Q VALUES FOR ALL MARKETS REAL*4 ALLQ(DSEC,MNUMCR

- 2) ! STORES Q TOTALS FOR ALL MARKETS REAL*4 TOTPQ(DSEC,MNUMCR

- 2) ! STORES P*Q VALUES FOR EACH MARKET REAL*4 TOTQ(DSEC,MNUMCR

- 2) ! STORES Q TOTALS FOR EACH MARKET REAL*4 FV_SHARE ! FLEET/PERSONAL VEHICLE SHARE REAL*4 AKQPV ! PERSONAL VEHICLE QTY IN ALASKA REAL*4 AKQFV ! FLEET VEHICLE QTY IN ALASKA REAL*4 PRC ! HOLDS AVERAGE PRICE (87$/ BCF)
REAL*4 DEFPR_SEC ! DEFAULT PRICE (87$/MMBTU) DATA DEFPR_SEC/3.5/ ! $87/MMBTU

! EMISSIONS REBATE ADJUSTMENT FOR WAXMAN MARKEY ONLY (INCLUDING INCLUDE(EMISSION)REAL*4 QTOT ! TOTAL QUANTITY GOING THROUGH

LDC REAL*4 REBATE ! EMISSIONS "REBATE" FOR UTILITY CUSTOMERS REAL*4 PER_LDC(DSEC

- 1,DNODES+1) ! AVERAGE PERCENT OF GAS GOING THROUGH LDC FOR PURCHASE BY SECTOR AND NGTDM REG REAL*4 PER_REB(IBASYR:IENDYR) ! PERCENT OF TOTAL REBATED ALLOWANCES TO NATURAL GAS DISTRIBUTORS DATA PER_REB /26*0.0,10*0.09,0.072,0.054,0.036,0.018,TMPYR*0.0/

DATA ((PER_LDC(I,J),J=1,DNODES+1),I=1,DSEC

- 1) /13*1 .0, &

0.690,0.861,0.741,0.807,0.885,0.866,0.761,0.838,0.923,0.751,0.816,0.660,0 .621, &

0.345,0.098,0.087,0.178,0.257,0.243,0.369,0.039,0.207,0.032,0.243,0.560,0 .737, 13*1.0 /

QTOT = 0.0 DO SEC=1,DSEC

- 1 QTOT = QTOT + ((AKQTY_F(SEC) + AKQTY_I(SEC)) * PER_LDC(SEC,DNODES+1))

DO J=1,DNODES QTOT = QTOT + ((BASQTY_F(SEC,J)+BASQTY_I(SEC,J)) * PER_LDC(SEC,J))

ENDDO ENDDO

! REBATE = oEMETAX(1,CURIYR) * 1000. * oEMLIM(1,CURIYR) * PER_REB(MOD YR) * (2./3.) / QTOT ! HR2454 REBATE = oEMETAX(1,CURIYR) * 1000. * oEMLIM(1,CURIYR) * PER_REB(MODYR) * (1.

- 0.2) / QTOT ! KGL

DO SEC=1,DSEC

- 1 IF (AKQTY_F(SEC).GT.0.0001) AKPR_F(SEC) = AKPR_F(SEC)

- & (REBATE * PER_LDC(SEC,J)*(AKQTY_F(SEC)+AKQTY_I(SEC))/AKQTY_F(SEC))

DO J=1,DNODES IF (BASQTY_F(SEC,J).GT.0.0001) NGPR_F(SEC,J) = NGPR_F(SEC,J)

- & (REBATE * PER_LDC(SEC,J)*(BASQTY_F(SEC, J)+BASQTY_I(SEC,J))/BASQTY_F(SEC,J))

ENDDO ENDDO

DO J=1,DNODES NGPR_TRFV_F(J) = NGPR_TRFV_F(J)

- (REBATE * PER_LDC(4,J)) NGPR_TRPV_F(J) = NGPR_TRPV_F(J)

- (REBATE * PER_LDC(4,J)) ENDDO

! END OF EMISSIONS REBATE ADJUSTMENT

!

---------------!

-- SET CORE END

- USE PRICES BY CENSUS DIVISION

! INITIALIZE P*Q AND Q TOTALS TO 0.0

DO SEC=1,DSEC DO I=1,MNUMCR

- 2 ! CENSUS DIV 1

- 9 ALLPQ(SEC,I) = 0.0 ALLQ(SEC,I) = 0.0 TOTPQ(SEC,I) = 0.0 TOTQ(SEC,I) = 0.0 ENDDO ENDDO

DO SEC=1,DSEC

- 1 ! NONUTIL SECTORS DO N=1,DNODES ! NGTDM DMD NODES 1

- 12 I=NG_CENMAP(N) ! CENSUS DIV 1

- 9 TOTPQ(S EC,I) = TOTPQ(SEC,I) + &

NGPR_F(SEC,N) * BASQTY_F(SEC,N) TOTQ(SEC,I) = TOTQ(SEC,I) + BASQTY_F(SEC,N) ENDDO TOTPQ(SEC,9) = TOTPQ(SEC,9) + AKPR_F(SEC) * AKQTY_F(SEC) TOTQ(SEC,9) = TOTQ(SEC,9) + AKQTY_F(SEC) ENDDO

SEC=5 ! UTILITY SECTOR DO J=1,NNGEM

- 1 ! NGTDM/EMM SUBREG N = EMMSUB_NG(J) ! NGTDM DMD NODES 1

- 12 I=NG_CENMAP(N) ! CENSUS DIV 1

- 9 TOTPQ(SEC,I) = TOTPQ(SEC,I) + &

NGUPR_F(J) * BASUQTY_F(J) TOTQ(SEC,I) = TOTQ(SEC,I) + BASUQTY_F(J) ENDDO TOTPQ(SEC,9) = TOTPQ(SEC,9) + AKPR_F(SEC) * AKQTY_F(SEC) TOTQ(SEC,9) = TOTQ(SEC,9) + AKQTY_F(SEC)

DO I=1,MNUMCR

- 2 DO SEC=1,DSEC IF (TOTQ(SEC,I) .GT. 0.) THEN PRC = TOTPQ(SEC,I) / TOTQ(SEC,I) IF (SEC .EQ. 1) oPGFRS(I,CURIYR) = PRC / oCFNGN(CURIYR) IF (SEC .EQ. 2) oPGFCM(I,CURIYR) = PRC / oCFNGN(CURIYR) IF (SEC .EQ. 3) oPGFIN(I,CURIYR) = PRC / oCFNGN(CURIYR) IF (SEC .EQ. 4) oPGFTR(I,CURIYR) = PRC / oCFNGN(CURIYR) IF (SEC .EQ. 5) oPGFEL(I,CURIYR) = PRC / oCFNGU(CURIYR) ELSE IF (SEC .EQ. 1) oPGFRS(I,CURIYR) = DEFPR_SEC IF (SEC .EQ. 2) oPGFCM(I,CURIYR) = DEFPR_SEC IF (SEC .EQ. 3) oPGFIN(I,CURIYR) = DEFPR_SEC IF (SEC .EQ. 4) oPGFTR(I,CURIYR) = DEFPR_SEC IF (SEC .EQ. 5) oPGFEL(I,CURIYR) = DEFPR_SEC ENDIF ENDDO ENDDO!

-- SET NON

- CORE END

- USE PRICES BY CENSUS DIVISION

! PUT CORE TOTALS INTO ALLPQ AND ALLQ, AND ! INITIALIZE P*Q AND Q TOTAL S TO 0.0

DO SEC=1,DSEC DO I=1,MNUMCR

- 2 ! CENSUS DIV 1

- 9 ALLPQ(SEC,I) = TOTPQ(SEC,I) ALLQ(SEC,I) = TOTQ(SEC,I) TOTPQ(SEC,I) = 0.0 TOTQ(SEC,I) = 0.0 ENDDO ENDDO

DO SEC=1 ,DSEC

- 1 ! NONUTIL SECTORS DO N=1,DNODES ! NGTDM DMD NODES 1

- 12 I=NG_CENMAP(N) ! CENSUS DIV 1

- 9 TOTPQ(SEC,I) = TOTPQ(SEC,I) + &

NGPR_I(SEC,N) * BASQTY_I(SEC,N) TOTQ(SEC,I) = TOTQ(SEC,I) + BASQTY_I(SEC,N) ENDDO TOTPQ(SEC,9) = TOTPQ(SEC,9) + AKPR_I(SEC) * AKQTY_I(SEC) TOTQ(SEC,9) = TOTQ(SEC,9) + AKQTY_I(SEC) ENDDO

SEC=5 ! UTILITY SECTOR DO J=1,NNGEM

- 1 ! NGTDM/EMM SUBREG N = EMMSUB_NG(J) ! NGTDM DMD NODES 1

- 12 I=NG_CENMAP(N) ! CENSUS DIV 1

- 9 TOTPQ(SEC,I) = TOTPQ(SEC,I) + &

NGUPR_I(J) * BASUQTY_I(J) TOTQ(SEC,I) = TOTQ(SEC,I) + BASUQTY_I(J) ENDDO TOTPQ(SEC,9) = TOTPQ(SEC,9) + AKPR_I(SEC) * AKQTY_I(SEC) TOTQ(SEC,9) = TOTQ(SEC,9) + AKQTY_I(SEC)

DO I=1,MNUMCR

- 2 DO SEC=1,DSEC IF (TOTQ(SEC,I) .GT. 0.) THEN PRC = TOTPQ(SEC,I) / TOTQ(SEC,I) IF (SEC .EQ. 1) oPGIRS(I,CURIYR) = PRC / oCFNGN(CURIYR) IF (SEC .EQ. 2) oPGICM(I,CURIYR) = PRC / oCFNGN(CURIYR) IF (SEC .EQ. 3) oPGIIN(I,CURIYR) = PRC / oCFNGN(CURIYR ) IF (SEC .EQ. 4) oPGITR(I,CURIYR) = PRC / oCFNGN(CURIYR) IF (SEC .EQ. 5) oPGIEL(I,CURIYR) = PRC / oCFNGU(CURIYR) ELSE IF (SEC .EQ. 1) oPGIRS(I,CURIYR) = DEFPR_SEC IF (SEC .EQ. 2) oPGICM (I,CURIYR) = DEFPR_SEC IF (SEC .EQ. 3) oPGIIN(I,CURIYR) = DEFPR_SEC IF (SEC .EQ. 4) oPGITR(I,CURIYR) = DEFPR_SEC IF (SEC .EQ. 5) oPGIEL(I,CURIYR) = DEFPR_SEC ENDIF ENDDO ENDDO!

-- SET TOTAL AVERAGE END

- USE PRICES BY CENSUS DIVISION

! ADD NON

- CORE TOTALS TO CORE TOTALS IN ALLPQ AND ALLQ

DO SEC=1,DSEC DO I=1,MNUMCR

- 2 ! CENSUS DIV 1

- 9 ALLPQ(SEC,I) = ALLPQ(SEC,I) + TOTPQ(SEC,I) ALLQ(SEC,I) = A LLQ(SEC,I) + TOTQ(SEC,I) ENDDO ENDDO

DO I=1,MNUMCR

- 2 DO SEC=1,DSEC IF (ALLQ(SEC,I) .GT. 0.) THEN PRC = ALLPQ(SEC,I) / ALLQ(SEC,I) IF (SEC .EQ. 1) oPNGRS(I,CURIYR) = PRC / oCFNGN(CURIYR) IF (SEC .EQ. 2) oPNGCM(I,CURIYR) = PRC / oCFNGN(CURIYR) IF (SEC .EQ. 3) oPNGIN(I,CURIYR) = PRC / oCFNGN(CURIYR) IF (SEC .EQ. 4) oPNGTR(I,CURIYR) = PRC / oCFNGN(CURIYR) IF (SEC .EQ. 5) oPNGEL(I,CURIYR ) = PRC / oCFNGU(CURIYR) ELSE IF (SEC .EQ. 1) oPNGRS(I,CURIYR) = DEFPR_SEC IF (SEC .EQ. 2) oPNGCM(I,CURIYR) = DEFPR_SEC IF (SEC .EQ. 3) oPNGIN(I,CURIYR) = DEFPR_SEC IF (SEC .EQ. 4) oPNGT R(I,CURIYR) = DEFPR_SEC IF (SEC .EQ. 5) oPNGEL(I,CURIYR) = DEFPR_SEC ENDIF ENDDO ENDDO

!

-- SET TRANSPORTATION FLEET AND PERSONAL VEHICLE PRICES

! INITIALIZE PRICES TO ZERO

DO I=1,MNUMCR

- 2 ! CENSUS DIV 1

- 9 oPGFTRFV(I,CURIYR) = 0.0 oPGFTRPV(I,CURIYR) = 0.0 ENDDO

! SET ALASKA QTY FOR FV & PV SEC=4 ! TRANS SECTOR I=9 ! ALASKA IN C ENSUS DIV 9 FV_SHARE = oQGFTRFV(9,CURIYR) / &

(oQGFTRFV(9,CURIYR) + oQGFTRPV(9,CURIYR)) AKQFV = AKQTY_F(4) * FV_SHARE AKQPV = AKQTY_F(4) * (1.

- FV_SHARE)

! FLEET VEHICLES DO I=1,MNUMCR

- 2 TOTQ(4,I) = 0.0 ENDDO DO N=1,DNODES ! W/O ALASKA IN CEN DIV 9 I = NG_CENMAP(N)TOTQ(4,I) = TOTQ(4,I) + BASQ_TRFV_F(N) oPGFTRFV(I,CURIYR) = oPGFTRFV(I,CURIYR) + & NG_CENSHR(SEC,N) * NGPR_TRFV_F(N) / oCFNGN(CURIYR) ENDDO ! W/ ALASKA IN CEN DIV 9 IF (TOTQ(4,9).GT.0.0000001) & oPGFTRFV(9,CURIYR) = (( (oCFNGN(CURIYR)*oPGFTRFV(9,CURIYR) * TOTQ(4,9)) + & (AKPR_F(SEC) * AKQFV) ) / & (TOTQ(4,9) + AKQFV) ) / oCFNGN(CURIYR)

! PERSONAL VEHICLES DO I=1,MNUMCR

- 2 TOTQ(4,I) = 0.0 ENDDO DO N=1,DNODES ! W/O ALASKA IN CEN DIV 9 I = NG_CENMAP(N) TOTQ(4,I) = TOTQ(4,I) + BASQ_TRPV_F(N) oPGFTRPV(I,CURIYR) = oPGFTRPV(I,CURIYR) + & NG_CENSHR(SEC,N) * NGPR_TRPV_F(N) / oCFNGN(CURIYR) ENDDO ! W/ ALASKA IN CEN DIV 9 IF (TOTQ(4,9).GT.0.0000001) & oPGFTRPV(9,CURIYR) = (( (oCFNGN (CURIYR)*oPGFTRPV(9,CURIYR) * TOTQ(4,9)) + & (AKPR_F(SEC) * AKQPV) ) / & (TOTQ(4,9) + AKQPV) ) / oCFNGN(CURIYR)

! FILL IN NATIONAL AVERAGE PRICES

oPGFTRPV(MNUMCR,CURIYR) = 0.0 oPGFTRFV(MNUMCR,CURIYR) = 0.0 oQGFTRPV(MNUMCR,CURIYR) = 0.0 oQGFTRFV(MNUMCR,CURIYR) = 0.0 DO I=1,MNUMCR

- 2 oPGFTRPV(MNUMCR,CURIYR) = oPGFTRPV(MNUMCR,CURIYR) + (oPGFTRPV(I,CURIYR) * oQGFTRPV(I,CURIYR))

oPGFTRFV(MNUMCR,CURIYR) = oPGFTRFV(MNUMCR,CURIYR) + (oPGFTRFV(I,CURIYR) * oQGFTRFV(I,CURIYR))

oQGFTRPV(MNUMCR,CURIYR) = oQGFTRPV(MNUMCR,CURIYR) + oQGFTRPV(I,CURIYR)

oQGFTRFV(MNUMCR,CURIYR) = oQGFTRFV(MNUMCR,CURIYR) + oQGFTRFV(I,CURI YR) ENDDO oPGFTRPV(MNUMCR,CURIYR) = oPGFTRPV(MNUMCR,CURIYR) / oQGFTRPV(MNUMCR,CURIYR) oPGFTRFV(MNUMCR,CURIYR) = oPGFTRFV(MNUMCR,CURIYR) / oQGFTRFV(MNUMCR,CURIYR)

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =!

! PROCESSES NGTDM SUPPLY RESULTS TO GENERATE PRODUCTION INFO ! OGPRDNG (ALASKA SET IN SUBROUTINE NGDMD_AK) ! OGPRDNGON ! OGPRDNGOF ! PRNG_PADD ! QLPIN ! OGWPRNG (ALASKA SET IN SUBROUTINE NGDMD_AK) ! OGPRSUP (TOTAL SUPPLEMENTAL) ! ! STATUS: COMPLETE ! ! CALLED BY: NGTDM_POST ! ! ! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

SUBROUTINE NGOUT_SUPPLY IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngtdminc' include 'ngitminc' include 'ngakinc' include 'ngcdmdinc' include 'nghistinc' include 'ngsteoinc' include 'ogglobal'

common /ogsmC1/ ogsmCflg INTEGER*4 ogsmC flg ! 1=use ogsmc, 0=do not use ogsmc

INTEGER*4 I,J,K,N,P,S,PADD ! COUNTERS

REAL*4 QNA_AD_LP(NSUPSUB+NOCSREG)! NA + AD + LP PLACEHOLDER by 20 subreg REAL*4 LPFAC ! % LEASE & PLANT FACTOR REAL*4 LPQTY ! HOLDS LEASE & PLANT REAL*4 PRNG_OKL ! APPROX NG PRODUCTION IN OKLAHOMA REAL*4 TOTPQ(MNUMOR) ! HOLDS P*Q FOR NA_AD_LP PRODUCTION REAL*4 TPQ ! HOLDS P*Q FOR NA_AD_LP L48 PROD REAL*4 LP1,LP2 ! MISC

REAL*4 DEFPR_SUP ! DEFAULT SUPPLY PR IF QTY=0 (87$/BCF) DATA DEFPR_SUP/1.5/ !

INTEGER*4 OG2PADD(6) ! DATA OG2PADD/1,3,2,2,4,5/ ! !

------------! INITIALIZE VARIABLES

DO I=1,NSUPREG+NOCSREG ! OGSM SUPPLY REGIONS 1

- 6,7

- 9 oOGPRDNG(I,CURIYR) = 0.0 ENDDO

DO I=1,MNUMCR

- 2 ! CENSUS DIVISIONS oQLP IN(I,CURIYR) = 0.0 ENDDO oQLPIN(MNUMCR,CURIYR) = 0.0

DO I=1,5 ! 5 PADD'S oPRNG_PADD(I,CURIYR) = 0.0 ENDDO

! DETERMINE: ONSHORE PRODUCTION (W/O ALASKA) ! OFFSHORE PRODUCTION (W/O ALASKA) ! TOTAL PRODUCTION (ALASKA FILLED IN NGDTM_AK SUBROUTINE) ! TOTAL PRODUCTION BY PADD (NA, AD, LP, ALASKA) ! LEASE AND PLANT QUANTITIES (W/ ALASKA)

DO S=1,NSUPSUB ! ONSHORE SUPPLY (1

- 17) N=SUPSUB_NG(S) ! NGTDM REGION 1

- 12 P=SUPSUB_OG(S) ! OGSM REGION 1

- 6 !!! LPFAC = (PCTLP(N) * SCALE_LP(MODYR)) / & !!! (1.

- (PCTLP(N)*SCALE_LP(MODYR))) !!!to prevent NaN fr 0/1

LP1 = (PCTLP(N) * SCALE_LP(MODYR)) LP2 = (1.

- (PCTLP(N)*SCALE_LP(MODYR))) IF (LP1.EQ.0.0) THEN LPFAC = 0.0 ELSE LPFAC = LP1/LP2
ENDIF

LPQTY = LPFAC * QSUP(S) oOGPRDNGON(S,CURIYR) = QSUP(S) + LPQTY QNA_AD_LP(S) = oOGPRDNGON(S,CURIYR) + oOGPRDADON(S,CURIYR) IF (S.EQ.12) QNA_AD_LP(S) = QNA_AD_LP(S) + oOGSHALENG(CURIYR) oOGPRDNG(P,CURIYR) = oOGPRDNG(P,CURIYR) + QNA_AD_LP(S) ! PADD LEVEL ONSHORE PR ODUC PADD = PMMMAP_NG(S) !pmm oPRNG_PADD(PADD,CURIYR) = oPRNG_PADD(PADD,CURIYR) + QNA_AD_LP(S) ! w/o L&P or gas shale oPRNG_PADD(PADD,CURIYR) = oPRNG_PADD(PADD,CURIYR) + QSUP(S) + & oOGPRDADON(S,CURIYR) ! ONSHORE L&P ONLY I=NG_CENMAP(N) ! if(modyr.eq.1990) then ! write(6,*) 'qlpin0',s,i,n,oqlpin(i,curiyr),lpqty ! write(6,*) 'qlpin2',lpfac,scale_lp(modyr),pctlp(n) ! write(6,*) 'qlpin3',oOGPRDADON(S,CURIYR),oOGSHALENG(CURIYR),oCFNGC(CURIYR) ! endifIF (S.EQ.12) THEN oQLPIN(I,CURIYR) = oQLPIN(I,CURIYR) + & oCFNGC(CURIYR) * (LPQTY + (P CTLP(N) * SCALE_LP(MODYR) * & (oOGPRDADON(S,CURIYR)+oOGSHALENG(CURIYR)) )) ELSE oQLPIN(I,CURIYR) = oQLPIN(I,CURIYR) + & oCFNGC(CURIYR) * (LPQTY + (PCTLP(N) * SCALE_LP(MODYR) * & oOGPRDADON(S,CURIYR))) ENDIF

! if(modyr.eq.1990) then ! write(6,*) 'qlpin1',s,i,n,oqlpin(i,curiyr),lpqty ! endif ENDDO

DO J=1,NOCSREG ! OFFSHORE SUPPLY (1

- 3) S=NSUPSUB + J ! SUPPLY (18

- 20) K=OCSMAP (J) ! ONSHORE SUPPLY (1

- 17) N=SUPSUB_NG(K) ! NGTDM REGION 1

- 12 P=NSUPREG + J ! OGSM REGION 7

- 9 LPFAC = (PCTLP(N) * SCALE_LP(MODYR)) / &

(1.

- (PCTLP(N)*SCALE_LP(MODYR))) L PQTY = LPFAC * QSUP(S) oOGPRDNGOF(J,CURIYR) = QSUP(S) + LPQTY QNA_AD_LP(S) = oOGPRDNGOF(J,CURIYR) + oOGPRDADOF(J,CURIYR) oOGPRDNG(P,CURIYR) = oOGPRDNG(P,CURIYR) + QNA_AD_LP(S) ! PADD LEVEL ON/OFF SHORE PRODUC PADD = PMMMAP_NG(K) !pmm oPRNG_PADD(PADD,CURIYR) = oPRNG_PADD(PADD,CURIYR) + QNA_AD_LP(S) ! w/o L&P oPRNG_PADD(PADD,CURIYR) = oPRNG_PADD (PADD,CURIYR) + QSUP(S) + & oOGPRDADOF(J,CURIYR) ! ADD OFFSHORE TO ONSHORE L&P I=NG_CENMAP(N) oQLPIN(I,CURIYR) = oQLPIN(I,CURIYR) + & oCFNGC(CURIYR) * (LPQTY + (P CTLP(N) * SCALE_LP(MODYR) * & oOGPRDADOF(J,CURIYR))) ENDDO ! ADD ALASKA L&P AND/OR QTY oQLPIN(9,CURIYR) = oQLPIN(9,CURIYR) + oCFNGC(CURIYR)*QALK_LAP ! w/o Alaska !pmm DO I=10,12 ! QTY INCLUDES L&P !pmm oPRNG_PADD(5,CURIYR) = oPRNG_PADD(5,CURIYR) + oOGPRDNG(I,CURIYR) !pmm ENDDO ! w/o L&P or gas shale, w/o CBM(3) DO J=1,6 ! OGSM L48 REGN PADD = OG2PADD(J) oPRNG_PADD(PADD,CURIYR) = oPRNG_PADD(PADD,CURIYR)

- oOGPRDUGR(J,3,CURIYR)

if (oPRNG_PADD(PADD,CURIYR).LT. 0.0) & WRITE(NGOERR,*) 'oPRNG_PADD error:', modyr,curitr,PAdd,oPRNG_PADD(PADD,CURIYR) ENDDO !! ! if (fcrl.eq.1) then!!! if(curiyr.gt.1) then

!!! write(6,*) ' ngCBM:',curiyr+1988,curitr,(oOGPRDCBM(J,CURIYR

1),J=1,6) !!! write(6,*) ' ngCBM:',curiyr+1989,curitr,(oOGPRDCBM(J,CURIYR),J=1,6) !!! endif !!! endif

DO I=1,9 oQLPIN(MNUMCR,CURIYR) = oQLPIN(MNUMCR,CURIYR) + & oQLPIN(I,CURIYR) ENDDO

! MOVE OKLAHOMA FROM PADD 3 TO PADD 2 ! ARIZONA SHOULD GO FROM PADD 3 TO PADD 5 AND ! NEVEDA SHOULD GO FROM PADD 4 TO PADD 5, BUT HIST ORICALLY ! THE QUANTITIES IN THESE TWO STATES ARE NEGLIGIBLE

!pmm ! should rmv L&P component of PRNG_OKL PRNG_OKL = oOGPRDNGON(10,CURIYR) * 0.85 oPRNG_PADD(2,CURIYR) = oPRNG_PADD(2,CURIYR) + PRNG_OKL oPRNG_P ADD(3,CURIYR) = oPRNG_PADD(3,CURIYR)

- PRNG_OKL

!

-- SET NATURAL GAS WELLHEAD PRICE (ALASKA DONE IN NGDMD_AK)

DO P=1,NSUPREG+NOCSREG ! OGSM REGION 1

- 9 TOTPQ(P) = 0.0 ENDDO TPQ = 0.0

DO S=1,NSUPSUB ! ONS HORE SUPPLY (1

- 17) P=SUPSUB_OG(S) ! OGSM REGION 1

- 6 TOTPQ(P) = TOTPQ(P) + QNA_AD_LP(S) * PSUP(S) TPQ = TPQ + QNA_AD_LP(S) * PSUP(S) ENDDO DO P=1,NSUPREG ! OGSM REGION 1

- 6 IF (oOGPRDNG(P,CURIYR) .GT. 0.) THEN oOGWPRNG(P,CURIYR) = TOTPQ(P) / oOGPRDNG(P,CURIYR) ELSE oOGWPRNG(P,CURIYR) = DEFPR_SUP ENDIF ENDDO

DO J=1,NOCSREG ! OFFSHORE SUPPLY (1

- 3) S=NSUPSUB + J ! SUPPLY (18

- 20) P=NSUPREG + J ! OGSM REGION 7

- 9 TOTPQ(P) = TOTPQ(P) + QNA_AD_LP(S) * PSUP(S) TPQ = TPQ + QNA_AD_LP(S) * PSUP(S) ENDDO DO P=NSUPREG+1,NSUPREG+NOCSREG ! O GSM REGION 7

- 9 IF (oOGPRDNG(P,CURIYR) .GT. 0.) THEN oOGWPRNG(P,CURIYR) = TOTPQ(P) / oOGPRDNG(P,CURIYR) ELSE ! oOGWPRNG(P,CURIYR) = DEFPR_SUPoOGWPRNG(P,CURIYR) = PSUP(18) ! IF NO ATL PROD, ASSIGN PROXY

PRICE ENDIF ENDDO

!

-- TOTAL WELLHEAD PRODUCTION FOR L48

oOGPRDNG(MNUMOR,CURIYR) = 0.0 ! TOTAL PROD: MNUMOR=13 DO P=1,NSUPREG+NOCSREG ! 1

- 9 oOGPRDNG(MNUMOR,CURIYR) = oOGPRDNG(MNUMOR,CURIYR) + & oOGPRDNG(P,CURIYR) ENDDO

!

-- SET AVERAGE WELLHEAD PRICE FOR L48 (W/O ALASKA)

IF (oOGPRDNG(MNUMOR,CURIYR) .GT. 0.0) THEN oOGWPRNG(MNUMOR,CURIYR) = TPQ / oOGPRDNG(MNUMOR,CURIYR) ELSE oOGW PRNG(MNUMOR,CURIYR) = DEFPR_SUP ENDIF

!

-- SET HENRY HUB PRICE BASED ON AVERAGE WELLHEAD PRICE

IF (MODYR.GT.STEOYRS(STEO_YEAR)) THEN ! oOGHHPRNG(CURIYR) =

- 0.115511 + (1.30406 * oOGWPRNG(MNUMOR,CURIYR)) ! don't use (bad data) ! oOGHHPRNG(CURIYR) = 1.00082 * (exp(0.115718) * oOGWPRNG(MNUMOR,CURIYR)**0.977713)

oOGHHPRNG(CURIYR) = 1.00439 * (exp(0.090246) * oOGWPRNG(MNUMOR,CURIYR)**1.00119) !revised 9

- 8

- 08 ETH ENDIF

!

-- AFTER CALC L48 AVG WELLHEAD PR, ADD ALASKA T O TOT PROD

DO P=10,12 ! MNUMOR = 13 oOGPRDNG(MNUMOR,CURIYR) = oOGPRDNG(MNUMOR,CURIYR) + & oOGPRDNG(P,CURIYR) ENDDO

!

-- SET TOTAL SUPPLEMENTAL (COALSNG, LIQSNG, OTHER)

oOGPRSUP(CURIYR) = 0.0 DO J=1,2 DO I=1,MNUMCR oOGSUPGAS(J,I,CURIYR) = 0.0 ENDDO ENDDO !yd1 CTG oOGSUPGAS(1,4,CURIYR) = SNGCOAL(MODYR) DO I=1,DNODES oOGPRSUP(CURIYR) = oOGPRSUP(CURIYR) + ZTOTSUP(I) oOGSUPGAS(2,NG_CENMAP(I),CURIYR) = oOGSUPGAS(2,NG_CENMAP(I),CURIYR) + SNGLIQ(I,MODYR) + SNGOTH(I,MODYR)oOGSUPGAS(1,NG_CENMAP(I),CURIYR) =

oOGSUPGAS(1,NG_CENMAP(I),CURIYR) + SNGCOAL(I ,MODYR) ENDDO oOGSUPGAS(1,11,CURIYR) = sum(oOGSUPGAS(1,1:9,CURIYR)) oOGSUPGAS(2,11,CURIYR) = sum(oOGSUPGAS(2,1:9,CURIYR))

!

-- DEFINE OGSM VARIABLES: OGCNQPRD, OGCNPPRD

IF (MODYR .LE. EHISYR) THEN PSUP(SNODES

- lSNODES

- 3) = HPSUP(SNODES

- lSNODES

- 3,MODYR) oOGCNPPRD(2,CURIYR) = HPSUP(SNODES

- lSNODES

- 3,MODYR) ! JUST USE PKNET HERE BECAUSE PK&OP HAVE SAME VALUE, NEED ANNUAL AVERAGE

oOGCNPPRD(1,CURIYR) = oOGCNPPRD(2,CURIYR) + ARC_VARTAR(PKNET,NODE_2ARC(TNODES

- LNGNODES,TNODES

- LNGNODES

- 1),MODYR) + &

ARC_FIXTAR(PKNET,NODE_2ARC(TNODES

- LNGNODES,TNODES

- LNGNODES

- 1),MODYR) ELSE oOGCNPPRD(2,CURIYR) = PSUP(SNODES

- lSNODES

- 3) oOGCNPPRD(1,CURIYR) = oOGCNPPRD(2,CURIYR) + ARC_VARTAR(PKNET,NODE_2ARC(TNODES

- LNGNODES,TNODES

- LNGNODES

- 1),MODYR) + &

ARC_FIXTAR(PKNET,NODE_2ARC(TNODES

- LNGNODES,TNODES

- LNGNOD ES

- 1),MODYR)

oOGCNQPRD(1,CURIYR) = oOGRESCAN(1,CURIYR) * oOGPRRCAN(1,CURIYR) ENDIF oOGCNQPRD(2,CURIYR) = QSUP(SNODES

- lSNODES

- 3)

!

-- DEFINE PROD & WPR FOR CN PROV IF (OGSMCFLG.EQ.1) THEN !

-- ogsm - c run w/ ngtdm CALL NGCAN_2OGSMC ENDIF

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! ! SET IMPORTS AND EXPORTS FOR OGSM VARIABLES ! OGQNGIMP

- CAN IMP AND TOTALS ONLY ! OGQNGEXP

- CAN & TOTALS ! OGPNGIMP

- ALL IMP AND TOTALS, EXCEPT HIST YRS ! ! STATUS: COMPLETED 5/15/97 ! ! CALLED BY NGTDM_POST ! ! NOTE: OGQNGEXP FOR CAN SET HERE ! OGQNGEXP FOR MEX, LNG, JAPAN FROM OGSM ! OGQNGIMP FOR MEX, LNG, JAPAN FROM OGSM ! OGPNGIMP FOR 1

- 14 SET IN HIST SUBROUTINE FOR HIST YRS ! ! = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =

SUBROUTINE NGOUT_OGIMPEXPIMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngtdminc' include 'ngitminc' include 'ngcdmdinc' include 'nghistinc' include 'ngakinc' include 'ogglobal' ! INTEGER*4 NODE ! L48 NODE ID INTEGER*4 IIMP ! IMPORT ID INTEGER*4 OGCAN ! OGSM BORDER CROSSING ID (1

- 6) INTEGER*4 SRC,DEST ! NODE IDS INTEGER*4 A ! ARC NUMBER INTEGER*4 I,J ! COUNTER INTEGER*4 NET ! PK/OP NETWORK ID

REAL*4 TOTPQ(30) ! TOTAL P*Q PLACEHOLDER REAL*4 TOTQ(30) ! TOTAL QTY PLACEHOLDER REAL*4 TFLOW ! ANNUAL FLOW PLACEHOLDER REAL*4 TMPFLOW ! ANNUAL FLOW PLACEHOLDER REAL*4 FLO_THRU_TMP ! FLOW_THRU PLACEHOLDER REAL*4 TMPIMP ! CN IMP PLACEH OLDER ALONG 16

- >4 REAL*4 IMPMIN ! MIN IMPORT ALONG 16

- >4 REAL*4 PR ! BORDER CROSSING PRICE PLACEHOLDER REAL*4 NODPR(DNODES) ! PLACEHOLDER FOR L48 AVG SUP PR REAL*4 CANFLO ! PLACEHOLDER FOR NETWORK CAN IMP REAL*4 LSHR(NLNGTER) ! SHARE OF LNG IMPORTS IN EACH OLD LNG REGION AS FRAC OF FLOWS REAL*4 PQ(NLNGTER) ! LNG P*Q PACEHOLDER ! EM4 TRACK

-- keep DATA IMPMIN/200./ ! MIN IMPORT ALONG 16

- >4 BCF

!

----------

! FILL OGQNGIMP FOR CANADIAN BORDER CROSSING NODES(1

- 6) FOR OGSM ! USING HISTORICAL AND FORECAST FLOW INFORMATION

! FILL OGPNGIMP FOR CANADA USING CANADIAN SUPPLY AND TARIFF

DO OGCAN=1,NCAN oOGQNGIMP(OGC AN,CURIYR) = 0.0 TOTPQ(OGCAN) = 0.0 TOTQ(OGCAN) = 0.0 ENDDO

DO IIMP=1,NXMAPCN ! LOOP OVER CANADIAN IMPORT ARCS TFLOW = 0.0 OGCAN = CAN_XMAPCN(IIMP,3) ! ID OGSM BORDER CROSSINGS SRC = CAN_XMAPCN(IIMP,2) DEST = CAN_XMAPCN(IIMP,1)A = NODE_2ARC(SRC,DEST) IF (A .GT. 0) THEN DO NET=1,NETWORK CANFLO = FLOW(NET,A) IF (DEST .EQ. 16) THEN ! SPLIT FLOW_THRU_IN IN TO PK/OP IF (NET .EQ. 1) THEN !rmv WRITE(NGOERR,*) 'ATTN TEMP OGIMPEXP: ',FLO_THRU_IN(MODYR) !rmv TMPFLOW = FLOW(1,A) + FLOW(2,A) TMPIMP = TMPFLOW

- FLO_THRU_IN(MODYR) IF (TMPIMP .LT. IMPMIN) THEN FLO_THRU_TMP = TMPFLOW

- IMPMIN IF (FLO_THRU_TMP .LT. 0.0) THEN WRITE(NGOERR,*) 'ATTN NGOUT_OGIMPEXP: ',FLO_THRU_IN(MODYR),TMPFLOW FLO_THRU_IN(MODYR) = 0.0 ELSE CANEXP(3,MODYR) = CANEXP(3,MODYR) + & ! flow

thru out adj (FLO_THRU_IN(MODYR)

- FLO_THRU_TMP) FLO_THRU_IN(MODYR) = FLO_THRU_TMP ENDIF ENDIF CANFLO = PKSHR_ICAN * FLO_THRU_IN(MODYR) ELSE CANFLO = (1.

- PKSHR_ICAN) * FLO_THRU_IN(MODYR) ENDIF CANFLO = FLOW(NET,A)

- CANFLO IF (CANFLO .LT. 0.) THEN WRITE(NGOERR,*) 'ATTN NGOUT_OGIMPEXP: ', & 'NODE 16 IMPORTS FOR NET= ', NET,' ARE (< 0) ', & CANFLO, TMPFLOW, FLO_THRU_IN(MODYR), TMPIMP ENDIF !rmv WRITE(NGOERR,*) 'ATTN TEMP OGIMPEXP: ', & !rmv !rmv CANFLO, TMPFLOW, FLO_THRU_IN(MODYR), TMPIMP !rmv ENDIF

TFLOW = TFLOW + CANFLO TOTPQ(OGCAN)= TOTPQ(OGCAN)+ NODE_ENDPR(NET,DEST)* CANFLO ENDDO ELSE IF (DEST .EQ. 15) THEN TFLOW = Q23TO3(MODYR) PR = PSUP(SNODES

- lSNODES

- 3) + T24TO15(MODYR) TOTPQ(OG CAN) = TOTPQ(OGCAN) + PR*TFLOW ELSE WRITE(NGOERR,*) 'ATTN NGOUT_OGIMPEXP: SRC,DEST,ARC= ', & SRC, DEST, A ENDIF ENDIF oOGQNGIMP(OGCAN,CURIYR) = oOGQNGIMP(OGCAN,CURIYR) + TFLOW TOTQ(OGCAN) = TOTQ(OGCAN) + TFLOW ENDDO! REDUCE IMPORTS BY SUPPLY FROM ANGTS (domestic production)

TFLOW = 0.0 ! HOLD TOTAL IMPORTS DO OGCAN=4,NCAN TFLOW = TFLOW + oOGQNGIMP(OGCAN,CURIYR) E NDDO

DO OGCAN=4,NCAN oOGQNGIMP(OGCAN,CURIYR) = oOGQNGIMP(OGCAN,CURIYR)

- & (QAK_ALB(MODYR) * oOGQNGIMP(OGCAN,CURIYR)/TFLOW) IF (oOGQNGIMP(OGCAN,CURIYR).LT.0.0) & WRITE(6,*) ' ATTN NGTDM: NEG QNGIMP

- AK ',OGCAN ENDDO

! PRICE AT CANADIAN BORDER CROSSING

IF (MODYR .GT. EHISYR) THEN ! HIST PR ALREADY FILLED DO OGCAN=1,NCAN IF (TOTQ(OGCAN) .GT. 0.0) THEN oOGPNGIMP(OGCAN,CURIYR) = TOTPQ(OGCAN) / TOTQ(OGCAN) ELSE oOGPNGIMP(OGCAN,CURIYR) = 1.5 ! ????????? ENDIF ENDDO ENDIF

! PRICE AT MEXICAN BORDER CROSSING AND LNG LOCATIONS ! EQUAL TO L48 SUPPLY PRICE

DO NODE=1,DNODES TOTPQ(NODE) = 0.0 TOT Q(NODE) = 0.0 ENDDO DO I=1,NSUPSUB ! 1

- 17 NODE = SUPSUB_NG(I) TOTPQ(NODE) = TOTPQ(NODE) + PSUP(I) * QSUP(I) TOTQ(NODE) = TOTQ(NODE) + QSUP(I) ENDDO DO NODE=1,DNODES IF (TOTQ(NODE) .GT. 0.0) THEN NODPR(NODE) = TOTPQ(NODE) / TOTQ(NODE) ELSE NODPR(NODE) = 1.5 ! ????????? ENDIF ENDDO

IF (MODYR .LE. EHISYR) THEN ! SET BENCH PR DO I=1,NMEX ! MEX BORDER CROSSING NODE = MEX_XMAP(I,1) IF (oOGQNGIMP(I+NCAN,CURIYR) .GT. 0.) THEN HMEX_BENCHP(I,MODYR)= oOGPNGIMP(I+NCAN,CURIYR)

- NODPR(NODE) ELSE HMEX_BENCHP(I,MODY R)= 0.0ENDIF ENDDO DO I=1,NLNGIMP HLNG_BENCHP(I,MODYR) =

- LNGTAR(I) ENDDO oPBAJA(CURIYR) = AVG_CGPR(12,MODYR)

- LNGTAR(NLNGTER)

ELSE IF (MODYR .GT. EHISYR) THEN

DO I=1,NMEX ! MEXICO BORDER CROSSING NODE = MEX_XMAP(I,1) oOGPNGIMP(I+NCAN,CURIYR) = NODPR(NODE) + MEX_BENCHP(I) ENDDO

DO I=1,NLNGIMP ! LNG LOCATIONS NODE = MAPLNG_NG(I) oOGPNGIMP(I+10,CURIYR) = AVG_CGPR(NODE,MODYR) + LNG_BENCHP(I) ENDDO ENDIF

! FILL OGQNGEXP FOR CANADIAN EXPORTS

DO J=1,NCAN oOGQNGEXP(J,CURIYR) = 0.0 ENDDO DO I=1,NXMAPUS J = CAN_XMAPUS(I,4) oOGQNGEXP(J,CURIYR) = oOGQNGEXP(J,CURIYR) + CANEXP(I,MODYR) ENDDO

! DETERMINE TOTAL IMPORTS FOR CANADA, MEXICO, AND LNG

DO I=MNUMBX

- 3,MNUMBX oOGQNGIMP(I,CURIYR) = 0.0 oOGQNGEXP(I,CURIYR) = 0.0 TOTPQ(I) = 0.0 TOTQ(I) = 0.0 END DO !

------- ! CANADA !

------- DO IIMP=1,NCAN oOGQNGIMP(MNUMBX

- 3,CURIYR) = oOGQNGIMP(MNUMBX

- 3,CURIYR) + & oOGQNGIMP(IIMP,CURIYR) oOGQNGEXP(MNUMBX

- 3,CURIYR) = oOGQNGEXP(MNUMBX

- 3,CURIYR) + & oOGQNGEXP(IIMP,CURIYR) TOTPQ(MNUMBX

- 3) = TOTPQ(MNUMBX

- 3) + oOGQNGIMP(IIMP,CURIYR) * & oOGPNGIMP(IIMP,CURIYR) ENDDO IF (oOGQNGIMP(MNUMBX

- 3,CURIYR) .GT. 0.0) THEN oOGPNGIMP(MNUMBX

- 3,CURIYR) = TOTPQ(MNUMBX

- 3) / oOGQNGIMP(MNUMBX

3,CURIYR) ELSE IF (CURIYR .GT. 1) THENoOGPNGIMP(MNUMBX

- 3,CURIYR) = oOGPNGIMP(MNUMBX

- 3,CURIYR

- 1) ELSE oOGPNGIMP(MNUMBX

- 3,CURIYR) = 1.5 ! ?????????? ENDIF ENDIF oOGQN GIMP(MNUMBX,CURIYR) = oOGQNGIMP(MNUMBX,CURIYR) + oOGQNGIMP(MNUMBX

- 3,CURIYR) oOGQNGEXP(MNUMBX,CURIYR) = oOGQNGEXP(MNUMBX,CURIYR) + oOGQNGEXP(MNUMBX

- 3,CURIYR) TOTPQ(MNUMBX) = TOTPQ(MNUMBX) + TOTPQ(MNUMBX

- 3) !

------- ! MEXICO !

------- DO I=1,NMEX IIMP = I + NCAN oOGQNGIMP(MNUMBX

- 2,CURIYR) = oOGQNGIMP(MNUMBX

- 2,CURIYR) + & oOGQNGIMP(IIMP,CURIYR) oOGQNGEXP(MNUMBX

- 2,CURIYR) = oOGQNGEXP(MNUMBX

- 2,CURIYR) + & oOGQNGEXP(IIMP,CURIYR) TOTPQ(MNUMBX

- 2 ) = TOTPQ(MNUMBX

- 2) + oOGQNGIMP(IIMP,CURIYR) * & oOGPNGIMP(IIMP,CURIYR) ENDDO IF (oOGQNGIMP(MNUMBX

- 2,CURIYR) .GT. 0.0) THEN oOGPNGIMP(MNUMBX

- 2,CURIYR) = TOTPQ(MNUMBX

- 2) / oOGQNGIMP(MNUMBX

2,CURIYR) ELSE IF (CURIYR .GT. 1) THEN oOGPNGIMP(MNUMBX

- 2,CURIYR) = oOGPNGIMP(MNUMBX

- 2,CURIYR

- 1) ELSE oOGPNGIMP(MNUMBX

- 2,CURIYR) = 1.5 ! ?????????? ENDIF ENDIF oOGQNGIMP(MNUMBX,CURIYR) = oOGQNGIMP(MNUMBX,CURIYR) + oOGQNGIMP(MNUMBX

- 2,CURIYR) oOGQNGEXP(MNUMBX,CURIYR) = oOGQNGEXP(MNUMBX,CURIYR) + oOGQNGEXP(MNUMBX

- 2,CURIYR) TOTPQ(MNUMBX) = TOTPQ(MNUMBX) + TOTPQ(MNUMBX

- 2)

!!!!!!!!!!!!!!variable LNG is assigned to OGQNGIMP and OGPNGIMP arrays

IF (.NOT.FIXLNGFLG) THEN DO I=1,NLNGTER A = NODE_2ARC(LNG_XMAP(I,2),LNG_XMAP(I,3)) IF (CURPCAP(A,MODYR) .GT. 0.00001) THEN LSHR(I)=LNGCAP(I,MODYR)/CURPCAP(A,MODYR) !YD1: DISTRIBUTE BASED ON LNG CAPACITY?

ELSE LSHR(I)= 0.0 ENDIF ENDDO PQ = 0.0 DO I=1,NLNGTER

- 3 DEST = LNG_XMAP(I,2)A = NODE_2ARC(LN G_XMAP(I,2),LNG_XMAP(I,3)) oOGQNGIMP(14+I,CURIYR) = 0.0 DO NET=1,NETWORK oOGQNGIMP(14+I,CURIYR) = oOGQNGIMP(14+I,CURIYR) + FLOW(NET,A)*LSHR(I)

PQ(I) = PQ(I) + NODE_ENDPR(NET,DEST)*FLOW(NET,A)*LSHR(I) ENDDO ENDDO DO I=1,NLNGTER

- 3 IF (oOGQNGIMP(14+I,CURIYR).GT.0.0) oOGPNGIMP(14+I,CURIYR) = PQ(I) / oOGQNGIMP(14+I,CURIYR) !CORRECT??

ENDDO A = NODE_2ARC(35,12) ! Baja to California IF (oQBAJA(C URIYR) .GT. 0.0) oPBAJA(CURIYR) = (NODE_ENDPR(PKNET,35)*FLOW(PKNET,A) + &
NODE_ENDPR(OPNET,35)*FLOW(OPNET,A)) /oQBAJA(CURIYR) !CORRECT??
ENDIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

!

- ------ ! LNG ! note: oOGQNGIMP(18,yr) represents NG PL imports from Bahamas (through FL); ! therefore, LNG total (MNUMBX

- 1) does NOT include oOGQNGIMP(18,yr); ! however, Total imports (MNUMBX) does include oOGQNGIMP(18,yr). ! Same appli es to oOGPNGIMP(18,yr) and oOGPNGIMP for MNUMBX & (MNUMBX

- 1) !

-------

oOGQNGIMP(MNUMBX

- 1,CURIYR) = oOGQNGIMP(MNUMBX

- 1,CURIYR) + & oOGQNGIMP(10,CURIYR) oOGQNGEXP(MNUMBX

- 1,CURIYR) = oOGQNGEXP(MNUMBX

- 1,CURIYR) + & oOGQNGEXP(10,CURI YR) DO I=1,NLNGIMP IIMP = I + 14 ! exclude FL because represents NG pipeline import from Bahamas (6

- 27

- 05)

IF (IIMP .NE. 18) THEN ! IF (IIMP .NE. 14) THEN

oOGQNGIMP(MNUMBX

- 1,CURIYR) = oOGQNGIMP(MNUMBX

- 1,CURIYR) + & oOGQNGIMP(IIMP,CURIYR) TOTPQ(MNUMBX

- 1) = TOTPQ(MNUMBX

- 1) + oOGQNGIMP(IIMP,CURIYR) * & oOGPNGIMP(IIMP,CURIYR) ENDIF oOGQNGEXP(MNUMBX

- 1,CURIYR) = oOGQNGEXP(MNUMBX

- 1,CURIYR) + & oOGQNGEXP(IIMP,CURIYR) ENDDO IF (oOGQNGIMP(MNUMBX

- 1,CURIYR) .GT. 0.0) THEN ! note: w/o PL imp fr Bahamas

oOGPNGIMP(MNUMBX

- 1,CURIYR) = TOTPQ(MNUMBX

- 1) / oOGQNGIMP(MNUMBX

1,CURIYR) ELSE IF (CURIYR .GT. 1) THENoOGPNGIMP(MNUMBX

- 1,CURIYR) = oOGPNGIMP(MNUMBX

- 1,CURIYR

- 1) ELSE oOGPNGIMP(MNUMBX

- 1,CURIYR) = 1.5 ! ?????????? ENDIF ENDIF oOGQNGIMP(MNUMBX,CURIYR) = oOGQNGIMP(MNUMBX,CURIYR) + oOGQNGIMP(MNUMBX

- 1,CURIY R) + & ! oOGQNGIMP(14,CURIYR) ! include PL imp fr Bahamas (FL) oOGQNGIMP(18,CURIYR) ! include PL imp fr Bahamas (FL) oOGQNGEXP(MNUMBX,CURIYR) = oOGQNGEXP(MNUMBX,CURIYR) + oOGQNG EXP(MNUMBX

- 1,CURIYR) TOTPQ(MNUMBX) = TOTPQ(MNUMBX) + TOTPQ(MNUMBX

- 1) + & ! oOGQNGIMP(14,CURIYR) * oOGPNGIMP(14,CURIYR) ! include PL imp fr Bahamas (FL)

oOGQNGIMP(18,CURIYR) * oOGPNGIMP(18,CURIYR) ! include PL imp fr Baham as (FL)

IF (oOGQNGIMP(MNUMBX,CURIYR) .GT. 0.) THEN oOGPNGIMP(MNUMBX,CURIYR) = TOTPQ(MNUMBX) / oOGQNGIMP(MNUMBX,CURIYR) ELSE IF (CURIYR .GT. 1) THEN oOGPNGIMP(MNUMBX,CURIYR) = oOGPNGIMP(MNUMBX,CURIYR

- 1) ELSE oOGPNGIMP(MNUMBX,CURIYR) = 1.5 ! ?????????? ENDIF ENDIF

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! ! SET OTHER MISCELLANEOUS OUTPUT VALUES ! != = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
SUBROUTINE NGOUT_MISC IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ogglobal' include 'ngparinc' include 'ngakinc' include 'ngtdminc' include 'ngcdmdinc' include 'ngitminc'

REAL*4 QTY ! PLACEHOLDER INTEGER*4 NET,REG,IYR ! INDICESoNGBAL(CURIYR) =

- AK_DISCR(MODYR) DO NET=1,NETWORK DO REG=1,DNODES oNGBAL(CURIYR) = oNGBAL(CURIYR) + DISCR(NET,REG,MODYR) ENDDO ENDDO

DO REG=1,NNGEM

- 1 oUDTAR(REG,CURIYR) = 0.0 QTY = 0.0 DO NET=1,NETWORK QTY = QTY + BASUQTY_SF(NET,REG) + BASUQTY_SI(NET,REG) oUDTAR(REG,CURIYR) = oUDTAR(REG,CURIYR) + & (BASUQTY_SF(NET,REG)*UDTAR_SF(NET,REG)) + & (BASUQTY_SI(NET,REG)*UDTAR_SI(NET,REG)) ENDDO oUDTAR(REG,CURIYR) = oUDTAR(REG,CURIYR) / QTY ENDDO

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! ! SET PIPE FUEL CONSUMPTION ! QGPTR (INCLUDING ALASKA) ! ! STATUS: COMPLETE ! ! CALLED BY NGTDM_POST ! ! = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
SUBROUTINE NGOUT_PFUEL IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngtdminc' include 'ngitminc' include 'ngakinc' include 'ogglobal'

INTEGER*4 CD ! CENSUS DIV ID INTEGER*4 N ! NODE ID INTEGER*4 NET ! NETWORK ID !

-----------

DO CD=1,MNUMCR

- 2 oQGPTR(CD,CURIYR) = 0.0 ENDDO oQGPTR(MNUMCR,CURIYR) = 0.0DO N=1,DNODES CD = NG_CENMAP(N) DO NET=1,NETWORK oQGPTR(CD,CURIYR) = oQGPTR(CD,CURIYR) + PFUEL(NET,N)*oCFNGC(CURIYR)

oQGPTR(MNUMCR,CURIYR) = oQGPTR(MNUMCR,CURIYR) + & PFUEL(NET,N)*oCFNGC(CURIYR) ENDDO ENDDO ! INCLUDE ALASKA oQGPTR(9,CURIYR) = oQGPTR(9,CURIYR) + QALK_PIP*oCFNGC(CURIYR) oQGPTR(MNUMCR,CURIYR) = oQGPTR(MNUMCR,CURIYR) + QALK_PIP*oCFNGC(CURIYR)

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! ! SET MISCELLANEOUS INFO FOR FTAB TABLES ! NGSTRCAP (STORAGE CAPACITY) ! NGPIPCAP (PIPE CAPACITY, 1

- interreg, 2

- interstate) ! ! STATUS: COMPLETE ! ! CALLED BY NGTDM_POST ! ! = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
SUBROUTINE NGOUT_PCAP IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngitminc' include 'ngptmitm' include 'ogglobal'

INTEGER*4 N ! COUNTERS INTEGER*4 STRID ! STORAGE ID 1

- 14 INTEGER*4 SKIP2STR ! SKIP PIPE & SUP NODES INTEGER*4 A ! ARC ID INTEGER*4 SRC, DEST ! NODE ID FOR NGTDM REG

!

------------

! INITIALIZE VARIABLES TO ZERO

DO N=1,2 oNGPIPCAP(N,CURIYR) = 0.0 ENDDODO N=1,24 oNGSTRCAP(N,CURIYR) = 0.0 ENDDO

! ************* ! PIPE CAPACITY ! PRIMARY ARCS ! ************* DO A=1,NARCS ! LOOP OVER ALL ARCS SRC = ARC_2NODE(A,1) DEST= ARC_2NODE(A,2)

IF (DEST .LE. 22) THEN ! exclude CAN arcs IF (SRC .LE. 22) THEN ! exclude CAN, sup, & str arcs oNGPIPCAP(1,CURIYR) = oNGPIPCAP(1,CURIYR) + ACTPCAP(A) ENDIF ENDIF ENDDO

! ************* ! PIPE CAPACITY ! SECONDARY ARCS ! ************* DO A=1,SARCS ! LOOP OVER ALL ARCS SRC = SARC_2NODE(A,1) DEST= SARC_2NODE(A,2)

IF (SRC .NE. DEST) THEN IF (DEST .LE. 22) THEN ! exclude CAN arcs IF (SRC .LE. 22) THEN ! exclude CAN, sup, & str arcs oNGPIPCAP(1,CURIYR)= oNGPIPCAP(1,CURIYR)+ SACTPCAP(A) ENDIF ENDIF ELSE oNGPIPCAP(2,CURIYR) = oNGPIPCAP(2,CURIYR) + SACTPCAP(A) ENDIF ENDDO oNGPIPCAP(2,CURIYR) = oNGPIPCAP(2,CURIYR) + oNGPIPCAP(1,CURIYR) ! WRITE(6,*) ' NGPIPCAP, YR=',CURIYR,(oNGPIPCAP(A,CURIYR),A=1,2)

! **************** ! STORAGE CAPACITY ! **************** DO A=1,NARCS SRC = ARC_2NODE(A,1) DEST = ARC_2NODE(A,2) SKIP2STR = TNODES+SNODES ! SKIP OVER PIPE & SUPPLY SRC IF (SRC .GT. SKIP2STR) THEN ! STORAGE ARCS STRID = SRC

- SKIP2STR + 1 IF (DEST .LE. DNODES) THEN ! TRACK STR AT NODES 1

- 12 ONLY oNGSTRCAP(DEST,CURIYR) = ACTPCAP(A) ENDIF ENDIF ENDDORETURN END

!******************************************************************C ! CALCULATES PHYSICAL CAPACITY, UTILIZATION, AND ADDITIONS ! ENTERING AND EXITING THE TWELEVE NGTDM REGIONS AND ! THE NINE CENSUS DIVISIONS FOR REPORTING IN FTAB. !

- C AP_NEN CAP_CEN !

- CAP_NEX CAP_CEX ! ! STATUS: COMPLETE ! ! CALLED BY: NGTDN_POST ! !******************************************************************C SUBROUTINE NGFTAB_YRCAP IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngtdminc' include 'ngitminc' include 'ngcdmdinc' include 'ogglobal'

INTEGER*4 N,I ! COUNTERS INTEGER*4 NET ! PK/OP NETWORK ID INTEGER*4 A ! ARC ID INTEGER*4 SRC, DEST ! NODE ID FOR NGTDM REG INTEGER*4 CSRC, CDEST ! NODE ID FOR CENSUS DIV INTEGER*4 C(DNODES) ! COUNTER

- ARCS ENTERING REG INTEGER*4 YR ! COUNTER INTEGER*4 JENDYR ! LAST YEAR VALUE CORRESPONDS TO IENDYR EXTERNAL RTOVALUE INTEGER RTOVALUE
REAL*4 FLO_NEN(14) ! FLOW ENTERING NGTDM REG REAL*4 FLO_NEX(14) ! FLOW EXITING NGT DM REG REAL*4 FLO_CEN(11) ! FLOW ENTERING CENSUS DIV REAL*4 FLO_CEX(11) ! FLOW EXITING CENSUS DIV

!

-----------

JENDYR = RTOVALUE('IJUMPCAL',2030)

! INITIALIZE VARIABLES TO ZERO DO N=1,14 FLO_NEN(N) = 0.0 FLO_NEX(N) = 0.0 DO I=1,3 oCAP_NEN(N,I,CURIYR) = 0.0 oCAP_NEX(N,I,CURIYR) = 0.0ENDDO ENDDO DO N=1,11 FLO_CEN(N) = 0.0 FLO_CEX(N) = 0.0 DO I=1,3 oCAP_CEN(N,I,CURIYR) = 0.0 oCAP_CEX(N,I,CURIYR) = 0.0 ENDDO ENDDO ! INITIALIZE FTAB VARIABLE TO ZERO

DO N=1,DNODES C(N) = 0 DO I=1,6 oNGFLOWS(N,I,CURIYR) = 0.0 oNGCAPS(N,I,CURIYR) = 0.0 ENDDO ENDDO

! ************* ! PIPE CAPACITY ! PRIMARY ARCS ! ************* DO A=1,NARCS SRC = ARC_2NODE(A,1) DEST= ARC_2NODE(A,2) IF (SRC .LE. 22) THEN ! L48 PIPE ARCS ONLY !

---------------- ! NGTDM REGIONS !

---------------- IF (DEST .LE. DNODES) THEN ! EXCLUDE EXPORT ARCS ! SET NGFLOWS, NGCAPS C(DEST) = C(DEST) + 1 oN GARCMP(DEST,C(DEST)) = SRC DO NET=1,NETWORK oNGFLOWS(DEST,C(DEST),CURIYR) = & oNGFLOWS(DEST,C(DEST),CURIYR) + FLOW(NET,A) ENDDO oNGCAPS(DEST,C(DEST),CURIYR) = & oNGCAPS(D EST,C(DEST),CURIYR) + ACTPCAP(A) ! SET CAP_NEX, CAP_NEN, ! SET FLO_NEX, FLO_NEN IF (SRC .LE. DNODES) THEN oCAP_NEX(SRC,1,CURIYR) = oCAP_NEX(SRC,1,CURIYR) + & ACTPCAP(A) oCAP_NEN(DEST,1,CURIYR)= oCAP_NEN(DEST,1,CURIYR) + & ACTPCAP(A) oCAP_NEX(13,1,CURIYR) = oCAP_NEX(13,1,CURIYR) + & ACTPCAP(A) oCAP_NEN(13,1,CURIYR) = oCAP_NEN(13,1,CURIYR) + & ACTPCAP(A) DO NET=1,NETWORK ! FLOWS USED TO CALC UTILZ FLO_NEX(SRC) = FLO_NEX(SRC) + FLOW(NET,A)FLO_NEX(13) = FLO_NEX(13) + FLOW(NET,A) FLO_NEN(DEST)= FLO_NEN(DEST)+ FLOW(NET,A) FLO_NEN(13) = FLO_NEN(13) + FLOW( NET,A) ENDDO ! IMPORT ARCS ELSE oCAP_NEN(DEST,1,CURIYR)= oCAP_NEN(DEST,1,CURIYR) + & ACTPCAP(A) oCAP_NEN(13,1,CURIYR) = oCA P_NEN(13,1,CURIYR) + & ACTPCAP(A) ! FILL IN TOTAL IMPORTS oCAP_NEN(14,1,CURIYR) = oCAP_NEN(14,1,CURIYR) + & ACTPCAP(A) DO NET=1,NETWORK FLO_NEN(DEST)= FLO_NEN(DEST)+ FLOW(NET,A) FLO_NEN(13) = FLO_NEN(13) + FLOW(NET,A) FLO_NEN(14) = FLO_NEN(14) + FLOW(NET,A) ENDDO ENDIF

ELSE ! EXPORT ARCS IF (SRC .LE. DNODES) THEN oCAP_NEX(SRC,1,CURIYR)= oCAP_NEX(SRC,1,CURIYR) + & ACTPCAP(A) oCAP_NEX(13,1,CURIYR) = oCAP_NEX(13,1,CURIYR) + & ACTPCAP(A) ! FILL IN TOTAL EXPORTS oCAP_NEX(14,1,CURIYR) = oCAP_NEX(14,1,CURIYR) + & ACTPCAP(A) DO NET=1,NETWORK FLO_NEX(SRC)= FLO_NEX(SRC)+ FLOW(NET,A) FLO_NEX(13) = FLO_NEX(13) + FLOW(NET,A) FLO_NEX(14) = FLO_NEX(14) + FLOW(NET,A) ENDDO ENDIF ENDIF

!

---------------- ! CENSUS DIVISIONS !

---------------- IF (SRC .LE. DNODES) THEN CSRC = NG_CENMAP(SRC) ELSE CSRC = SRC ENDIF

IF (DEST .LE. DNODES) THEN ! EXCLUDE EXPORT ARCS CDEST = NG_CENMAP(DEST) IF (CSRC .LE. DNODES) THEN IF (CSRC .NE. CDEST) THEN oCAP_CEX(CSRC,1,CURIYR) = oCAP_CEX(CSRC,1,CURIYR) + & ACTPCAP(A) oCAP_CEN(CDEST,1,CURIYR)= oCAP_CEN(CDEST,1,CURIYR) + & ACTPCAP(A)oCAP_CEX(10,1,CURIYR) = oCAP_CEX(10,1,CURIYR) + & ACTPCAP(A)

o CAP_CEN(10,1,CURIYR) = oCAP_CEN(10,1,CURIYR) + & ACTPCAP(A) DO NET=1,NETWORK ! FLOWS USED TO CALC UTILZ FLO_CEX(CSRC) = FLO_CEX(CSRC) + FLOW(NET,A) FLO_CEX( 10) = FLO_CEX(10) + FLOW(NET,A) FLO_CEN(CDEST)= FLO_CEN(CDEST)+ FLOW(NET,A) FLO_CEN(10) = FLO_CEN(10) + FLOW(NET,A) ENDDO ENDIF ! IMPORT ARCS ELSE oCAP_CEN(CDEST,1,CURIYR)= oCAP_CEN(CDEST,1,CURIYR) + & ACTPCAP(A) oCAP_CEN(10,1,CURIYR) = oCAP_CEN(10,1,CURIYR) + & ACTPCAP(A) ! FILL IN TOTAL IMPORTS oCAP_CEN(11,1,CURIYR) = oCAP_CEN(11,1,CURIYR) + & ACTPCAP(A) DO NET=1,NETWORK FLO_CEN(CDEST)= FLO_CEN(CDEST)+ FLOW(NET,A) FLO_CEN(10) = FLO_CEN(10) + FLOW(NET,A) FLO_CEN(11) = FLO_CEN(11) + FLOW(NET,A) ENDDO ENDIF

ELSE ! EXPORT ARCS IF (CSRC .LE. DNODES) THEN oCAP_CEX(CSRC,1,CURIYR)= oCAP_CEX(CSRC,1,CURIYR) + & ACTPCAP(A) oCAP_CEX(10,1,CURIYR) = oCAP_CEX(10,1,CURIYR) + & ACTPCAP(A) ! FILL IN TOTAL EXPORTS oCAP_CEX(11,1,CURIYR) = oCAP_CEX(11,1,CURIYR) + & ACTPCAP(A) DO NET=1,NETWORK FLO_CEX(CSRC)= FLO_CEX(CSRC)+ FLOW (NET,A) FLO_CEX(10) = FLO_CEX(10) + FLOW(NET,A) FLO_CEX(11) = FLO_CEX(11) + FLOW(NET,A) ENDDO ENDIF ENDIF ENDIF ENDDO

! *************** ! PIPE CAPACITY ! SECONDARY ARCS ! ** ************* DO A=1,SARCS SRC = SARC_2NODE(A,1) DEST= SARC_2NODE(A,2)IF (SRC .NE. DEST) THEN

IF (SRC .LE. 22) THEN ! L48 PIPE ARCS ONLY !

---------------- ! NGTDM REGIONS !

---------------- IF (DEST .LE. DNODES) THEN ! EXCLUDE EXPORT ARCS IF (SRC .LE. DNODES) THEN oCAP_NEX(SRC,1,CURIYR) = oCAP_NEX(SRC,1,CURIYR) + & SACTPCAP(A) oCAP_NEN(DEST,1,CURIYR)= oCAP_NEN(DEST,1,CURIYR) + & SACTPCAP(A) oCAP_NEX(13,1,CURIYR) = oCAP_NEX(13,1,CURIYR) + & SACTPCAP(A) oCA P_NEN(13,1,CURIYR) = oCAP_NEN(13,1,CURIYR) + & SACTPCAP(A) FLO_NEX(SRC) = FLO_NEX(SRC) + SAFLOW(A,MODYR) FLO_NEX(13) = FLO_NEX(13) + SAFLOW(A,MODYR) FLO_NEN(DEST)= FLO_N EN(DEST)+ SAFLOW(A,MODYR) FLO_NEN(13) = FLO_NEN(13) + SAFLOW(A,MODYR)

! IMPORT ARCS ELSE oCAP_NEN(DEST,1,CURIYR)= oCAP_NEN(DEST,1,CURIYR) + & SACTPCAP(A) oCAP_NEN(13,1,CURIYR) = oCAP_NEN(13,1,CURIYR) + & SACTPCAP(A) ! FILL IN TOTAL IMPORTS oCAP_NEN(14,1,CURIYR) = oCAP_NEN(14,1,CURIYR) + & SACTPCAP(A) FLO_NEN(DEST)= FLO_NEN(DEST)+ SAFLOW(A,MODYR) FLO_NEN(13) = FLO_NEN(13) + SAFLOW(A,MODYR) FLO_NEN(14) = FLO_NEN(14) + SAFLOW(A,MODYR) ENDIF

ELSE ! EXPORT ARCS IF (SRC .LE. DNODES) THEN oCAP_NEX(SRC,1,CURIYR)= oCAP_NEX(SRC,1,CURIYR) + & SACTPCAP(A) oCAP_NEX(13,1,CURIYR) = oCAP_NEX(13,1,CURIYR) + & SACTPCAP(A) ! FILL IN TOTAL EXPORTS oCAP_NEX(14,1,CURIYR ) = oCAP_NEX(14,1,CURIYR) + & SACTPCAP(A) FLO_NEX(SRC)= FLO_NEX(SRC)+ SAFLOW(A,MODYR) FLO_NEX(13) = FLO_NEX(13) + SAFLOW(A,MODYR) FLO_NEX(14) = FLO_NEX(14) + SAFLOW(A,MO DYR) ENDIF ENDIF

!

---------------- ! CENSUS DIVISIONS !

---------------- IF (SRC .LE. DNODES) THENCSRC = NG_CENMAP(SRC) ELSE CSRC = SRC ENDIF

IF (DEST .LE. DNODES) THEN ! EXCLUDE EXPORT ARCS CDEST = NG_CENMAP(DEST) IF (CSRC .LE. DNODES) THEN IF (CSRC .NE. CDEST) THEN oCAP_CEX(CSRC,1,CURIYR) = oCAP_CEX(CSRC,1,CURIYR) + & SACTPCAP(A) oCAP_CEN(CDEST,1,CURIYR)= oCAP_CEN(CDEST,1,CURIYR) + & SACTPCAP(A) oCAP_CEX(10,1,CURIYR) = oCAP_CEX(10,1,CURIYR) + & SACTPCAP(A) oCAP_CEN(10,1,CURIYR) = oCAP_CEN(10,1,CURIYR) + & SACTPCAP(A) FLO_CEX(CSRC) = FLO_CEX(CSRC) + SAFLOW(A,MODYR) FLO_CEX(10) = FLO_CEX(10) + SAFLOW(A,MODYR) FLO_CEN(CDEST)= FLO_CEN(CDEST)+ SAFLOW(A,MODYR) FLO_CEN(10) = FLO_CEN(10) + SAFLOW(A,MODYR) ENDIF ! IMPORT ARCS ELSE oCAP_CEN(CDEST,1,CURIYR)= oCAP_CEN(CDEST,1,CURIYR) + & SACTPCAP(A) oCAP_CEN(10,1,CURIYR ) = oCAP_CEN(10,1,CURIYR) + & SACTPCAP(A) ! FILL IN TOTAL IMPORTS oCAP_CEN(11,1,CURIYR) = oCAP_CEN(11,1,CURIYR) + & SACTPCA P(A) FLO_CEN(CDEST)= FLO_CEN(CDEST)+ SAFLOW(A,MODYR) FLO_CEN(10) = FLO_CEN(10) + SAFLOW(A,MODYR) FLO_CEN(11) = FLO_CEN(11) + SAFLOW(A,MODYR) ENDIF

ELSE ! EXPORT ARCS IF (CSRC .LE. DNODES) THEN oCAP_CEX(CSRC,1,CURIYR)= oCAP_CEX(CSRC,1,CURIYR) + & SACTPCAP(A) oCAP_CEX(10,1,CURIYR) = oCAP_CEX(10,1,CURIYR) + & SACTPCAP(A) ! FILL IN TOTAL EXPORTS oCAP_CEX(11,1,CURIYR) = oCAP_CEX(11,1,CURIYR) + & SACTPCAP (A) FLO_CEX(CSRC)= FLO_CEX(CSRC)+ SAFLOW(A,MODYR) FLO_CEX(10) = FLO_CEX(10) + SAFLOW(A,MODYR) FLO_CEX(11) = FLO_CEX(11) + SAFLOW(A,MODYR) ENDIF ENDIF ENDIF ENDIF ENDDO! ****************

! PIPE UTILIZATION ! **************** DO N=1,14 ! *** NGTDM REGION *** IF (oCAP_NEX(N,1,CURIYR) .GT. 0.0) THEN oCAP_NEX(N,2,CURIYR) = FLO_NEX(N) / oCAP_NEX(N,1,CURIYR)
ENDIF IF (oCAP_NEN(N,1,CURIYR) .GT. 0.0) THEN oCAP_NEN(N,2,CURIYR) = FLO_NEN(N) / oCAP_NEN(N,1,CURIYR)
ENDIF ENDDO

DO N=1,11 ! *** CENSUS DIVISION *** IF (oCAP_CEX(N,1,CURIYR) .GT. 0.0) THEN oCAP_CEX(N,2,CURIYR) = FLO_CEX(N) / oCAP_CEX(N,1,CURIYR)
ENDIF IF (oCAP_CEN(N,1,CURIYR) .GT. 0.0) THEN oCAP_CEN(N,2,CURIYR) = FLO_CEN(N) / oCAP_CEN(N,1,CURIYR)
ENDIF ENDDO

! **************** ! FLOWS ! **************** DO N=1,14 ! *** NGTDM REGION *** oCAP_NEX(N,3,CURIYR) = FLO_NEX(N) oCAP_NEN(N,3,CURIYR) = FLO_NEN(N) ENDDO DO N=1,11 ! *** CENSUS DIVISION *** oCAP_CEX(N,3,CURIYR) = FLO_CEX (N) oCAP_CEN(N,3,CURIYR) = FLO_CEN(N) ENDDO

! **************** ! NGTDMOUT: ! CITYGATE PRICES ! END

- USE DEMANDS ! ****************

IF ((CURIYR.EQ.LASTYR).AND.(NGDBGITR(1,4))) THEN WRITE(NGUNIT,*) WRITE(NGUNIT,52) (N,N=1,DNODES) WRITE(NGUNIT,*) 'CITYGATE PRICES (87$/MCF)' DO YR=IBASYR,JENDYR WRITE(NGUNIT,200) YR,(NGCGPR(N,YR

- IBASYR+1),N=1,DNODES+3) ENDDO

WRITE(NGUNIT,*) WRITE(NGUNIT,52) (N,N=1,DNODE S) WRITE(NGUNIT,*) 'END

- USE DMD (BCF) ' DO YR=IBASYR,JENDYR WRITE(NGUNIT,220) YR,(NGENDDMD(N,YR

- IBASYR+1),N=1,DNODES+3) ENDDOWRITE(NGUNIT,*) WRITE(NGUNIT,52) (N,N=1,DNODES) WRITE(NGUNIT,*) 'NET NODE DMD (BCF) ' DO YR=IBASYR,JENDYR WRITE(NGUNIT,210) YR,(NGNODDMD(N,YR

- IBASYR+1),N=1,DNODES+3) ENDDO ENDIF

! IF ((CURIYR.EQ.LASTYR).AND.(NGDBGITR(1,4))) THEN ! WRITE(NGUNIT,*) ! WRITE(NGUNIT,52) (YR,YR=IBASYR,JENDYR) ! WRITE(NGUNIT,*) 'CITYGATE PRICES (87$/MCF)' ! DO N=1,MNUMCR

- 2 ! WRITE(NGUNIT,200) N,(NGCGPR(N,YR),YR=1,IJUMPYR) ! ENDDO ! WRITE(NGUNIT,*) 'NET NODE DMD (BCF) ' ! DO N=1,MNUMCR

- 2 ! WRITE(NGUNIT,210) N,(NGNODDMD(N,YR),YR=1,IJUMPYR) ! ENDDO ! WRITE(NGUNIT,*) 'END

- USE DMD (BCF) ' ! DO N=1,MNUMCR

- 2 ! WRITE(NGUNIT,220) N,(NGENDDMD(N,YR),YR=1,IJUMPYR) ! ENDDO ! ENDIF

! TMPINC: TEMP WRITES IF (( CURIYR.EQ.LASTYR).AND.(NGDBGITR(1,5))) THEN DO N=1,DNODES C(N) = 0.0 DO I=1,6 IF (oNGARCMP(N,I).GT.0) THEN C(N) = C(N) + 1 ENDIF ENDDO ENDDO

WRITE(NGUNIT,*) WRITE(NGUNIT,* ) 'NG FLOWS ON ARCS ENTERING L48 REG 1

- 12 (BCF)' WRITE(NGUNIT,50) (YR,YR=IBASYR,JENDYR) DO N=1,DNODES WRITE(NGUNIT,*) ' entering ',N DO I=1,C(N) WRITE(NGUNIT,100) oNGARCMP(N,I), (oNGFLOWS(N,I,YR),YR=1,IJUMPYR) ENDDO ENDDO WRITE(NGUNIT,*) WRITE(NGUNIT,*) 'NG CAPS ON ARCS ENTERING L48 REG 1

- 12 (BCF)' WRITE(NGUNIT,51) (YR,YR=IBASYR,JENDYR) DO N=1,DNODES WRITE(NGUNIT,*) ' entering ',N DO I=1,C(N) WR ITE(NGUNIT,110) oNGARCMP(N,I), (oNGCAPS(N,I,YR),YR=1,IJUMPYR)ENDDO ENDDO ENDIF

50 FORMAT(1X,' YEAR ', <IJUMPYR>I7) 100 FORMAT(1X,' from ',I2,<IJUMPYR>F7.1) 51 FORMAT(1X,' YEAR ', <IJUMPYR>I7) 110 FORMA T(1X,' from ',I2,<IJUMPYR>F7.1) 52 FORMAT(1X,' NGTDM REG ', 12(' N',I2), &

' CD 5',' CD 8',' CD 9') 200 FORMAT(1X,' ',I4,3X,<IJUMPYR>F7.3) 210 FORMAT(1X,' ',I4,3X,<IJUMPYR>F7.0) 220 FORMAT(1X,' ',I4,3X,<IJUMPYR>F7.0)

RETURN END

!================================================================== ! ! SETS STEO SCALE FACTOR FOR LEASE & PLANT (L&P) ! ! ! ! CALLED BY: NGTDM_POST ! ! NOTES: ONLY CALLED AFTER LHISYR ! (L&P ALREADY BENCHMARKED IN HISTORICAL YEARS) ! !==================================================================

SUBROUTINE NGSTEO_BENCHLP IMPLICIT NONE

include 'parametr' include 'ncnt rl' include 'ngparinc' include 'ngtdminc' include 'ngitminc' include 'nghistinc' include 'ngsteoinc' include 'ngakinc' include 'ogglobal'

INTEGER*4 I,J INTEGER*4 PHASYR ! PHASEOUT YEAR NUMBER (1ST, 2ND, ETC) INTEGER*4 TOTPHAS ! TOTAL NUMBER OF PHASEOUT YEARS INTEGER*4 LOOPYR ! YEARS TO WRITE OUT SCALE INFO
REAL*4 DEL_SCALE ! DELTA BETWN STEO & LHISYR SCALING FACTOR REAL*4 LPLT_SCALE ! SCALE FACTOR FOR L&PREAL*4 TOTLP

!

-----------
! SET SCALE_LP IF BENCHMARKING L&P TO STEO

IF (MODYR .LE. BMYEAR) THEN IF (STINPUT_SCAL .EQ. 0) THEN TOTL P = (oQLPIN(MNUMCR,CURIYR) / oCFNGC(CURIYR))

- QALK_LAP ! BCF LPLT_SCALE = (STQLPIN(CURIYR)

- QALK_LAP) / TOTLP

SCALE_LP(MODYR) = SCALE_LP(MODYR) * LPLT_SCALE ELSE SCALE_LP(MODYR) = STSCAL_LPLT(MODYR) END IF if(modyr.eq.1990) write(6,*) 'qlpin3',bmyear,scale_lp(modyr),totlp

! PHASE OUT STEO BENCHMARKING SCALE IF BENCHMARKING L&P TO STEO

ELSE IF (( MODYR .LE. STPHAS_YR) .AND. &

( BMYEAR .GT. LHISYR)) THEN PHASYR = MODYR

- BMYEAR TOTPHAS = STPHAS_YR

- BMYEAR DEL_SCALE = SCALE_LP(BMYEAR)

- SCALE_LP(STPHAS_YR) SCALE_LP(MODYR) = SCALE_LP(BMYEAR)

- & PHASYR * (DEL_SCALE / TOTPHAS)

! SET STEO BENCHMARKING SCALE TO T

- 1 LEVEL FOR L&P

if(modyr.eq.1990) write(6,*) 'qlpin4',bmyear,scale_lp(modyr),totlp ELSE IF (MODYR .GT. EHISYR) THEN SCALE_LP(MODYR) = SCALE_LP(MODYR

- 1) if(modyr.eq.1990) write(6,*) 'qlpin5',bmyear,scale_lp(modyr),totlp ENDIF

IF (STPHAS_YR .GT. BMYEAR) THEN LOOPYR = STPHAS_YR ELSE LOOPYR = BMYEAR ENDIF

IF ((MODYR .EQ. LOOPYR) .AND. (FCRL .EQ. 1)) THEN WRITE(NGOBENCH,*) ' LEASE & PLANT NATIONAL SCALING FACTORS' WR ITE(NGOBENCH,10) (I,I=IBASYR,LOOPYR) WRITE(NGOBENCH,11) (SCALE_LP(I),I=IBASYR,LOOPYR) DO J=1,DNODES WRITE(NGOBENCH,12) J,(HPCTLP(J,I),I=IBASYR,EHISYR), & (PCTLP(J)*SCALE_LP(I),I=EHISYR+1,LOOPYR) ENDDO ENDI F 10 FORMAT(9X,'REG',<IJUMPYR>(4X,I4))11 FORMAT(1X,'SCALE_LP: ',<IJUMPYR>F8.4)

12 FORMAT(1X,'PCTLPX: ',I3,<IJUMPYR>F8.4)

RETURN END

!================================================================== ! ! SETS STEO SCALE FACTOR FOR PIPE FUEL (PFUEL) ! ! ! ! CALLED BY: NGTDM_POST ! ! NOTES: ONLY CALLED AFTER LHISYR ! (PIPE FUEL ALREADY BENCHMARKED IN HISTORICAL YEARS) ! !==================================================================

SUBROUTINE NGSTEO_BENCHPF IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngtdminc' include 'ngitminc' include 'nghistinc' include 'ngsteoinc' include 'ngakinc' include 'ogglobal'

INTEGER*4 I,J INTEGER*4 PHASYR ! PHASEOUT YEAR NUMBER (1ST, 2ND, ETC) INTEGER*4 TOTPHAS ! TOTAL NUMBER OF PHASEOUT YEARS INTEGER*4 LOOPYR ! YEARS TO WRITE OUT SCALE INFO INTEGER*4 NET ! PK/OP ID

REAL*4 DEL_SCALE ! DELTA BETWN STEO & LHISYR SCALING FACTOR REAL*4 PFUEL_SCALE ! SCALE FACTOR FOR PFUEL REAL*4 TOTPF

!

-----------
! SET SCALE_PF IF BENCHMARKING PIPE FUEL TO STEO

IF (MODYR .LE. BMYEAR) THEN IF (STINPUT_SCAL .EQ. 0) THEN TOTPF = (oQGPTR(MNUMCR,CURIYR) / oCFNGC(CURIYR))

- QALK_ PIP ! BCFPFUEL_SCALE = (STQGPTR(CURIYR)

- QALK_PIP) / TOTPF SCALE_PF(MODYR) = SCALE_PF(MODYR) * PFUEL_SCALE ELSE SCALE_PF(MODYR) = STSCAL_PFUEL(MODYR) ENDIF

! PHASE OUT STEO BENCHMARKING SCALE IF BENCHM ARKING L&P TO STEO

ELSE IF (( MODYR .LE. STPHAS_YR) .AND. &

( BMYEAR .GT. LHISYR)) THEN PHASYR = MODYR

- BMYEAR TOTPHAS = STPHAS_YR

- BMYEAR DEL_SCALE = SCALE_PF(BMYEAR)

- SCALE_PF(STPHAS_YR) SCALE_PF(MODYR) = SCALE_PF(BMYEAR)

- & PHASYR * (DEL_SCALE / TOTPHAS)

! SET STEO BENCHMARKING SCALE TO T

- 1 LEVEL FOR PFUEL

ELSE IF (MODYR .GT. EHISYR) THEN SCALE_PF(MODYR) = SCALE_PF(MODYR

- 1) ENDIF

IF (STPHAS _YR .GT. BMYEAR) THEN LOOPYR = STPHAS_YR ELSE LOOPYR = BMYEAR ENDIF

IF ((MODYR .EQ. LOOPYR) .AND. (FCRL .EQ. 1)) THEN WRITE(NGOBENCH,*) ' PIPE FUEL NATIONAL SCALING FACTORS' WRITE(NGOBENCH,10) (I,I=IBASYR,LOOPYR) WRITE(NGOBENCH,11) (SCALE_PF(I),I=IBASYR,LOOPYR) DO NET=1,NETWORK WRITE(NGOBENCH,*) ' NETWORK = ',NET DO J=1,DNODES WRITE(NGOBENCH,12) J,(HPFUEL_FAC(NET,J,I),I= IBASYR,EHISYR), & (PFUEL_FAC(NET,J)*SCALE_PF(I),I=EHISYR+1,LOOPYR) ENDDO ENDDO WRITE(NGOBENCH,*) ENDIF 10 FORMAT(9X,'REG',<IJUMPYR>(4X,I4)) 11 FORMAT(1X,'SCALE_PF: ',<IJUMPYR>F8.4) 12 FORMAT(1X,'PFUELX: ',I3,<IJUMPYR>F8.4)

RETURN END

!================================================================== ! ! SETS STEO SCALE FACTOR FOR L48 AND OFFSHORE WELLHEAD PRICE ! ! !! CALLED BY: NGCHK_CONVNG

! ! NOTES: ONLY CALLED WHEN MODYR > LHISYR ! (L48 & OFFSHORE WELLHEAD PR ALREADY BENCHMARKED IN HISTORICAL YEARS) ! !==================================================================

SUBROUTINE NGSTEO_BENCHWPR IMPLICIT NONE

includ e 'parametr' include 'ncntrl' include 'ngparinc' include 'ngtdminc' include 'ngitminc' include 'nghistinc' include 'ngsteoinc' include 'ogglobal'

INTEGER*4 I,J,S INTEGER*4 PHASYR ! PHASEOUT YEAR NUMBER (1ST, 2ND, ETC) INTEGER*4 TOTPHAS ! TOTAL NUMBER OF PHASEOUT YEARS INTEGER*4 LOOPYR ! YEARS TO WRITE OUT SCALE INFO INTEGER*4 NET ! PK/OP ID INTEGER*4 JENDYR ! LAST YEAR VALUE CORRESPONDS TO IENDYR EXTERNAL RTOVALUE INTEGER RTOVALUE

REAL*4 NGPRCFAC(IBASYR:IENDYR) ! FACTOR FOR ADJUSTING "EXPECTED" PRICE REAL*4 OG_GROWTH ! FACTOR FOR ADJUSTING "EXPECTED" PRICE REAL*4 DEL_SCALE ! DELTA BETWN STEO & LHISYR SCALING FACTOR REAL*4 TOTPF REAL*4 SCALE_CAN(IBASYR:IENDYR) ! STEO DIFFERENTIAL S CALE FOR CAN WPR

LOGICAL FIRST DATA FIRST/.TRUE./

!

-----------------

JENDYR = RTOVALUE('IJUMPCAL',2030)

! INTIALIZE

IF (FIRST) THEN SCALE_CAN = 1.0 FIRST = .FALSE.ENDIF

! FOR STEO YEAR, SET SCALE_WPR AS RATIO OF ACTUAL TO MODEL WELLHEAD PR ! THEREFORE, NEED TO USE NGOUT_SUPPLY TO CALC AVERAGE WELLHEAD PR

CALL NGOUT_SUPPLY

IF (MODYR .LE. BMYEAR) THEN IF (STINPUT_SCAL .EQ. 0) THEN SCALE_WPR(MODYR) = & (STOGWPRNG(CURIYR) / oOGWPRNG(MNUMOR,CURIYR)) ! w/o Alaska ELSE

SCALE_WPR(MODYR) = STSCAL_WPR(MODYR) ENDIF ENDIF

! PHASE

- OUT STEO SCALE FACTOR FOR WELLHEAD PRICE

IF ((MODYR .EQ. BMYEAR) .AND. (FCRL .EQ. 1)) THEN IF (WPR4CAST_FLG .EQ. 'YES') THEN DO I=BMYEAR+1,JENDYR IF (( I .LE. STPHAS_YR) .AND. & ( BMYEAR .GT. LHISYR)) THEN

PHASYR = I

- BMYEAR TOTPHAS = STPHAS_YR

- BMYEAR DEL _SCALE = SCALE_WPR(BMYEAR)

- SCALE_WPR(STPHAS_YR) SCALE_WPR(I) = SCALE_WPR(BMYEAR)

- & PHASYR * (DEL_SCALE / TOTPHAS) ELSE SCALE_WPR(I) = SCALE_WPR(I

- 1) ENDIF ENDDO

! ELSE ! DO I=BMYEAR+1,JENDYR ! NGPRCFAC(I) = oOGGROWFAC(I

- BASEYR+1)**4 ! WRITE(NGUNIT,*) 'ngprcfac',I,oOGPRCEXP(I

BASEYR+1),NGPRCFAC(I),oOGPRCEXP(I

- BASEYR+1)*NGPRCFAC(I) ! SCALE_WPR(I) = SCALE_WPR(LHISYR) * oOGPRCEXP(I

- BASEYR+1) * NGPRCFAC(I) ! assume high prices in STEO yrs ! will not be assumed to continue ! so lower expect price for sev yrs after ! ENDDO

ENDIF ENDIF

IF (STPHAS_YR .GT. BMYEAR) THEN LOOPYR = STPHAS_YRELSE LOOPYR = BMYEAR ENDIF

IF ((MODYR .EQ. LOOPYR) .AND. (FCRL .EQ. 1)) THEN WRITE(NGOBENCH,*) ' WELLHEAD PRICE NATIONAL SCALING FACTORS' WRITE(NGOBENCH,10) (I,I=IBASYR,LOOPYR) WRITE(NGOBENCH,11) (SCALE_WPR(I),I=IBASYR,LOOPYR) WRITE(NGOBENCH,*) ENDIF

10 FORMAT(9X,'REG',<IJUMPYR> (4X,I4)) 11 FORMAT(1X,'SCALE_WPR: ',<IJUMPYR>F8.4)

! USE SCALE FACTOR TO ADJUST REGIONAL WELLHEAD PRICES

!CC SCALE_WPR(MODYR) = 1.0

DO S=1,uSNODES ! L48 & OFFSHORE ONLY (NOT CANADA) IF (SUPARRAY(S).EQ.1) THEN PSUP(S) = P SUP(S) * SCALE_WPR(MODYR) DO NET=1,NETWORK NODE_PSUP(NET,S) = NODE_PSUP(NET,S) * SCALE_WPR(MODYR) ENDDO ENDIF ENDDO

! ADJUST FOR CANADA

IF (MODYR.GE.STEOYRS(1) .AND. MODYR.LE.STEOYRS(STEO_YEAR)) THEN S CALE_CAN(MODYR) = STSCAL_CAN(MODYR

- STEOYRS(1)+1) ENDIF

IF ((MODYR .EQ. BMYEAR) .AND. (FCRL .EQ. 1)) THEN DO I=BMYEAR+1,JENDYR IF (( I .LE. STPHAS_YR) .AND. & ( BMYEAR .GT. LHISYR)) THEN

PHASYR = I

- BMYEAR TOTPHAS = STPHAS_YR

- BMYEAR DEL_SCALE = SCALE_CAN(BMYEAR)

- SCALE_CAN(STPHAS_YR) SCALE_CAN(I) = SCALE_CAN(BMYEAR)

- & PHASYR * (DEL_SCALE / TOTPHAS) ELSE SCALE_CAN(I) = SCALE_CAN(I

- 1) ENDIF ENDDO ENDIF

! APPLY STEO PRICE FACTORS

DO S = uSNODES+1,SNODES

- lSNODES

- 3 IF (SUPARRAY(S) .EQ. 1) THEN PSUP(S) = PSUP(S) * SCALE_WPR(MODYR) * SCALE_CAN(MODYR)DO NET=1,NETWORK NODE_PSUP(NET,S) = NODE_PSUP(NET,S) * SCALE_WPR(MODYR) * SCALE_CAN(MODYR)

ENDDO ENDIF ENDDO
!yd PSUP(SNODES) = PSUP(SNODES) * SCALE_WPR(MODYR) * SCALE_CAN(MODYR) !yd D O NET=1,NETWORK !yd NODE_PSUP(NET,SNODES) = NODE_PSUP(NET,SNODES) * SCALE_WPR(MODYR) * SCALE_CAN(MODYR) !yd ENDDO

RETURN END

!================================================================== ! ! SETS STEO SCALE FACTOR FOR END

- USE PRICES AND ADJUST END

- USE PR ! ! CALLED BY: NGSET_SECPR ! ! NOTES: ONLY CALLED AFTER LHISYR ! (END

- USE PR ALREADY BENCHMARKED IN HISTORICAL YEARS) ! !==================================================================

SUBROUTINE NGSTEO_BENCHENDPR IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngtdminc' include 'ngitminc' include 'nghistinc' include 'ngsteoinc' include 'ogglobal'

INTEGER*4 I,J, SEC,N INTEGER*4 PHASYR ! PHASEOUT YEAR NUMBER (1ST, 2ND, ETC) INTEGER*4 TOTPHAS ! TOTAL NUMBER OF PHASEOUT YEARS INTEGER*4 LOOPYR ! YEARS TO WRITE OUT SCALE INFO
REAL*4 DEL_SCALE ! DELTA BETWN STEO & LHISYR SCALING FACTOR REAL*4 TOTRESPR ! ANNUAL AVG RES PR REAL*4 TOTCOMPR ! ANNUAL AVG COM PR REAL*4 TOTINDPR ! ANNUAL AVG IND PR REAL*4 TOTEUPR ! ANNUAL AVG EU PRREAL*4 TRESQ ! PLACEHOLDER FOR TOT AL RES

DMD REAL*4 TCOMQ ! PLACEHOLDER FOR TOTAL COM DMD REAL*4 TINDQ ! PLACEHOLDER FOR TOTAL IND DMD REAL*4 TEUQ ! PLACEHOLDER FOR TOTAL EU DMD !

-----------

! S ET SCALE_FPR AND SCALE_IPR IF BENCHMARKING END

- USE PR TO STEO

IF (MODYR .LE. BMYEAR) THEN IF (STINPUT_SCAL .EQ. 0) THEN TOTRESPR = 0.0 TOTCOMPR = 0.0 TOTINDPR = 0.0 TOTEUPR = 0.0 TRESQ = 0.0 TCOMQ = 0.0 TINDQ = 0.0 TEUQ = 0.0 DO N=1,DNODES ! calc P*Q, sumQ TOTRESPR = TOTRESPR + &

NGQTY_SF(PKNET,1,N) * NGPR_SF(PKNET,1,N) + & NGQ TY_SF(OPNET,1,N) * NGPR_SF(OPNET,1,N) TOTCOMPR = TOTCOMPR + &

NGQTY_SF(PKNET,2,N) * NGPR_SF(PKNET,2,N) + & NGQTY_SF(OPNET,2,N) * NGPR_SF(OPNET,2,N) TOTINDPR = TOTINDPR + &

NGQTY_SF(PKNET,3,N) * NGPR_SF(PKNET,3,N) + & NGQTY_SF(OPNET,3,N) * NGPR_SF(OPNET,3,N) + & NGQTY_SI(PKNET,3,N) * NGPR_SI(PKNET,3,N) + & NGQTY_SI(OPNET,3,N) * NGPR_SI (OPNET,3,N) TRESQ = TRESQ+ NGQTY_SF(PKNET,1,N)+ NGQTY_SF(OPNET,1,N) TCOMQ = TCOMQ+ NGQTY_SF(PKNET,2,N)+ NGQTY_SF(OPNET,2,N) TINDQ = TINDQ+ NGQTY_SF(PKNET,3,N)+ NGQTY_SF(OPNET,3,N) + &

NGQTY_SI( PKNET,3,N)+ NGQTY_SI(OPNET,3,N) ENDDO TOTRESPR = TOTRESPR / TRESQ ! qty

- wt avg TOTCOMPR = TOTCOMPR / TCOMQ ! qty

- wt avg TOTINDPR = TOTINDPR / TINDQ ! qty

- wt avg

! UTILITY SUBREGIONS 1

- 16 DO J=1,NNGEM

- 1 ! calc P*Q, sumQ TOTEUPR = TOTEUPR + &

NGUQTY_SF(PKNET,J) * NGUPR_SF(PKNET,J) + & NGUQTY_SF(OPNET,J) * NGUPR_SF(OPNET,J) + & NGUQTY_SI(PKNET,J) * NGUPR_SI(PKNET,J) + & NGUQTY_SI(OPNET,J) * NGUPR_SI(OPNET,J) TEUQ = TEUQ + NGUQTY_SF(PKNET,J) + NGUQTY_SF(OPNET,J) + &

NGUQTY_SI(PKNET,J) + NGUQTY_SI(OPN ET,J) ENDDO TOTEUPR = TOTEUPR / TEUQ ! qty

- wt avgSCALE_FPR(1,MODYR) = STPNGRS(CURIYR)

- TOTRESPR ! RES SCALE_FPR(2,MODYR) = STPNGCM(CURIYR)

- TOTCOMPR ! COM IF (STPIN_FLG.EQ.'YES') THEN ! IND SCALE_FPR(3,MODYR) = STPNGIN(CURIYR)

- TOTINDPR ! IND ELSE ! IND SCALE_FPR(3,MODYR) = 0.0 ! IND ENDIF ! IND SCALE_FPR(4,MODYR) = 0.0 ! TRN SCALE_FPR(5,MODYR) = STPNGEL(CURIYR)

- TOTEUPR ! EU

SCALE_IPR(1,MODYR) = 0.0 ! RES SCALE_IPR(2,MODYR) = 0.0 ! COM SCALE_IPR(3,MODYR) = SCALE_FPR(3,MODYR) ! IND SCALE_IPR(4,MODYR) = 0.0 ! TRN SCALE_IPR(5,MODYR) = SCALE_FPR(5 ,MODYR) ! EU ELSE DO SEC=1,DSEC SCALE_FPR(SEC,MODYR) = STSCAL_FPR(SEC,MODYR) SCALE_IPR(SEC,MODYR) = STSCAL_IPR(SEC,MODYR) ENDDO ENDIF

! PHASE OUT STEO BENCHMARKING SCALE IF BENCHMARKING TO STEO ELSE IF ( (MODYR .LE. STPHAS_YR) .AND. &

(BMYEAR .GT. LHISYR)) THEN PHASYR = MODYR

- BMYEAR TOTPHAS = STPHAS_YR

- BMYEAR DO SEC=1,DSEC DEL_SCALE = SCALE_FPR(SEC,BMYEAR)

- &

SCALE_FPR(SEC,STPHAS_YR) SCALE_FPR(SEC,MODYR) = SCALE_FPR(SEC,BMYEAR)

- &

PHASYR * (DEL_SCALE / TOTPHAS) DEL_SCALE = SCALE_IPR(SEC,BMYEAR)

- &

SCALE_IPR(SEC,STPHAS_YR) SCALE_IPR(SEC,MODYR) = SCALE_IPR(SEC,BMYEAR)

- &

PHASYR * (DEL_SCALE / TOTPHAS) ENDDO

! SET STEO BENCHMARKING SCALE TO T

- 1 LEVEL ELSE IF (MODYR .GT. EHISYR) THEN DO SEC=1,DSEC SCALE_FPR(SEC,MODYR) = SCALE_FPR(SEC,MODYR

- 1) SCALE_IPR(SEC,MODYR) = SCALE_IPR(SEC,MODYR

- 1) ENDDO ENDIF

IF (STPHAS_YR .GT. BMYEAR) THEN LOOPYR = STPHAS_YR ELSE LOOPYR = BMYEAR ENDIF

IF ((MODYR .EQ. LOOPYR) .AND. (FCRL .EQ. 1)) THENWRITE(NGOBENCH,*) ' END

- USE PR NATIONAL SCALING FACTORS' WRITE(NGOBENCH,10) (I,I=IBASYR,LOOPYR) DO SEC=1,DSEC WRITE(NGOBENCH,11) SEC,(SCALE_FPR(SEC,I),I=IBASYR,LOOPYR) ENDDO WRITE(NGOBENCH,12) (I,I=IBASYR,LOOPYR) DO SEC=1,DSEC WRITE(NGOBENCH,13) SEC,(SCALE_IPR(SEC,I),I=IBASYR,LOOPYR) ENDDO WRITE(NGOBENCH,*) ENDIF 10 FORMAT(3X,'FIRM ','SEC',<IJUMPYR>(4X,I4)) 11 FORMAT(1X,'SC_FPR: ',I1,1X,<IJUMPYR>F8.4) 12 FORMAT(3X,'INTRP ','SEC',<IJUMPYR>(4X,I4)) 13 FORMAT(1X,'SC_IPR: ',I1,1X,<IJUMPYR>F8.4)

RETURN END

!================================================================== ! ! SETS STEO S CALE FACTOR FOR DISCREPANCY AND NET STORAGE WITHDRWL ! ! ! ! CALLED BY: NGSET_BENCH ! ! NOTES: ! ! !==================================================================

SUBROUTINE NGSTEO_BENCHDISCR IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngtdminc' include 'ngitminc' include 'ngcdmdinc' include 'ngsteoinc' include 'ogglobal'

INTEGER*4 YR1, YR, N, NET ! COUNTERS INTEGER*4 LOOPYR ! COUNTER INTEGER*4 PHASYR ! PHASEOUT YEAR # (1ST, 2ND, ETC.) INTEGER*4 TOTPHAS ! TOTAL NUM OF PHASEOUT YEARS

REAL*4 DEL_SCALE ! DELTA BTWN STEO & MODEL TOTAL DISCR REAL*4 ANNDISCR ! TOTAL MODEL DISCR !

-----------
DO YR=STEOYRS(1),STEOYRS(STEO_YEAR) ! ie, 1997,1998YR1 = YR

- IBASYR + 1 ! ie, 8,9 ANNDISCR = 0.0

DO NET=1,NETWORK DO N=1,DNODES ANNDISCR = ANNDISCR + DISCR(NET,N,YR) ENDDO ENDDO
IF (STINPUT_SCAL .EQ. 0) THEN DEL_SCALE = STDISCR(YR1)

- ANNDISCR SCALE_DISCR(YR) = DEL_SCALE /(NETWORK * DNODES) ! ALLOCATE OVER NET,REG

SCALE_NETSTR(YR)= NNETWITH(YR1) / (NETWORK * DNODES) ELSE SCALE_DISCR(YR) = STSCAL_DISCR(YR) SCALE_NETSTR(YR)= STSCAL_NETSTR(YR) ENDIF ENDDO
DO YR=STEOYRS(1),STEOYRS(STEO_YEAR) ! ie, 1997,199 8 DO NET=1,NETWORK DO N=1,DNODES DISCR(NET,N,YR) = DISCR(NET,N,YR) + SCALE_DISCR(YR)

- & SCALE_NETSTR(YR) ENDDO ENDDO ENDDO ! P HASE OUT STEO SCALE FACTORS IF (STPHAS_YR .GT. 0) THEN DO YR=BMYEAR+1,STPHAS_YR PHASYR = YR

- BMYEAR TOTPHAS = STPHAS_YR

- BMYEAR DEL_SCALE = SCALE_DISCR(BMYEAR)

- SCALE_DISCR(STPHAS_YR) SCALE_DISCR(YR) = SCALE_DISCR(BMYEAR)

- & PHASYR * (DEL_SCALE / TOTPHAS) DEL_SCALE = SCALE_NETSTR(BMYEAR)

- SCALE_NETSTR(STPHAS_YR) SCALE_NETSTR(YR) = SCALE_NETSTR(BMYEAR)

- & PHASYR * (DEL_SCALE / TOTPHAS) DO NET=1,NETWORK DO N=1,DNODES DISCR(NET,N,YR) = DISCR(NET,N,YR) + SCALE_DISCR(YR)

- & SCALE_NETSTR(YR) ENDDO ENDDO ENDDO ENDIF

IF (STPHAS_YR .GT. BMYEAR) THEN LOOPYR = STPHAS_YR ELSE LOOPYR = BMYEAR ENDIFWRITE(NGOBENCH,*) ' NATIONAL DISCRPANCY SCALING FACTORS' WRITE(NGOBENCH,10) (YR,YR=IBA SYR,LOOPYR) WRITE(NGOBENCH,11) (SCALE_DISCR(YR),YR=IBASYR,LOOPYR) WRITE(NGOBENCH,12) (SCALE_NETSTR(YR),YR=IBASYR,LOOPYR) WRITE(NGOBENCH,*) 10 FORMAT(9X,'REG',<IJUMPYR>(4X,I4)) 11 FORMAT(1X,'SCALE_DISCR',<IJUMPYR>F8.2) 12 FORMAT(1 X,'SCALE_NETSTR',F7.2,<IJUMPYR>F8.2)

RETURN END

!================================================================== ! ! SETS STEO SCALE FACTOR FOR DISCREPANCY AND NET STORAGE WITHDRWL ! ! ! ! CALLED BY: CALLED first ITR, each STEO year & phaseout yr ! FOR AEO2003 AER ADJ ! ! NOTES: ! ! !==================================================================

SUBROUTINE xNGSTEO_BENCHDISCR IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngpa rinc' include 'ngtdminc' include 'ngitminc' include 'ngcdmdinc' include 'ngsteoinc' include 'ngakinc' include 'ogglobal'

INTEGER*4 YR1,YR,N,NET,SEC ! COUNTERS INTEGER*4 LOOPYR ! COUNTER INTEGER*4 PHASYR ! PHASEOUT YEAR # (1ST, 2ND, ETC.) INTEGER*4 TOTPHAS ! TOTAL NUM OF PHASEOUT YEARS INTEGER*4 JENDYR ! LAST YEAR VALUE CORRESPONDS TO IENDYR EXTERNAL RTOVALUE INTEGER RTOVALUE
REAL*4 DEL_SCALE ! DELTA BTWN STEO & MODEL TOTAL DISCR REAL*4 ANNDISCR ! TOTAL MODEL DISCR REAL*4 TMPDISCR(NETWORK,DNODES) ! HOLD INITIAL, NONADJ VALUES REAL*4 NDISCR_AERADJ ! STEO DISCREPANCY A DJ DEALING W/NEW AER NUMBER ALIGNMENTLOGICAL ONCE/.TRUE./

!

-----------

JENDYR = RTOVALUE('IJUMPCAL',2030)

IF (CURITR.EQ.1) THEN DO NET=1,NETWORK DO N=1,DNODES TMPDISCR(NET,N) = DISCR(NET,N,MODYR) ENDDO ENDDO ENDIF

IF (MODYR.LE.STEOYRS(STEO_YEAR)) THEN

ANNDISCR = 0.0 DO NET=1,NETWORK DO N=1,DNODES ANNDISCR = ANNDISCR + TMPDISCR(NET,N) ENDDO ENDDO
IF (STINPUT_SCAL .EQ. 0) THEN NDISCR_AERADJ = STENDCON(CURIYR)

DO SEC=1,DSEC NDISCR_AERADJ = NDISCR_AERADJ

- AKQTY_F(SEC)

- AKQTY_I(SEC) ENDDO

DO N=1,DNODES DO SEC=1,DSEC

- 1 NDISCR_AERADJ = NDISCR_AERADJ

- BASQTY_F(SEC,N)

- BASQTY_I(SEC,N)

ENDDO ENDDO

DO N=1,NNGEM

- 1 NDISCR_AERADJ = NDISCR_AERADJ

- BASUQTY_F(N)

- BASUQTY_I(N) ENDDO

DEL_SCALE = STDISCR(CURIYR ) + NDISCR_AERADJ

- ANNDISCR SCALE_DISCR(MODYR) = DEL_SCALE /(NETWORK * DNODES) ! ALLOCATE OVER NET,REG

SCALE_NETSTR(MODYR)= NNETWITH(CURIYR) / (NETWORK * DNODES) ELSE SCALE_DISCR(MODYR) = STSCAL_DISCR(MODYR) SCALE_NETSTR(MODYR)= STSCAL_NETSTR(MODYR) ENDIF

DO NET=1,NETWORK DO N=1,DNODES DISCR(NET,N,MODYR) = TMPDISCR(NET,N) + SCALE_DISCR(MODYR)

- & SCALE_NETSTR(MODYR) ENDDOENDDO
ELSEIF (STPHAS_YR.GT.0) THEN ! PHASE OUT STEO SCALE FACTORS PHASYR = MODYR

- BMYEAR

TOTPHAS = STPHAS_YR

- BMYEAR DEL_SCALE = SCALE_DISCR(BMYEAR)

- SCALE_DISCR (STPHAS_YR) SCALE_DISCR(MODYR) = SCALE_DISCR(BMYEAR)

- & PHASYR * (DEL_SCALE / TOTPHAS) DEL_SCALE = SCALE_NETSTR(BMYEAR)

- SCALE_NETSTR(STPHAS_YR) SCALE_NETSTR(MODYR) = SCALE_NETSTR(BMYEAR)

- & PHASYR * (DEL_SCALE / TOTPHAS) DO NET=1,NETWORK DO N=1,DNODES DISCR(NET,N,MODYR) = TMPDISCR(NET,N) + SCALE_DISCR(MODYR) ENDDO ENDDO ELSEIF (STPHAS_YR.EQ.0) THEN IF (ONCE) THEN ONCE = .FALSE. DO YR=STEOYRS(STEO_YEAR)+1,JENDYR DO NET=1,NETWORK DO N=1,DNODES DISCR(NET,N,YR) = DISCR(NET,N,YR) + SCALE_DISCR(STEOYRS(STEO_YEAR))

ENDDO ENDDO EN DDO ENDIF

ENDIF

IF (STPHAS_YR .GT. BMYEAR) THEN LOOPYR = STPHAS_YR ELSE LOOPYR = BMYEAR ENDIF

IF (MODYR.EQ.LOOPYR) THEN !

------

WRITE(NGOBENCH,60) (YR,YR=EHISYR+1,LHISYR+10) WRITE(NGOBENCH,20) DO NET=1,NETWORK DO N=1,DNODES WRITE(NGOBENCH,70) NET,N,(DISCR(NET,N,YR), & YR=EHISYR+1,LHISYR+10) ENDDO WRITE(NGOBENCH,*) ENDDO 20 FOR MAT(2X,"NET NODE ") 60 FORMAT(1X,'<DISCR (4CAST)>',<IJUMPYR>(4X,I4)) ! format set to be sure enough70 FORMAT(3X,I1,3X,I2,7X,<IJUMPYR>F8.2) ! fomrat set to be sure

enough

WRITE(NGOBENCH,*) ' NATIONAL DISCRPANCY SCALING FACTO RS'

WRITE(NGOBENCH,10) (YR,YR=IBASYR,LOOPYR) WRITE(NGOBENCH,11) (SCALE_DISCR(YR),YR=IBASYR,LOOPYR) WRITE(NGOBENCH,12) (SCALE_NETSTR(YR),YR=IBASYR,LOOPYR) WRITE(NGOBENCH,*) 10 FORMAT(9X,'REG',<IJUMPYR>(4X,I4)) 11 FORMAT(1X,'SCALE_DISCR',<IJUMPYR>F8.2) 12 FORMAT(1X,'SCALE_NETSTR',F7.2,<IJUMPYR>F8.2) ENDIF

RETURN END

!================================================================== ! ! SETS STEO SCALE FACTOR FOR SUPPLEMENTA L SUPPLY ! ! ! ! CALLED BY: NGMAIN ! ! NOTES: ! ! !==================================================================

SUBROUTINE NGSTEO_BENCHSUPLM IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngtdminc' include 'ngitminc' include 'ngcdmdinc' include 'ngsteoinc' include 'ogglobal'

INTEGER*4 YR1, YR, N, NET ! COUNTERS INTEGER*4 LOOPYR ! COUNTER

REAL*4 DEL_SCALE ! DELTA BTWN STEO & MODEL TOTAL DISCR REAL*4 ANNSUPLM ! TOTAL MODEL SUPPLEMENTAL SUPPLY

!

-----------
DO YR=STEOYRS(1),STEOYRS(STEO_YEAR) ! ie, 1997,1998 YR1 = YR

- IBASYR + 1 ! ie, 8,9 ANNSUPLM = 0.0

!yd1 CTG ANNSUPLM = ANNSUPLM + SNGCOAL(YR)DO N=1,DNODES ANNSUPLM = ANNSUPLM + SNGOTH(N,YR) + SNGLIQ(N,YR) + SNGCOAL(N,YR)

ENDDO
IF (STINPUT_SCAL .EQ. 0) THEN SCALE _SUPLM(YR) = STOGPRSUP(YR1) / ANNSUPLM ELSE SCALE_SUPLM(YR) = STSCAL_SUPLM(YR) ENDIF

! UPDATE THE THREE OTHER SUPPLEMENTAL CATEGORIES

!yd1 CTG SNGCOAL(YR) = SNGCOAL(YR) * SCALE_SUPLM(YR)

DO N=1,DNODES SNGOTH(N,YR) = SNGOTH(N,YR) * SCALE_SUPLM(YR) SNGLIQ(N,YR) = SNGLIQ(N,YR) * SCALE_SUPLM(YR) SNGCOAL(N,YR) = SNGCOAL(N,YR) * SCALE_SUPLM(YR) ENDDO ENDDO

IF (STPHAS_YR .GT. BMYEAR) THEN LOOPYR = STPH AS_YR ELSE LOOPYR = BMYEAR ENDIF

WRITE(NGOBENCH,*) ' NATIONAL SUPPLEMENTAL SUPPLY SCALING ', & 'FACTORS' WRITE(NGOBENCH,10) (YR,YR=IBASYR,LOOPYR) WRITE(NGOBENCH,11) (SCALE_SUPLM(YR),YR=IBA SYR,LOOPYR) WRITE(NGOBENCH,*) 10 FORMAT(9X,'REG',<IJUMPYR>(4X,I4)) 11 FORMAT(1X,'SCALE_SUPLM',<IJUMPYR>F8.4)

RETURN END

!================================================================== ! ! SUBROUTINE TO MODULE INPUTS AND OUTPU TS ! !================================================================== SUBROUTINE NGREPIN IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngtdminc' include 'ngakinc' include 'ogglobal' ! INTEGER*4 IO,I,IYINTEGER*4 NSDOMREG ! DOMESTIC SUPPLY REGIONS (6+3)

INTEGER*4 FILE_MGR LOGICAL ONCE/.TRUE./ !

-----------

IF (ONCE) THEN ONCE = .FALSE. NSDOMREG = NOCSREG + NSUPREG ENDIF

IO = NGUNIT IY = CURIYR ! WRITE(IO,*) 'AFM: CURIYR = ',CURIYR,' CURITR = ',CURITR WRITE(IO,*) ' INPUTS FROM OGSM (& COAL) TO AFM' WRITE(IO,*) ' SUBREG OGRESNGON OGPRRNGON ', &

'CLSYNGQN(TBTU) OGPRDADON(BCF)' WRITE(IO,10) (I,oOGRESNGON(I,IY),oOGPRRNGON(I,IY), &

oCLSYNGQN(I,IY),oOGPRDADON(I,IY),I=1,17) 10 FORMAT(17(5X,I2,4X,4(2X,F11.3),/),/) WRITE(IO,*) ' OCSREG OGRESNGOF OGPRRNGOF OGPRDADOF' ! WRITE(IO,20) (I,oOGRESNGOF(I,IY),oOGPRRNGOF(I,IY), &

oOGPRDADOF(I,IY),I=1,3) 20 FORMAT(3(5X,I2,4X,3(2X,F11.3),/),/) WRITE(IO,22) (I,I=1,14) 22 FORMAT(' BORDER',14I6) WRITE(IO,24) (oOGQNGEXP(I,IY),I=1,MNUMBX

- 4) 24 FORMAT(' OGQNGEXP',<MNUMBX

- 4>F6.0) WRITE(IO,26) (oOGQNGIMP(I,IY),I=1,MNUMBX

- 4) 26 FORMAT(' OGQNGIMP',<MNUMBX

- 4>F6.0) WRITE(IO,*) ' CANGAS OGRESCAN OGPRRCAN ' WRITE(IO,30) oOGRESCAN(2,I Y),oOGPRRCAN(2,IY) 30 FORMAT(5X,2(2X,F11.2),/) WRITE(IO,52) MODYR, oOGQANGTS(IY),QAK_ALB(MODYR) 52 FORMAT(1X,I4,' OGQANGTS = ',F9.0,' QAK_ALB = ',F9.0) WRITE(IO,53) MODYR, QMD_ALB(MODYR) 53 FORMAT(1X,I4,' QMD_ALB = ',F9.0) ! WRITE(IO,*) ' INPUTS FROM PMM TO AFM' WRITE(IO,*) ' RFQTDCRD, OIL PROD 6 ONSHR, 3 OFFSHR (MMBBL/DAY)' WRITE(IO,56) (oRFQTDCRD(I,IY),I=1,NOCSREG + NSUPREG) 56 FORMAT(5X,9(1X,F6.3),/) WRITE(IO,*) ' INPUTS FROM EMM TO AFM' WRITE(IO,*) ' SUBREG QGFELGR QGCELGR QGIELGR ', & ' SQGFELGR SQGIELGR' WRITE(IO,60) (I,oQGFELGR(I,IY),oQGCELGR(I,IY),oQGIELGR(I,IY), & oSQGFELGR(I,IY,PKNET),oSQGFELGR(I,IY,OPNET), & oSQGIELGR(I,IY,PKNET),oSQGIELGR(I,IY,OPNET),I=1,NNGEM) 60 FORMAT(17(5X,I2,4X,7(2X,F9.4),/),/) ! NNGEM ! WRITE(IO,65) oIT_WOP(IY,1) 65 FORMAT(' INPUTS FROM INTERN"L TO AFM, IT_WOP($/BBL)= ',F7.2,/) !WRITE(IO,*) ' INP UTS FROM "NEMS" BY CENSUS ACROSS (TBTU) ' WRITE(IO,70) (oQGFRS(I,IY),I=1,NNCEN) 70 FORMAT(1X,'QGFRS ',9F7.1) WRITE(IO,80) (oQGFCM(I,IY),I=1,NNCEN) 80 FORMAT(1X,'QGFCM ',9F7.1) WRITE(IO,90) (oQGFIN(I,IY),I=1,NNCEN) 90 FORMAT(1X ,'QGFIN ',9F7.1) WRITE(IO,100) (oQGFTR(I,IY),I=1,NNCEN) 100 FORMAT(1X,'QGFTR ',9F7.1) WRITE(IO,110) (oQGFEL(I,IY),I=1,NNCEN) 110 FORMAT(1X,'QGFEL ',9F7.1,/) WRITE(IO,101) (oQGFTRFV(I,IY),I=1,NNCEN) 101 FORMAT(1X,'QGFTRFV',9F7.1) WRITE(IO,102) (oQGFTRPV(I,IY),I=1,NNCEN) 102 FORMAT(1X,'QGFTRPV',9F7.1,/) WRITE(IO,120) (oQGIRS(I,IY),I=1,NNCEN) 120 FORMAT(1X,'QGIRS ',9F7.1) WRITE(IO,130) (oQGICM(I,IY),I=1,NNCEN) 130 FORMAT(1X,'QGICM ',9F7.1) WRITE(IO,14 0) (oQGIIN(I,IY),I=1,NNCEN) 140 FORMAT(1X,'QGIIN ',9F7.1) WRITE(IO,145) (oQGITR(I,IY),I=1,NNCEN) 145 FORMAT(1X,'QGITR ',9F7.1) WRITE(IO,150) (oQGIEL(I,IY),I=1,NNCEN) 150 FORMAT(1X,'QGIEL ',9F7.1,/) ! WRITE(IO,160) (I,I=1,NNCEN) WRITE(IO,162) (oPMGTR(I,IY),I=1,NNCEN) 160 FORMAT(' INPUTS FROM NEMS PROPER TO PTM/DTM ',/, &

' CENREG ',9I8) 162 FORMAT(' PMGTR ',9F8.2) ! WRITE(IO,*) ' INPUTS FROM MACRO TO PTM/DTM ' WRITE(IO,*) ' IMPLICIT GDP PRICE DEFLATOR, ',oMC_PCWGDP(IY) WRITE(IO,*) ' YIELD ON AA UTILITY BONDS, ',oMC_RMPUAANS(IY) WRITE(IO,*) ' REAL YIELD,10YR US GVT BONDS, ',oMC_REALRMGBLUS(IY) WRITE(IO,*) ' EMPLOYMENT COST INDE X, WAGE & SAL, ', &

oMC_ECIWSP(IY) WRITE(IO,170) (oMC_CPI(I,IY),I=1,NNCEN)

170 FORMAT(3X,'COMSUMER PRICE INDEX BY CENSUS DIVISION 1

- 9',/6X, & 9F8.5) ! RETURN END

!============================================== ==================== SUBROUTINE NGREPOUT ! ! SUBROUTINE TO MODULE INPUTS AND OUTPUTS ! IMPLICIT NONE include 'parametr' include 'ncntrl'include 'ngparinc' include 'ngtdminc' include 'ngitminc' include 'ogglobal' ! INTEGER*4 IO,I,J,IY

INTEGER*4 FILE_MGR !

-----------

IO = NGUNIT IY = CURIYR ! WRITE(IO,*) 'AFM: CURIYR = ',CURIYR,' CURITR = ',CURITR
!!!!! CALL NGTDM_SUPTEST(NGUNIT) ! WRITE(IO,*) ' OUT PUTS TO "NEMS" BY CENSUS ACROSS, $/MMBTU, TBTU' WRITE(IO,170) (oPGFRS(I,IY),I=1,NNCEN) 170 FORMAT(1X,'PGFRS ',9F7.2) WRITE(IO,180) (oPGFCM(I,IY),I=1,NNCEN) 180 FORMAT(1X,'PGFCM ',9F7.2) WRITE(IO,190) (oPGFIN(I,IY),I=1,NNCEN) 190 FORMAT(1X,'PGFIN ',9F7.2) WRITE(IO,200) (oPGFTR(I,IY),I=1,NNCEN) 200 FORMAT(1X,'PGFTR ',9F7.2) WRITE(IO,210) (oPGFEL(I,IY),I=1,NNCEN) 210 FORMAT(1X,'PGFEL ',9F7.2,/) WRITE(IO,201) (oPGFTRFV(I,IY),I=1,NNCEN) 201 FORMAT(1X,'PGFTRFV',9F7.2) WRITE(IO,202) (oPGFTRPV(I,IY),I=1,NNCEN) 202 FORMAT(1X,'PGFTRPV',9F7.2,/) WRITE(IO,220) (oPGIRS(I,IY),I=1,NNCEN) 220 FORMAT(1X,'PGIRS ',9F7.2) WRITE(IO,230) (oPGICM(I,IY),I=1,NNCEN) 230 FORMAT(1X ,'PGICM ',9F7.2) WRITE(IO,240) (oPGIIN(I,IY),I=1,NNCEN) 240 FORMAT(1X,'PGIIN ',9F7.2) WRITE(IO,250) (oPGITR(I,IY),I=1,NNCEN) 250 FORMAT(1X,'PGITR ',9F7.2) WRITE(IO,260) (oPGIEL(I,IY),I=1,NNCEN) 260 FORMAT(1X,'PGIEL ',9F7.2,/) ! WRITE(IO,261) (oPNGRS(I,IY),I=1,NNCEN) 261 FORMAT(1X,'PNGRS ',9F7.2) WRITE(IO,262) (oPNGCM(I,IY),I=1,NNCEN) 262 FORMAT(1X,'PNGCM ',9F7.2) WRITE(IO,263) (oPNGIN(I,IY),I=1,NNCEN) 263 FORMAT(1X,'PNGIN ',9F7.2) WRITE(IO,264) (oP NGTR(I,IY),I=1,NNCEN) 264 FORMAT(1X,'PNGTR ',9F7.2) WRITE(IO,265) (oPNGEL(I,IY),I=1,NNCEN) 265 FORMAT(1X,'PNGEL ',9F7.2,/) !WRITE(IO,270) (oQLPIN(I,IY),I=1,NNCEN)

270 FORMAT(1X,'QLPIN ',9F7.1) WRITE(IO,280) (oQGPTR(I,IY),I=1,NNCEN) 280 FORMAT(1X,'QGPTR ',9F7.1,/) !CCC WRITE(IO,*) ' EMISSIONS (CENUS & TOT ACROSS, TYPE DOWN),', !CCC 1 ' M MET TONS' !CCC WRITE(IO,290) (J,(EMNT(I,J,IY),I=1,NNCEN), !CCC 1 EMNT(MNU MCR,J,IY),J=1,8) !CCC 290 FORMAT(8(2X,I1,1X,10F9.2,/),/) WRITE(IO,*) ' ' WRITE(IO,*) ' OUTPUTS FROM AFM TO EMM' WRITE(IO,*) ' SUBREG PGFELGR PGIELGR SPGFELGR', & ' SPGIELGR ($/MMBTU)'
WR ITE(IO,300) (I,oPGFELGR(I,IY),oPGIELGR(I,IY), & oSPGFELGR(I,IY,PKNET),oSPGFELGR(I,IY,OPNET), & oSPGIELGR(I,IY,PKNET),oSPGIELGR(I,IY,OPNET),I=1,NNGEM) 300 FORMAT(17(5X,I2,6(6X,F5.2),/),/) ! NNGEM WRITE(IO,*) ' OUTPUTS FROM AF M TO PMM' WRITE(IO,*) ' PRNG_PADD BY 5 PADD REGIONS (BCF)

-- w/o L&P, AK' WRITE(IO,310) (oPRNG_PADD(I,IY),I=1,5) 310 FORMAT(5X,5F8.1,/) WRITE(IO,*) ' OUTPUTS FROM AFM TO REPORTS ' WRITE(IO,*) ' OGQNGIMP CAN MEX LNG TOT =', & oOGQNGIMP(MNUMBX

- 3,IY),oOGQNGIMP(MNUMBX

- 2,IY), & oOGQNGIMP(MNUMBX

- 1,IY),oOGQNGIMP(MNUMBX,IY) WRITE(IO,*) ' OGQNGEXP CAN MEX LNG TOT =', & oOGQNGEXP(MNUMBX

- 3,IY),oOGQNGEXP(MNUMBX

- 2,IY), & oOGQNGEXP(MNUMBX

- 1,IY),oO GQNGEXP(MNUMBX,IY) WRITE(IO,*) ' OGPRSUP (BCF) = ',oOGPRSUP(IY) WRITE(IO,*) ' MNUMOR OGPRDNG(BCF) OGWPRNG($/MCF) ' WRITE(IO,320) (I,oOGPRDNG(I,IY),oOGWPRNG(I,IY),I=1,13) 320 FORMAT(13(5X,I2,4X,F8.1,3X,F5.2,/),/) WRITE(IO,*) ' OUTPUTS FROM AFM TO OGSM & COAL' WRITE(IO,322) (oOGQNGIMP(I,IY),I=1,MNUMBX

- 4) 322 FORMAT(' OGQNGIMP',<MNUMBX

- 4>F8.0) WRITE(IO,324) (oOGPNGIMP(I,IY),I=1,MNUMBX

- 4) 324 FORMAT(' OGPNGIMP',<MNUMBX

- 4>F8.2) WRITE(IO, *) ' OGCNPPRD, OGCNQPRD ',oOGCNPPRD(2,IY),oOGCNQPRD(2,IY) WRITE(IO,*) ' OGPRDNGOF(1

- 3) (BCF) ' WRITE(IO,330) (oOGPRDNGOF(I,IY),I=1,3) 330 FORMAT(5X,3F8.1/) WRITE(IO,*) ' SUBREG OGPRDNGON(BCF) PSUP ($/MMBTU) ' WRITE(IO, 340) (I,oOGPRDNGON(I,IY),PSUP(I),I=1,17) 340 FORMAT(17(5X,I2,5X,F8.1,10X,F5.2,/),/) ! RETURN END

!==================================================================== ! ! ROUTINE TO WRITE OUT SUPPLY CURVE AND SUPPLY SOLUTION VARIABLES ! != =============================================================== SUBROUTINE NGTDM_SUPTEST(UNRPT)IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngitminc' include 'ngtdminc' include 'ngsteoinc' include 'ogglobal'

INTEGER*4 S,N,M,I,RG,NET INTEGER*4 UNRPT INTEGER*4 NG_NREG ! FUNCTION: MAPS SUP REG ID TO NG REG INTEGER*4 NREG ! NG REG ID

REAL*4 SUP_MIN,TSUPPR,TSUPQ REAL*4 SUP_MAX REAL*4 P0,Q0 REAL*4 PZ,QZ ! temp REAL*4 NGSUP_PR ! SUPPLY FUNCTION

REAL*4 LNGSUP_MIN(NETWORK),LNG_TSUPPR(NETWORK),LNG_TSUPQ(NET WORK) REAL*4 LNGSUP_MAX(NETWORK) REAL*4 LNG_P0(NETWORK),LNG_Q0(NETWORK),TLNG_Q0(NETWORK) REAL*4 NGPRCLNG ! LNG SUPPLY CURVE FUNCTION REAL*4 QLAGTOT(NETWORK,NLNGCRV) ! LNG IMPORTS LAST YEAR, EAST AND W EST REAL*4 TOTQ(NETWORK,NLNGCRV) ! IMPORT LEVELS IN EAST AND WEST (LAST YEAR, THIS YEAR) REAL*4 MEXLNGTOT ! TOTAL MEXICO LNG IMPORTS ON GIVEN COAST REAL*4 SH ! TEMPORARY HOLD SEASONAL M EXICO SHARE REAL*4 PQ,PQ0 ! SUM OF P*Q

!

-------------
oNGSCRV_MIN(CURIYR) = 0.0 oNGSCRV_MAX(CURIYR) = 0.0 oNGSCRV_Q(CURIYR) = 0.0 oNGSCRV_P(CURIYR) = 0.0 oNGSCRV_Q0(CURIYR) = 0.0 oNGSCRV_P0(CURIYR) = 0.0

DO S=1,SNODES IF (SUPARRAY(S).EQ.1) THEN IF (SUPTYPE(S) .NE. 14) THEN !NON

- LNG SUPPLY YD1LNG: ADD LNG CHECK LATER?? ! NREG = NG_NREG(S) ! FUNCTION MAPPING SUP ID TO NG ID ! w/o L&P NREG = MAP_NG(S) IF(S.EQ.SNODES

- lSNODES

- 3) NREG=13IF (MODYR .LE. EHISYR) THEN SUP_MAX = QSUP(S) * MAXPRRFAC ELSE SUP_MAX = ZOGRESNG(S) * ZOGPRRNG(S) * MAXPRRFAC ! w/ L&P
ENDIF SUP_MIN = ZOGRESNG(S) * ZOGPRRNG(S) * 0.6 ! w/ L&P
! SUP_MIN = NGSUP_PR('P',0.1,S) / & ! function ! w/ L&P ! (1.

- (PCTLP(NREG) * SCALE_LP(MODYR)))

TSUPPR = NGSUP_PR('Q',Q SUP(S),S) ! function ! Q+L&P done in func TSUPQ = QSUP(S) / & ! w/ L&P (1.

- (PCTLP(NREG) * SCALE_LP(MODYR)))

IF (S .LE. NSUPSUB) THEN N = SUPSUB_NG(S) ELSE IF (S .LT. FSRGN(3)) THEN N = SUPSUB_NG(OCSMAP(S

- NSUPSUB)) ELSE IF (S .EQ. SNODES

- lSNODES

- 3) THEN N = 13 ENDIF

IF (MODYR .LE. EHISYR) THEN Q0 = QSUP(S) ! w/o L&P ELSE Q0 = ZOGRESNG(S) * ZOGPRRNG(S) * & ! w/o L&P (1.

- (PCTLP(NREG) * SCALE_LP(MODYR))) ENDIF P0 = NGSUP_PR('Q',Q0,S) ! Q+L&P done in func Q0 = Q0 / (1.

- (PCTLP(NREG) * SCALE_LP(MOD YR))) ! w/ L&P

IF (S.LT.FSRGN(3)) THEN oNGSCRV_MIN(CURIYR) = oNGSCRV_MIN(CURIYR) + SUP_MIN oNGSCRV_MAX(CURIYR) = oNGSCRV_MAX(CURIYR) + SUP_MAX oNGSCRV_Q(CURIYR) = oNGSCRV_Q(CURIYR) + TSUPQ oNGSCRV_P(CURIYR ) = oNGSCRV_P(CURIYR) + (TSUPQ * PSUP(S)) oNGSCRV_Q0(CURIYR) = oNGSCRV_Q0(CURIYR) + Q0 oNGSCRV_P0(CURIYR) = oNGSCRV_P0(CURIYR) + (Q0 * P0 * SCALE_WPR(MODYR))

ENDIF

IF (NGDBGITR(1,2)) THEN IF (S .EQ . 1) THEN WRITE(UNRPT,1000) CURIYR,CURIYR,CURITR,CYCLE ENDIF WRITE(UNRPT,1100) S,SUP_MIN,SUP_MAX, & TSUPQ,PSUP(S), TSUPPR,P0,Q0,PCTLP(N) ENDIF

ELSE !LNG SUPPLY N = DNODES + 2 M = S

- FSRGN(14) + 1 PQ = 0.0 PQ0 = 0.0IF (NGDBGITR(1,2)) THEN IF (M .EQ. 1) WRITE(UNRPT,1005) ENDIF DO NET=1,NETWORK IF (NET.EQ.PKNET) THEN SH = PKSHR_PROD(S) ELSE SH = 1.

- PKSHR_PROD(S) ENDIF LNGSUP_MIN(NET) = 0.0 LNGSUP_MAX(NET) = 0.0 TOTQ(NET,M) = QSUP(S) * SH QLAGTOT(NET,M) = NODE_QSUPPREV(NET,S) DO I=1,NLNGTER RG = MAPLNGE_W(I) IF (RG.EQ.M) THEN LNGSUP_MIN(NET) = LNGSUP_MIN(NET) + LNGMIN(I)*SH !W/O MEXICO LNGSUP_MAX(NET) = LNGSUP_MAX(NET) + LNGCAP(I,MODYR)*SH !?? ENDIF

ENDDO

IF (M.EQ.1) THEN MEXLNGTOT = (MEXLNG(2,MODYR) + MEXLNG(4,MODYR)) * SH ELSEIF (M.EQ.2) THEN MEXLNGTOT = (MEXLNG(1,MODYR) + MEXLNG(3,MODYR) + MEXLNG(5,MODYR)) * SH

ENDIF QLAGTOT(NET,M) = QLAGTOT(NET,M) + MEXLNGTOT TOTQ(NET,M) = TOTQ(NET,M) + MEXLNGTOT

LNG_TSUPPR(N ET) = NGPRCLNG(M,NET,MODYR,TOTQ(NET,M),'Q',QLAGTOT(NET,M)) !*LNG FUNCTION

LNG_TSUPQ(NET) = TOTQ(NET,M)

- MEXLNGTOT PQ = PQ + LNG_TSUPPR(NET) * TOTQ(NET,M) !WITH ADJ FOR MEXICO, CORRECT?

IF (MODYR .LE. E HISYR) THEN TLNG_Q0(NET) = QSUP(S) * SH + MEXLNGTOT ! w/ MEXICO ELSE TLNG_Q0(NET) = LNGQPT(M,NET,MODYR) !W/ MEXICO
ENDIF ! LNG_P0(NET) = NGPRCLNG(M,NET,MODYR,TLNG_Q0(NET),'Q', QLAGTOT(NET,M)) !*LNG FUNCTION

LNG_P0(NET) = LNGPPT(M,NET,MODYR) PQ0 = PQ0 + LNG_P0(NET)*TLNG_Q0(NET) ! LNG_Q0(NET) = TLNG_Q0(NET)

- MEXLNGTOT !W/O MEXICO

IF (NGDBGITR(1,2)) THEN WRITE(UNRPT,1101) S,LNGSUP_MIN(NET),LNGSUP_MAX(NET), & LNG_TSUPQ(NET),NODE_PSUP(NET,S), LNG_TSUPPR(NET),LNG_P0(NET),TLNG_Q0(NET),NET

ENDIFENDDO

SUP_MIN = LNGSUP_MIN(PKNET) + LNGSUP_MIN(OPNET) SUP_MAX = LNGSUP_MAX(PKNET) + LNGSUP_MAX(OPNET) IF ((TOTQ(PKNET,M)+TOTQ(OPNET,M)).GT.0.0) THEN TSUPPR = PQ / (TOTQ(PKNET,M)+TOTQ(OPNET,M)) ELSE TSUPPR = 1.0 ENDIF TSUPQ = QSUP(S) Q0 = TLNG_Q0(PKNET) + TLNG_Q0(OPNET) IF ((TLNG_Q0(PKNET) + TLNG_Q0(OPNET)).GT.0.0) THEN P0 = PQ0 / (TLNG_Q0(PKNET) + TLNG_Q0(OPNET)) ELSE P0 = (LNG_P0(PKNET) + LNG_P0(OPNET))/2.
ENDIF

IF (NGDBGITR(1,2)) THEN WRITE(UNRPT,1100) S,SUP_MIN,SUP_MAX, & TSUPQ,PSUP(S), TSUPPR,P0,Q0 ENDIF

ENDIF

ENDIF ENDDO
oNGSCRV_P(CURIYR) = oNGSCRV_P(CURIYR) / oNGSCRV_Q(CURIYR) oNGSCRV_P0(CURIYR) = oNGSCRV_P0(CURIYR) / oNGSCRV_Q0(CURIYR)

! 1000 FORMAT (' <

-------------------- with L&P

-----------------

--- >', & /'YR=',I2,' SUP_MIN SUP_MAX QSUP PSUP P(QTY) ', &

'P0 Q0 L&P', & ' YR=',I2,' ITR=',I2,' CYCLE=',I2,' (w/o ADgas)') !xxx 1000 FORMAT('YR=',I2,' SUP_MIN SUP_MAX QSUP PSUP ', & !xxx ' P(QTY) P 0 Q0net L&P', & !xxx ' YR=',I2,' ITR=',I2,' CYCLE=',I2,' (w/o ADgas)') 1005 FORMAT (' <

------------------- LNG SUPPLY

----------------

--- > NET') 1100 FORMAT(2X,I2,1X,3(2X,F6.1),3(2X,F5.2),2X,F6.1,F7.4) 1101 FORMAT(2X,I2,1X,3(2X, F6.1),3(2X,F5.2),2X,F6.1,I4)

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! ! SET BENCHMARK FACTORS FOR FORECAST YEARS BASED ON HIST YEAR RESULTS ! PFUEL_FAC PKSHR_ILNG ! PCTLP PKSHR_EMEX! CGBENCH PKSHR_ECAN

! LNG_BENCHP PKSHR_IMEX ! MEX_BENCHP PKSHR_ICAN ! NG_CENSHR PKSHR_DMD ! DISCR PKSHR_UDMD_F ! CN_DISCR P KSHR_UDMD_I ! PKSHR_SUPLM ! PKSHR_PROD ! ! SET SCALE FACTORS FOR STEO

- YR DISCR & NET WITHDRAWALS ! ! STATUS: ! ! CALLED BY: ! ! NOTE: CALLED EHISYR AND NCRL=1 ONLY ! ! = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
SUBROUTINE NGSET_BENCH IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngitminc' include 'ngtdminc' include 'ngcdmdinc' include 'nghistinc' include 'ngsteoinc'

INTEGER*4 NET,N,S,YR ! COUNTERS INTEGER*4 TOTYRS,TOTYR2 ! TOTAL YEARS FOR AVERAGING INTEGER*4 CNT ! COUNTER INTEGER*4 JENDYR ! LAST YEAR VALUE CORRE SPONDS TO IENDYR EXTERNAL RTOVALUE INTEGER RTOVALUE

REAL*4 SUM,SUM1,SUM2,SUM3 ! PLACEHOLDERS FOR YR TOT REAL*4 DISCR_AVG ! AVERAGE DISCR BEFORE CCAP ADJ REAL*4 SPLIT ! PK/OP YEAR SPLIT

CHARACTER*15 HEAD15 ! VARIABLE BEING PRINTED !

---------

JENDYR = RTOVALUE('IJUMPCAL',2030)

TOTYRS = LHISYR

- FHISYR+1

! AVERAGE CITYGATE, MEXICO, AND LNG BENCHMARK FACTORS ! USING HISTORICAL RESULTS

!

------!CCC HEAD15= "<HCG_BENCH> " HEAD15="<HCG_BENCH>ehyr" WRITE(NGOBENCH,10) HEAD15, (YR,YR=FHISYR,LHISYR) WRITE(NGOBENCH,20)

DO NET=1,NETWORK ! CITYGATE BENCH FACTOR DO N=1,DNODES SUM=0.0 CNT = 0 DO YR =2004,LHISYR

- 1 IF (YR.NE.2006) THEN ! outliers CNT = CNT + 1 SUM = SUM + HCG_BENCH(NET,N,YR) ENDIF ENDDO CGBENCH(NET,N) = SUM / CNT ! CGBENCH(NET,N) = HCG_BENCH(NET,N,LHISYR)

WRITE(NGOBENCH,30) NET,N,(HCG_BENCH(NET,N,YR), & YR=FHISYR,LHISYR), CGBENCH(NET,N) ENDDO WRITE(NGOBENCH,*) ENDDO 10 FORMAT(1X,A15,<LHISYR

- FHISYR+1>(4X,I4),4X," AVG") 20 FORMAT(2X,"NET NODE ") 30 FORMAT(3 X,I1,3X,I2,7X,<LHISYR

- FHISYR+2>F8.4)

!

------ HEAD15="<HMEX_BENCHP> " WRITE(NGOBENCH,10) HEAD15, (YR,YR=FHISYR,LHISYR) WRITE(NGOBENCH,40)

DO N=1,NMEX ! MEXICO BENCH FACTOR SUM=0.0 CNT = 0 DO YR=1993,LHISYR IF (HMEX_BENCHP(N,YR) .LT.

- 0.0001) THEN SUM = SUM + HMEX_BENCHP(N,YR) CNT = CNT + 1 ENDIF ENDDO IF (CNT.EQ.0) CNT = 1 MEX_BENCHP(N) = SUM / CNT WRITE(NGOBENCH,50) N,(HMEX_BENCHP(N,YR),YR=FHISYR,LHISYR), &

MEX_BENCHP(N) ENDDO WRITE(NGOBENCH,*) 40 FORMAT(2X," ID ") 50 FORMAT(7X,I2,7X,<LHISYR

- FHISYR+2>F8.4)

!

------ HEAD15="<HLNG_BENCHP> " WRITE(NGOBENCH,10) HEAD15, (YR,YR=FHISYR,LHISYR) WRITE(NGOBENCH,40)DO N=1,NLNGIMP ! LNG BENCH FACTOR SUM=0.0 CNT = 0 DO YR=LHISYR

- 3,LHISYR IF (HLNG_BENCHP(N,YR).LT.0.0) THEN CNT = CNT + 1 SUM = SUM + HLNG_BENCHP(N,YR) ENDIF ENDDO LNG_BENCHP(N) = SUM / CNT WRITE(NGOBENCH,50) N,(HLNG_BENCHP(N,YR),YR=FHISYR,LHISYR), &

LNG_BENCHP(N) ENDDO WRITE(NGOBENCH,*)

! AVERAGE DISCREPANCIES FOR L48 AND CANADA USING HIST INFO

!

------ HEAD15="<HCN_DISCR> " WRITE(NGOBENCH,10) HEAD15, (YR,YR=FHISYR,LHISYR) WRITE(NGOBENCH,100) 100 FORMAT(2X,"NET CANID")

DO N=1,2 ! CANADA (1=EAST, 2=WEST) DO NET=1,NETWORK SUM=0.0 CNT = 0 DO YR=1999,LHISYR

- 1 ! consistent w/l48 SUM = SUM + HCN_DISCR(NET,N,YR) CNT = CNT + 1 ENDDO CN_DISCR(NET,N) = SUM / CNT WRITE(NGOBENCH,110) NET,N, &

(HCN_DISCR(NET,N,YR),YR=FHISYR,LHISYR), & CN_DISCR(NET,N) ENDDO ENDDO WRITE(NGOBENCH,*) 110 FORMAT(3 X,I1,3X,I2,7X,<LHISYR

- FHISYR+2>F8.2)

!

------ HEAD15="<DISCR (HIST)> " WRITE(NGOBENCH,10) HEAD15, (YR,YR=FHISYR,LHISYR) WRITE(NGOBENCH,20)

! ADJUST DISCR FOR AER DIFF IN AEO2003 BEFORE TAKING AVERAGE

DO NET=1,NETWORK IF (NET .EQ. PKNET) THEN SPLIT=PKSHR_YR ELSE SPLIT=(1.

- PKSHR_YR) ENDIF DO N=1,DNODESSUM=0.0 TOTYR2 = 0.0 DO YR=FHISYR,LHISYR DISCR(NET,N,YR) = DISCR(NET,N,YR) + (DISCR_AERADJ(N,YR) * SPLIT) IF (YR.GE.1999 .AND. YR.LE.(LHISYR

- 1)) THEN

SUM = SUM + DISCR(NET,N,YR) TOTYR2 = TOTYR2 + 1 ENDIF ENDDO DISCR_AVG = SUM / TOTYR2 DO YR=LHISYR+1,JENDYR DISCR(NET,N,YR) = DISCR_AVG ENDDO WRITE(NGOBENCH,110) NET,N,(DISCR(NET,N,YR),YR=FHISYR,LHISYR), &

DISCR_AVG ENDDO WRITE(NGOBENCH,*) ENDDO ! DISCR must be set before ! calling NGSTEO_BENCHDISCR ! IF (BMYEAR .NE. EHISYR) THEN ! use steo scale factors ! CALL NGSTEO_BENCHDISCR ! generate new scale factors ! ENDIF ! !

------ ! HEAD15="<DISCR (4CAST)>" ! WRITE(NGOBENCH,60) HEAD15, (YR,YR=EHISYR+1,LHISYR+10) ! WRITE(NGOBENCH,20) ! DO NET=1,NETWORK ! DO N=1,DNODES ! WRITE(NGOBENCH, 70) NET,N,(DISCR(NET,N,YR), & ! YR=EHISYR+1,LHISYR+10) ! ENDDO ! WRITE(NGOBENCH,*) ! ENDDO 60 FORMAT(1X,A15,<IJUMPYR>(4X,I4)) ! format set to be sure enough 70 FORMAT(3X,I1,3X,I2,7X,<IJUMPYR>F8.2) ! fomrat set to be sure enough

! AVERAGE PERCENT LEASE & PLANT INFO USING HIST RESULTS

!

------ HEAD15="<HPCTLP> " WRITE(NGOBENCH,10) HEAD15, (YR,YR=FHISYR,LHISYR) WRITE(NGOBENCH,40)

DO N=1,DNODES ! EXCLUDE CA NADA SUM = 0.0TOTYR2 = 0 DO YR=1996,LHISYR SUM = SUM + HPCTLP(N,YR) TOTYR2 = TOTYR2 + 1 ENDDO PCTLP(N) = SUM / TOTYR2 WRITE(NGOBENCH,50) N,(HPCTLP(N,YR),YR= FHISYR,LHISYR), &

PCTLP(N) ENDDO WRITE(NGOBENCH,*)

!

------ HEAD15="<INTRA_FLO> " WRITE(NGOHIST,19) HEAD15, (YR,YR=FHISYR,LHISYR) WRITE(NGOHIST,120)

DO NET=1,NETWORK DO N=1,DNODES WRITE(NGOHIST,130) NET,N,(INTRA_FLO(NET,N,YR), & YR=FHISYR,LHISYR) ENDDO WRITE(NGOHIST,*) ENDDO 19 FORMAT(1X,A15,<LHISYR

- FHISYR>(5X,I4)) 120 FORMAT(2X,"NET NODE ") 130 FORMAT(3X,I2,2X,I2,7X,< LHISYR

- FHISYR+1>F9.2)

! AVERAGE INTRAREGIONAL FLOW FACTOR USING HIST INFO

!

------ HEAD15="<HFLO_FAC> " WRITE(NGOBENCH,10) HEAD15, (YR,YR=FHISYR,LHISYR) WRITE(NGOBENCH,20)

DO NET=1,NETWORK DO N=1,DNODES SUM=0.0 DO YR=FHISYR,LHISYR SUM = SUM + HFLO_FAC(NET,N,YR) ENDDO FLO_FAC(NET,N) = SUM / TOTYRS ! FLO_FAC(NET,N) = HFLO_FAC(NET,N,LHISYR) ! OVERWRITE AVG WITH LHISYR WRITE(NGOBENCH,30) NET,N,(HFLO_FAC(NET,N,YR), & YR=FHISYR,LHISYR), & FLO_FAC(NET,N) ENDDO WRITE(NGOBENCH,*) ENDDO

! AVERAGE PIPE FUEL FACTOR USING HIST INFO

!

------HEAD15="<HPFUEL_FAC> " WRITE(NGOBENCH,10) HEAD15, (YR,YR=FHISYR,LHISYR) WRITE(NGOBENCH,20)

DO NET=1,NETWORK DO N=1,TNODES SUM=0.0 CNT= 0 DO YR=LHISYR

- 5,LHISYR CNT = CNT + 1 SUM = SUM + HPFUEL_FAC(NET,N,YR) ENDDO PFUEL_FAC(NET,N) = SUM / CNT WRITE(NGOBENCH,30) NET,N,(HPFUEL_FAC(NET,N,YR), & YR=FHISYR,LHISYR), & PFUEL_FAC(NET,N) ENDDO WRITE(NGOBENCH,*) ENDDO

! AVERAGE CENSUS SHARE INFO AND PK SHARE FOR DEMANDS ! USING HISTORICAL INFO

DO S=1,DSEC

- 1 DO N=1,DNODES SUM1=0.0 SUM2=0.0 CNT= 0 DO YR=2001,LHISY R ! NOTE: years consistent for num_regshr #res houses in ngdtar (lagged ok)

SUM1 = SUM1 + HNG_CENSHR(S,N,YR) SUM2 = SUM2 + HPKSHR_DMD(S,N,YR) CNT = CNT + 1 ENDDO NG_CENSHR(S,N) = SU M1 / CNT PKSHR_DMD(S,N) = SUM2 / CNT ENDDO ENDDO

!

------ HEAD15="<HNG_CENSHR> " WRITE(NGOBENCH,10) HEAD15, (YR,YR=FHISYR,LHISYR) WRITE(NGOBENCH,80) DO S=1,DSEC

- 1 DO N=1,DNODES WRITE(NGOBENCH,30) S,N,(HNG_CENSHR(S,N,YR),YR=FHISYR,LHISYR), &

NG_CENSHR(S,N) ENDDO WRITE(NGOBENCH,*) ENDDO

!

------ HEAD15="<HPKSHR_DMD> " WRITE(NGOBENCH,10) HEAD15, (YR,YR=FHISYR, LHISYR)WRITE(NGOBENCH,80) DO S=1,DSEC

- 1 DO N=1,DNODES WRITE(NGOBENCH,30) S,N,(HPKSHR_DMD(S,N,YR),YR=FHISYR,LHISYR), &

PKSHR_DMD(S,N) ENDDO WRITE(NGOBENCH,*) ENDDO 80 FORMAT(2X,"SEC NODE ")

! AVERAGE PK SHARE FACTORS USING HIST INFO

SUM1=0.0 ! CANADA EXPORTS SUM2=0.0 ! CANADA IMPORTS SUM3=0.0 ! SUPPLEMENTAL SUPPLIES DO YR=FHISYR,LHISYR IF (YR.GE.1992) THEN SUM1 = SUM1 + HPKSHR_ECAN(YR) ENDIF SUM2 = SUM2 + HPKSHR_ICAN(YR) SUM3 = SUM3 + HPKSHR_SUPLM(YR) ENDDO PKSHR_ECAN = SUM1 / (TOTYRS

- 2) PKSHR_ICAN = SUM2 / TOTYRS PKSHR_SU PLM = SUM3 / TOTYRS

HEAD15="<HPKSHR_ECAN> " WRITE(NGOBENCH,10) HEAD15, (YR,YR=FHISYR,LHISYR) WRITE(NGOBENCH,90) (HPKSHR_ECAN(YR),YR=FHISYR,LHISYR), &

PKSHR_ECAN WRITE(NGOBENCH,*)

!

------ HEAD15="<HPK SHR_ICAN> " WRITE(NGOBENCH,10) HEAD15, (YR,YR=FHISYR,LHISYR) WRITE(NGOBENCH,90) (HPKSHR_ICAN(YR),YR=FHISYR,LHISYR), &

PKSHR_ICAN WRITE(NGOBENCH,*)

HEAD15="<HPKSHR_SUPLM> " WRITE(NGOBENCH,10) HEAD15, (YR,YR =FHISYR,LHISYR) WRITE(NGOBENCH,90) (HPKSHR_SUPLM(YR),YR=FHISYR,LHISYR), &

PKSHR_SUPLM WRITE(NGOBENCH,*) 90 FORMAT(9X,7X,<LHISYR

- FHISYR+2>F8.4)

!

------ HEAD15="<HPKSHR_ILNG> " WRITE(NGOBENCH,10) HEAD15, (YR,YR=FHISYR,LHISYR) WRITE(NGOBENCH,40)

! LNG IMPORTS SUM=0.0 DO YR=FHISYR,LHISYRSUM = SUM + HPKSHR_ILNG(YR) ENDDO DO N=1,NLNGIMP ! LNG IMPORTS PKSHR_ILNG(N) = SUM / TOTYRS WRITE(NGOBENCH,50) N,(HPKSHR_ILNG(YR),YR=FHISYR,LHISYR), &

PKSHR_ILNG(N) ENDDO WRITE(NGOBENCH,*)

SUM1=0.0 ! MEXICO EXPORTS SUM2=0.0 ! MEXICO IMPORTS DO YR=1991,LHISYR SUM1 = SUM1 + HPKSHR_EMEX(YR) ENDDO DO YR=1994,LHISYR SUM2 = SUM2 + HPKSHR_IMEX(YR) ENDDO PKSHR_EMEX = SUM1 / (TOTYRS

- 1) PKSHR_IMEX = SUM2 / (TOTYRS

- 4)

!

------ HEAD15="<HPKSHR_EMEX> " WRITE(NGOBENCH,10) HEAD15, (YR,YR=FHISYR,LHISYR) WRITE(NGOBENCH,90) (HPKSHR_EMEX(YR),YR=FHISYR,LHISYR), & PKSHR_EMEX WRITE(NGOBENCH,*)

!

------ HEAD15="<HPKSHR_IMEX> " WRITE(NGOBENCH,10) HEAD15, (YR,YR=FHISYR,LHISYR) WRITE(NGOBENCH,90) (HPKSHR_IMEX(YR),YR=FHISYR,LHISYR), &

PKSHR_IMEX WRITE(NGOBENCH,*)

!

------ HEAD15="<HPKSHR_PROD> " WRITE(NGOBENCH,10) HEAD15, (YR,YR=F HISYR,LHISYR) WRITE(NGOBENCH,40)

DO N=1,SNODES ! NG PRODUCTION IF (SUPTYPE(N).EQ.1 .OR. SUPTYPE(N).EQ.2 .OR. SUPTYPE(N).EQ.10) THEN SUM=0.0

DO YR=1994,LHISYR SUM = SUM + HPKSHR_PROD(N,YR) ENDDO PKSHR_PROD(N) = SUM / (TOTYRS

- 4)

!fixed supplies ELSEIF (SUPTYPE(N).EQ.3) THEN PKSHR_PROD(N)=PKSHR_ILNG(SUPREG(N)) ELSEIF (SUPTYPE(N).EQ.4.OR.SUPTYPE(N).EQ.5.OR.SUPTYPE(N).EQ.6) THEN PKSHR_PROD(N)=PKSHR_SUPLMELSEIF (SUPTYPE(N).EQ.7.OR.SUPTYPE(N).EQ.8) THEN PKSHR_PROD(N)=PKSHR_PROD(N

- FSRGN(7)+1) ELSEIF (SUPTYPE(N).EQ.9) THEN PKSHR_PROD(N)=PKSHR_YR ! ELSEIF (SUPTYPE(N).GE.11) THEN !NO PKSHR FOR CAN UNCONV SUP ! PKSHR_PROD(N)=PKSHR_PROD(SUPRGN(N)) ! ELSEIF (SUPTYPE(N).EQ.14) THEN !VARIABLE LNG

ENDIF WRITE(NGOBENCH,50) N,(HPKSHR_PROD(N,YR),YR=FHISYR,LHISYR), &

PKSHR_PROD(N) ENDDO WRITE(NGOBENCH,*)

DO N=1,NNGEM

- 1 SUM1=0.0 ! FIRM ELEC UTIL DMD SUM2=0.0 ! INTRP ELEC UTIL DMD DO YR=1994,LHISYR IF (N.EQ.1) THEN IF (YR.GE.1997) THEN SUM1 = SUM1 + HPKSHR_UDMD_F(N,YR) SUM2 = SUM2 + HPKSHR_UDMD_I(N,YR) ENDIF ELSE SUM1 = SUM1 + HPKSHR_UDMD_F(N,YR) SUM2 = SUM2 + HPKSHR_UDMD_I(N,YR) ENDIF ENDDO IF (N.EQ.1) THEN PKSHR_UDMD_F(N) = SUM1 / (TOTYRS

- 7) PKSHR_UDMD_I(N) = SUM2 / (TOTYRS

- 7) ELSE PKSHR_UDMD_F(N) = SUM1 / (TOTYRS

- 4) PKSHR_UDMD_I(N) = SUM2 / (TOTYRS

- 4) ENDIF ENDDO

!

- ----- HEAD15="<HSPERJAN> " WRITE(NGOBENCH,10) HEAD15, (YR,YR=FHISYR,LHISYR) !!! WRITE(NGOBENCH,10) HEAD15 WRITE(NGOBENCH,*) ' TNODES'

DO N=1,DNODES SUM1=0.0 TOTYRS=0 DO YR=1995,LHISYR SUM1 = SUM1 + HSPERJAN(N,YR) TOTYRS = TOTYRS + 1 ENDDO HSPERJAN(N,LHISYR+1) = SUM1 / TOTYRS ENDDO ! temp...4

- 15

- 04DO N=DNODES+1,TNODES DO YR=1990,LHISYR+1 HSPERJAN(N,YR) = 0.30 ENDDO ENDDO

DO N=1,TNODES WRITE(NGOBENCH,50) N,(HSPERJAN(N,YR),YR=FHISYR,LHISYR+1) !!! WRITE(NGOBENCH,50) N,SPERMTH(1,N) ENDDO WRITE(NGOBENCH,*)

!

------ HEAD15="<HPPERJAN> " WRITE(NGOBENCH,10) HEAD15, (Y R,YR=FHISYR,LHISYR) WRITE(NGOBENCH,*) ' SNODES'

DO N=1,SNODES IF (SUPARRAY(N).EQ.1) THEN SUM1=0.0 TOTYRS=0 DO YR=1990,LHISYR SUM1 = SUM1 + HPPERJAN(N,YR) TOTYRS = TOTYRS + 1 ENDDO HPPERJAN(N,LHISYR+1) = SUM1 / TOTYRS
ENDIF ENDDO

DO N=1,SNODES IF (SUPARRAY(N).EQ.1) THEN WRITE(NGOBENCH,50) N,(HPPERJAN(N,YR),YR=FHISYR,LHISYR+1) ENDIF ENDDO WRITE(NGOBENCH,*)

!

------ HEAD15="<HCPERJAN> " WRITE(NGOBENCH,10) HEAD15, (YR,YR=FHISYR,LHISYR) WRITE(NGOBENCH,*) ' DNODES'

DO S=1,DSEC DO N=1,DNODES SUM1=0.0 TOTYRS=0 DO YR=1990,LHISYR SUM1 = SUM1 + HCPERJAN(N,S ,YR) TOTYRS = TOTYRS + 1 ENDDO HCPERJAN(N,S,LHISYR+1) = SUM1 / TOTYRS ENDDO ENDDO

DO S=1,DSECWRITE(NGOBENCH,*) 'SEC = ',S DO N=1,DNODES WRITE(NGOBENCH,50) N,(HCPERJAN(N,S,YR),YR=FHISYR,LHISYR+1) ENDDO ENDDO WRITE(NGOBENCH,*)

!

------ HEAD15="<HUCPERJAN> " WRITE(NGOBENCH,10) HEAD15, (YR,YR=FHISYR,LHISYR) WRITE(NGOBENCH,*) ' NNGEM '

DO N=1,NNGEM SUM1=0.0 TOTYRS=0 DO YR=1990,LHISYR SUM1 = SUM1 + HUCPERJAN(N,YR) TOTYRS = TOTYRS + 1 ENDDO HUCPERJAN(N,LHISYR+1) = SUM1 / TOTYRS ENDDO

DO N=1,NNGEM WRITE(N GOBENCH,50) N,(HUCPERJAN(N,YR),YR=FHISYR,LHISYR+1) ENDDO WRITE(NGOBENCH,*)

!

------ HEAD15="<HPKSHR_UDMD_F>" WRITE(NGOBENCH,10) HEAD15, (YR,YR=FHISYR,LHISYR) WRITE(NGOBENCH,40) DO N=1,NNGEM

- 1 WRITE(NGOBENCH,50) N,(HPKSHR_UDMD_F(N,YR),YR=FHISYR,LHISYR), &

PKSHR_UDMD_F(N) ENDDO WRITE(NGOBENCH,*)

!

------ HEAD15="<HPKSHR_UDMD_I>" WRITE(NGOBENCH,10) HEAD15, (YR,YR=FHISYR,LHISYR) WRITE( NGOBENCH,40) DO N=1,NNGEM

- 1 WRITE(NGOBENCH,50) N,(HPKSHR_UDMD_I(N,YR),YR=FHISYR,LHISYR), &

PKSHR_UDMD_I(N) ENDDO WRITE(NGOBENCH,*)

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! ! WRITE REALIZED TARIFFS TO THE PTM OUTPUT FILE !! STATUS:

! ! CALLED BY: NGMAIN ! ! NOTE: CALLED WHEN NCRL=1 ONLY ! ! = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =

SUBROUTINE NGPTAR_OUT IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngtdminc' include 'ngitminc'

REAL*4 PKVAR,OPVAR ! TEMP HOLDING ARRAY VAR VARIABLE TARIFFS

INTEGER*4 A ! ARC NUMBER INTEGER*4 AF, AT ! "FROM" AND "TO" NODE

!

---------

WRITE(NGOPTM,1000) 1000 FORMAT(1X,'PTMTAR ',1X,'YEAR',1X,'ARC',1X,'AF',2X,'AT',1X, &

' PK FIXTAR',' OP FIXTAR', ' PK VARTAR',' OP VARTAR', & ' PK TOTTAR',' OP TOTTAR ')

DO A=1,NARCS AF = ARC_2NODE(A,1) AT = ARC_2NODE(A,2) IF ((AF.LE.TNODES) .AND. (AT.LE.TNODES)) THEN PKVAR = ARC_ENDFEE(PKNET,A)

- ARC_FIXTAR(PKNET,A,MODYR) OPVAR = ARC_ENDFEE(OPNET,A)

- ARC_FIXTAR(OPNET, A,MODYR) ! WRITE(NGOPTM,1001) MODYR, A, AF,AT, ARC_FIXTAR(PKNET,A,MODYR),
& ARC_FIXTAR(OPNET,A,MODYR),PKVAR,OPVAR,ARC_ENDFEE(PKNET,A), &

ARC_ENDFEE(OPNET,A) ENDIF ENDDO 1001 FORMAT(1X,'PTMTAR ',1X,I4,1X,I3,1X,I2,'

- >',I2,1X, 6F10.3)

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! ! WRITE AND COMPARE OLD AND NEW STORAGE TARIFFS !

-- NGSTR_VARTAR (OLD) !

-- X1NGSTR_VARTAR (NEW) ! ! STATUS: COMPLETE !! CALLED BY:

! ! FUNCTIONS USED: NGSTR_VARTAR ! X1NGSTR_VARTAR ! ! = = = = = = = = = = = = = = = = = = = = = = = = = = = = SUBROUTINE NGSTOR_OUT IMPLICIT NONE

include 'parametr' inclu de 'ncntrl' include 'ngparinc' include 'ngtdminc' include 'ngitminc' include 'ngcdmdinc'

INTEGER*4 L,A ! COUNTERS INTEGER*4 NET ! REPRESENTS PK,OP NETWORK INTEGER*4 SRC ! SOURCE NODE ALONG ARC INTEGER*4 STID ! STORAGE NODE ID (1

- 14)

REAL*4 NGSTR_VARTAR ! FUNCTION (old) REAL*4 X1NGSTR_VARTAR ! FUNCTION (new) REAL*4 Q ! FLOW ALONG AR C W/IN PK OR OP SEASON REAL*4 STR_FIXTAR(STNODES) REAL*4 STR_X0VARTAR(STNODES) REAL*4 STR_X1VARTAR(STNODES) REAL*4 STR_FLOW(STNODES) !

-------------

! TARIFF ON ALL PRIMARY ARCS

NET=1 DO A=1,NARCS SRC = ARC_2NODE(A,1) Q = FLOW(NET,A) IF (SRC .GT. (TNODES+SNODES)) THEN ! STR ARCS STID = SRC

- (TNODES+SNODES) STR_FIXTAR(STID) = ARC_FIXTAR(NET,A,MODYR) STR_X0VARTAR(STID) = NGST R_VARTAR(STID,Q) ! OLD FUNCTION STR_X1VARTAR(STID) = X1NGSTR_VARTAR(STID,Q) ! NEW FUNCTION STR_FLOW(STID) = Q

ENDIF ENDDO

WRITE(NGOPTM,10) DO STID=1,STNODES WRITE(NGOPTM,20) MODYR, CURITR, STID, STR_X1VARTAR(STID), & STR_X0VARTAR(STID), STR_FIXTAR(STID), STR_FLOW(STID) ENDDO10 FORMAT(1X,'STRTAR: ','YEAR ITR SID NEWVAR OLDVAR FIX

FLOW') 20 FORMAT(1X,'STRT AR: ',I4,I4,I4,3F8.4,F8.1)

RETURN END

!*******************************************************************

! C A N A D A !******************************************************************

SUBROUTINE NG CANADA IMPLICIT NONE

include'parametr' ! nems dimension parameters include'ncntrl' ! nems control variables include'ngparinc' include'ogsmimp' include'ogglobal'

!

------ ! IF (CURIYR.EQ.FIRSYR .AND. CURITR.EQ.1) CALL NGINIT_CAN IF (NCRL.EQ.1 .AND. CURIYR.GE.ICNBYR) CALL NGOUT_CAN(CURIYR) IF (NCRL.EQ.1) CALL NGREP_CAN(CURIYR) !ogsmcCALL OGCANADAX

RETURN END !******************************************************************

SUBROUTINE NGINIT_CAN(NGCAN) IMPLICIT NONE

include'parametr' ! nems dimension parameters include'ncntrl' ! nems control variables include'ngparinc' include'ngtdminc' include'ogsmimp' ! foreign input v ariables include'ogglobal'

INTEGER*4 I,J,K,L ! GENERIC INDICES INTEGER*4 NR ! LOOP INTEGER*4 IFLG, PRV_IFLG ! END OF DATA FLAG INTEGER*4 DELTA ! NUM YRS GROW APPLIED INTEG ER*4 IYR ! YEAR INDEX (1,2,3...) INTEGER*4 JYR ! YEAR INDEX (1,2,3...) INTEGER*4 IYEAR ! YEAR ID (1990, 1991...) INTEGER*4 NGCAN ! INPUT FILE NUMBER

REAL*4 SUMFRCAN ! TEMP HOLDING ARRAY CHARACTER*1 CH, CH1INTEGER*4 SHGAS/2/ ! ARRAY ID FOR SHALLOW GAS IN CANFUEL REAL*4 DUMMY(3) ! PLACEHOLDER FOR PROD GROWTH RATE !

------ ! READ OPTION SWITCH FOR RUNNING NEW OR OLD MEXICO AND CANADA ROUTINES

CALL NEXTDATA(NGCAN) READ(NGCAN,*) NCNMX ! READ BASE YEAR FOR RUNNING IMPORT MODULES ! em4 CALL NEXTDATA(NGCAN) READ (NGCAN,*) ICNBYR

! CONVERT ICNBYR FORMAT FROM 1990,1991, etc. to 1,2,etc. IF (ICNBYR .GE. 1900) ICNBYR = ICNBYR

- BASEYR + 1

! CHECK RELATIVE YEAR CONTROLS IF (ICNBYR.GT.ICNHYR+1 .OR. ICNBYR.LE.1) WRITE(NGUNIT,6) ICNBYR,ICNHYR 6 FORMAT(1X,'ERROR OGSM: ICNBYR > ICNHYR OR (2 ',I2,' vs ', I2,' )')

! READ CUM WELLS DRILLED AS OF BEG YR 1990 CALL NEXTDATA(NGCAN) READ (NGCAN,*) I, HCUMSUCWEL(1)

! READ HISTORICAL WELLS DRILLED DO IYR=1,ICNHYR READ (NGCAN,*) IYEAR, HISTWELCAN(IYEAR

- 1989) HCUMSUCWEL(IYR+1) = HCUMSUCWEL(IYR) + HISTWELCAN(IYR) ENDDO

! READ RECOVERABLE RESOURCE ESTIMATE ! (NOTE: CURRENTLY 1990 (or 1989?) DATA. IF UPDATED TO NEW YEAR, ! THEN NEED TO CHANGE CODE IN NGOUT_CAN) CALL NEXTDATA(NGCAN) READ (NGCAN,*) RESBASYR,RESBASE

! READ RESERVES TECH FACTOR CALL NEXTDATA(NGCAN) READ (NGCAN,*) RESTECH

! READ HISTORICAL BEGINNING OF YEAR RESERVES CALL NEXTDATA(NGCAN) DO IYR=1,ICNHYR+1 READ (NGCAN,*) IYEAR, HISTRESCAN(IYEAR

- 1989) ENDDO

! CALCULATE HIST RESERVE ADDITIONS, P/R RATIOS, AND FINDING RATES SUMFRCAN = 0.0 DO IYR=1,ICNHYR HISTRESAD(IYR) = HISTRESCAN(IYR+1)

- HISTRESCAN(IYR) + & oOGCNQPRD(SHGAS,IYR) HISTPRRCAN(IYR) = oOGCNQPRD(SHGAS,IYR) / HISTRESCAN(IYR) HISTFRCAN(IYR) = HISTRESAD(IYR) / HISTWELCAN(IYR) SUMFRCAN = SUMFRCAN + HISTFRCAN(IYR)ENDDO

FRCAN = SUMFRCAN / ICNHYR

! ACCUMULATE RESERVE ADDITIONS TO FROM RESOURCE BASE YEAR FORWARD CUMRCAN = 0.0 IF ((RESBASYR

- BASEYR+1) .LT. ICNBYR) THEN DO IYR=RESBASYR

- BASEYR+1,ICNBYR

- 1 CUMRCAN = CUMRCAN + HISTRESAD(IYR) ENDDO ENDIF

! REPORT INITIAL 1990 IMPORT VALUES TO NEMS ! INITIALIZE THE CANADIAN ELASTICITY

DO IYR=1,ICNHYR oOGPRRCAN(SHGAS,IYR) = HISTPRRCAN(IYR) oOGRESCAN(SHGAS,IYR) = HISTRESCAN(IYR) ENDDO

oOGRESCAN(SHGAS,ICNHYR+1) = HISTRESCAN(ICNHYR+1) ! oOGPRRCAN(SHGA S,ICNHYR+1) = 0.105 ! FIRST STEO YEAR

! READ CANADIAN EQUATION OPTIONS

CALL NEXTDATA(NGCAN) READ (NGCAN,*) WLMETH, FRMETH, PRMETH

! ASSIGN VARIABLES THAT ARE USED FOR SUMMARY REPORTING DO IYR=1,ICNHYR CANPCAP(IYR) = HISTRESCAN(IYR) * HISTPRRCAN(IYR) ! productive capc in year t

REPWELLS(IYR) = HISTWELCAN(IYR) ! successful gas wells

REPRSVCAN(IYR) = HISTRESCAN(IYR) ! begin of year t RE PADDCAN(IYR) = HISTRESAD(IYR) ! year t

REPPRDCAN(IYR) = oOGCNQPRD(SHGAS,IYR) ! year t REPFRCAN(IYR) = HISTFRCAN(IYR) ! year t ENDDO REPRSVCAN(ICNHYR+1) = HISTRESCAN(ICNHYR+1)

RETURN END

!******************************************************************** !This is a function to compute Canadian well finding rates, well success !rates and the Canadian production to reserves ratio. These values are !computed from e conometric functions estimated by Ernie Zampelli. !*********************************************************************

SUBROUTINE NGOUT_CAN(IYR) IMPLICIT NONEinclude'parametr' ! nems dimension parameters include'ncntrl' ! nems control variables include'ngparinc' include'ngtdminc' include'ogsmimp' ! foreign input variables include'ogglobal'

REAL*4 CX(20) !

REAL*4 SUCWELLAG ! GAS WELLS LAST YEAR REAL*4 CN_PRC00 ! ALB PRICE IN 2000 US$ PER CUBIC FOOT REAL*4 CN_P00LAG ! LAGGED VALUE OF CN_PRC92 REAL*4 URRLAG ! LAST YEARS REMAINING RESOURCES (BOY) REAL*4 RLYR ! REAL VERSION OF YEAR REAL*4 FRLAG ! LAST YEAR'S FRCAN REAL*4 ROY_ADJ ! ADJUSTMENT TO PRICE TO ACCNT FOR CH IN ALB ROYALTY RATE REAL*4 ROY_ADJLAG ! LAGGED VALUE OF ROY_ADJ REAL*4 EXSPEND00 ! REAL*4 EXSPEND00LAG ! LA GGED VALUE OF EXSPEND00 REAL*4 EXSPEND00LG2 ! TWO YEAR LAGGED VALUE OF EXSPEND00 REAL*4 CST_PRXY ! proxy for estimated drilling cost of a canadian NG well REAL*4 CST_PRXYLAG REAL*4 EXSP2PRX_XVAR ! x variable for regressi on estimate of relationship between EXPEND and CST_PRXY REAL*4 EXSP2PRX_INT ! intercept for regression estimate of relationship between EXPEND and CST_PRXY REAL*4 TECHADJ ! ADJUSTMENT IF RUNNING HIGH OR LOW OIL & GAS TECH CASE REAL*4 TECHAMT ! AMOUNT TECHNOLOGY IS BEING ADJUSTED IN PERCENTAGE TERMS

EXTERNAL RTOVALUE INTEGER RTOVALUE

INTEGER*4 I,J,K,L ! GENERIC INDICES INTEGER*4 TECHSWT ! INDICATOR OF HIGH/LOW/REF TECH 0

- LOW, 1

- REF, 2

- H IGH INTEGER*4 YEAR ! EXECUTION YEAR (1990, 1991, ...) INTEGER*4 IYR ! EXECUTION YEAR (1, 2, ...) INTEGER*4 SHGAS/2/ ! ARRAY POSITION FOR SHALLOW GAS IN CANFUEL INTEGER*4 ICNT ! YEAR COUNTER
DATA EXSP2PRX_XVAR/1713.2/ DATA EXSP2PRX_INT/143872.6/

!

--------------

YEAR = IYR + BASEYR

- 1 RLYR = REAL(YEAR)

TECHSWT = RTOVALUE('OGTECH ',1) TECHAMT = RTOVALUE('OGTECADJ',0)TECHADJ = 1.0 IF (TECHSWT. EQ.0) TECHADJ = 1.

- TECHAMT/100. IF (TECHSWT.EQ.2) TECHADJ = 1.+TECHAMT/100.
CN_PRC00 = oOGCNPPRD(SHGAS,CURIYR) * oMC_PCWGDP(11)/oMC_PCWGDP(

- 2) EXSPEND00 = oEXSPEND(1,IYR) * oMC_PCWGDP(11)/oMC_PCWGDP(

- 2) CST_PRXY = oEXSPEND(1,IYR) * EXSP2PRX_XVAR + EXSP2PRX_INT ! calculate canadian well cost proxy using regression equation EXSPEND00LAG = oEXSPEND(1,IYR

- 1) * oMC_PCWGDP(11)/oMC_PCWGDP(

- 2) CST_PRXYLAG = oEXSPEND(1,IYR

- 1) * EXSP2PRX_XVAR + EXSP2PRX_INT EXSPE ND00LG2 = oEXSPEND(1,IYR

- 2) * oMC_PCWGDP(11)/oMC_PCWGDP(

- 2)

! ASSIGN LAGGED VALUES FOR FIRST YEAR CALLED (ICNBYR)

IF (IYR .EQ. ICNBYR) THEN
CN_P00LAG = oOGCNPPRD(SHGAS,IYR

- 1) * oMC_PCWGDP(11)/oMC_PCWGDP(

- 2)

PRRATCAN = 0.0

ICNT = 0 DO K = ICNBYR

- 6,ICNBYR

- 1 PRRATCAN = PRRATCAN + HISTPRRCAN(K) ICNT = ICNT + 1 ENDDO PRRATCAN = PRRATCAN / ICNT

CURRESCAN = HISTRESCAN(IYR) ! beginning of yr CURPRRCAN = HISTPRRCAN(IYR

- 1) SUCWELLAG = HISTWELCAN(IYR

- 1) FRLAG = HISTFRCAN(IYR

- 1) URRLAG = RESBASE

- CUMRCAN + HISTRESAD(ICNBYR

- 1) ELSE CURRESCAN = RESBOYCAN ! beginning of yr CURPRRCAN = PRRATCAN SUCWELLAG = SUCWELL FRLAG = FRCAN URRLAG = URRCAN ENDIF

! SET REMAINING RESOURCES, CHECK GREATER THAN 0

IF (IYR .GE. (RESBASYR

- BASEYR+1)) THEN K = IYR + BASEYR

- 1

- RESBASYR UR RCAN = (RESBASE*(1.+RESTECH)**K)

- CUMRCAN WRITE(NGUNIT,*) ' CAN REMAIN RESOURCE= ',IYR,URRCAN IF (URRCAN .LE. 0.0) WRITE(NGUNIT,*) "ATTN NGOUT_CAN: ", &

"NO MORE GAS RESV IN CAN IN ", YEAR, & " CUMRCAN= ",CUMR CAN," URRCAN= ",URRCAN ELSE URRCAN = RESBASE ENDIF

!

-------------------------------------------------------------------! COMPUTE NUMBER OF SUCCESSFUL GAS WELLS DRILLED (NEW EQ, 7

- 15

- 99)

! IMPLEMENT QUICK ADJUSTMENT TO WELLHEAD PRICE TO CAPTURE ! IMPACT OF CHANGE IN ALBERTA ROYALTY TREATMENT STARTING IN 2009 (IYR=20), BUT IMPACT STARTED EARLIER ! APPROXIMATED BY ASSUMING AVERAGE WCSB ROYALTY RATE GOES FROM 35 TO 50 PERCENT, ! HOWEVER ALBERTA IS ONLY PART OF WCSB, SO THIS IS ! MODELED AS A SEEING AN EFFECTIVE PRICE THAT IS 90 PERCENT OF THE ACTUAL PRICE ! FOR THE PURPOSES OF DRILLING DECISIONS.

! IF (CURIYR.GE.10) THEN ! ROY_ADJ = 0.90 ! ROY_ADJLAG = 0.90 ! IF (CURIYR.EQ.20) ROY_ADJLAG = 1.0 ! ELSE

ROY_ADJ = 1.00 ROY_ADJLAG = 1.00 ! ENDIF

! ESTIMATED WELLS EQUATIONS FOR AEO2008 TESTS

IF (WLMETH.EQ.9) THEN CX(1) = EXP(3.95973) CX(2) = (CN_PRC00*ROY_ADJ)**0.506617 CX(3) = EXP((0.0000116340*URRCAN)+(33.7870*oOGCNQPRD(SHGAS,IYR

1)/CURRESCAN))

CX(4) = 1.0 CX(5) = 1.0 ELSEIF (WLMETH.EQ.10) THEN CX(1) = EXP(2.74600) CX(2) = (CN_PRC00*ROY_ADJ)**0.862006 CX(3) = EXP((0.0000139784*URRCAN)+(0.000671181*oOGCNQPRD(SHGAS,IYR

- 1)))

CX(4) = 1.0 CX(5) = 1.0

! ESTIMATED WELLS EQUATIONS FOR AEO2009 TESTS ELSEIF (WLMETH.EQ.11) THEN CX(1) = EXP(

- 1.24038) CX( 2) = (CN_PRC00*ROY_ADJ)**1.10382 CX(3) = URRCAN**1.52862 CX(4) = CST_PRXYLAG**

- .863675 CX(5) = EXP(33.6137*CURPRRCAN) ELSEIF (WLMETH.EQ.12) THEN CX(1) = EXP(55.1593)* ((CN_PRC00*ROY_ADJ)**.790215) CX(2) = URRC AN**(

- 3.06841) * EXSPEND00LAG**(

- .857788) CX(3) = SUCWELLAG**.610569 * EXP(

- .610569*55.1593) CX(4) = (CN_P00LAG*ROY_ADJLAG)**(

- .610569 * .790215) * URRLAG**(

- .610569*(

- 3.06841))

CX(5) = EXSPEND00LG2**(

- .610569 * (

- .857788)) ELSEIF (WLMETH.EQ.13) THENCX(1) = EXP(3.27462 + .457621*(CN_PRC00*ROY_ADJ)) CX(2) = EXP(.0000124107*URRCAN + .000650684*oOGCNQPRD(SHGAS,IYR

1)) CX(3) = EXP(

- .00000123237*EXSPEND00LAG)

CX(4) = 1 CX(5) = 1

! ESTIMATED WELLS EQUATION FOR AEO2010 TESTS ELSEIF (WLMETH.EQ.14) THEN CX(1) = EXP(

- 1.85639) CX(2) = (CN_PRC00*ROY_ADJ)**(1.09939) CX(3) = URRCAN**(1.57373)

! EPA RIA MODIFICATION TO FIX CANADIAN DRILLING COST TO BASELINE MODEL RUN VALUES ! OTHERWISE LAGGED COSTS WOULD CHANGE WITH US DRILLING COSTS AS AFFECTED BY RULES ! PLEASE SEE REGULATORY IMPACT ANALYSIS OF FINAL RULE FOR DETAILS

IF (YEAR.EQ.2009) THEN CST_PRXYLAG = 2815799 ELSEIF (YEAR.EQ.2010) THEN CST_PRXYLAG = 3499820 ELSEIF (YEAR.EQ.2011) THEN CST_PRXYLAG = 2321756 ELSEIF (YEAR.EQ.2012) THEN CST_PRXYLAG = 2460345 ELSEIF (YEAR.EQ.2013) THEN CST_PRXYLAG = 2504752 ELSEIF (YEAR.EQ.2014) THEN CST_PRXYLAG = 2523222 ELSEIF (YEAR.EQ.2015) THEN CST_PRXYLAG = 2543908 ELSEIF (YEAR.EQ.2016) THEN CST_PRXYLAG = 2554816 ELSEIF (YEAR.EQ.2017) THEN CST_PRXYLAG = 2564521 ELSEIF (YEAR.EQ.2018) THEN CST_PRXYLAG = 2583774 ELSEIF (YEAR.EQ.2019) THEN CST_PRXYLAG = 2596805 ELSEIF (YEAR.EQ.2020) THEN CST_PRXYLAG = 2607224 ELSEIF (YEAR.EQ.2021) THEN CST_PRXYLAG = 2596668 ELSEIF (YEAR.EQ.2022) THEN CST_PRXYLAG = 2591398 ELSEIF (YEAR.EQ.2023) THEN CST_PRXYLAG = 2579989 ELSEIF (YEAR.EQ.2024) TH EN CST_PRXYLAG = 2572767 ELSEIF (YEAR.EQ.2025) THEN CST_PRXYLAG = 2563646 ELSEIF (YEAR.EQ.2026) THENCST_PRXYLAG = 2557042 ELSEIF (YEAR.EQ.2027) THEN CST_PRXYLAG = 2528627 ELSEIF (YEAR.EQ.2028) THEN CST_PRXYLAG = 2501563 ELSEI F (YEAR.EQ.2029) THEN CST_PRXYLAG = 2446046 ELSEIF (YEAR.EQ.2030) THEN CST_PRXYLAG = 2423669 ELSEIF (YEAR.EQ.2031) THEN CST_PRXYLAG = 2392212 ELSEIF (YEAR.EQ.2032) THEN CST_PRXYLAG = 2382544 ELSEIF (YEAR.EQ.2033) THEN CST_PRXYLAG = 2366408 ELSEIF (YEAR.EQ.2034) THEN CST_PRXYLAG = 2353248 ELSEIF (YEAR.EQ.2035) THEN CST_PRXYLAG = 2351632 ENDIF

CX(4) = CST_PRXYLAG**(

- 0.86063) CX(5) = EXP(33.6237*CURPRRCAN) ENDIF

SUCWELL = CX(1) * CX(2) * CX(3) * CX(4) * CX(5) SUCWELL = AMIN1(SUCWELL,1.3*SUCWELLAG)

! ADJUST WELLS FOR TECH ASSUMPTION

IF (IYR.GE.ICNBYR+1) THEN SUCWELL = SUCWELL * (1.+ (REAL(IYR

- (ICNBYR+1))/REAL(IJUMPYR

- (ICNBYR+1))*(TECHADJ

- 1.)*0.2 00)) ENDIF

IF(IYR .EQ. 19) SUCWELL = 8104.0

!

-------------------------------------------------------------------
! COMPUTE THE FINDING RATES USED TO CALC RESV ADD (eoy for t) ! AND BOY RESV FOR t+1 (new eq. 7

- 16

- 99) ! (CONVERT FROM MILLIONS CF TO BCF)

! METHODS 6

- 11 FOR AEO2008

IF (URRCAN.GT. 0.0) THEN IF (FRMETH.EQ.6) THEN FRCAN = EXP(((1.

- 0.384096)*

- 2.43218)+(0.0000166026*URRCAN)) & * EXP(

- 0.384096*0.0000166026*URRLAG) E LSEIF (FRMETH.EQ.7) THEN FRCAN = EXP(

- 1.88786+(0.000012952*URRCAN)) ELSEIF (FRMETH.EQ.8) THEN FRCAN = EXP(

- 16684.7 + (1305.85*alog(URRCAN)) &+ (

- 0.054490*SUCWELL)+(0.0000271706*SUCWELL*RLYR) & + (

- 0.642102*alog(URRCAN)*RLYR) + (8.21678*RLYR) &

- 0.337108 * (

- alog(FRLAG)

- 16684.7 & + (1305.85*alog(URRLAG)) + (

- 0.054490*SUCWELLAG) & + (0.0000271706*SUCWELLAG*(RLYR

- 1.)) & + (

- 0.642102*alog(URRLAG)*(RLYR

- 1.)) & + (8.21678*(RLYR

- 1.) ) ) ) ELSEIF (FRMETH.EQ.9) THEN FRCAN = EXP(

- 6846.08 + (495.193*alog(URRCAN)) &

+ (

- 0.057321*SUCWELL)+(0.0000286537*S UCWELL*RLYR) & + (

- 0.236841*alog(URRCAN)*RLYR) + (3.29776*RLYR) &

- 0.343877 * (

- alog(FRLAG)

- 6846.08 & + (495.193*alog(URRLAG)) + (

- 0.057321*SUCWELLAG) &
+ (0.0000286537*SUCWELLAG*(RLYR

- 1.)) & + (

- 0.236841*alog(URRLAG)*(RLYR

- 1.)) & + (3.29776*(RLYR

- 1.) ) ) ) ELSEIF (FRMETH.EQ.10) THEN FRCAN = EXP(((1.

- 0.411435)*

- 29.0225)+(2.44927*alog(URRCAN))) & * EXP(

- 0.411435*2.44927*alog(URRLAG)) ELSEIF (FRMETH.EQ.11) THEN FRCAN = EXP(

- 21.1713+(1.78396*alog(URRCAN))) ENDIF ELSE FRCAN = 0.0 ENDIF

! METHODS 12

- 17 FOR AEO2009 IF (URRCAN.GT. 0.0) THEN IF (FRMETH.EQ.12) THEN FRCAN = EXP(((1.

- 0.385615)*

- 2.36119)+(0.0000162215*URRCAN)) & * EXP(

- 0.385615*0.00001662215*URRLAG) ELSEIF (FRMETH.EQ.13) THEN FRCAN = EXP(

- 1.86173+(0.0000127846*URRCAN)) ELSEIF (FRMETH.EQ.14) THEN FRCAN = EXP( (1

- .335483)*(

- 17163.7) + (1348.98*alog(URRCAN)) &

+ (

- .052234*SUCWELL)+(.0000260303*SUCWELL*RLYR) & + (

- .664321*alog(URRCAN)* RLYR) + (8.46401*RLYR) &

- .335483 * (

- alog(FRLAG) & + (1348.98*alog(URRLAG)) + (

- .052234*SUCWELLAG) & + (.0000260303*SUCWELLAG*(RLYR

- 1.)) & + (

- .664321*alog(URRLAG)*(RLYR

- 1.)) & + (8.46401*(RLYR

- 1.) ) ) ) ELSEIF (FRMETH.EQ.15) THEN FRCAN = EXP( (1

- .337462)*(

- 6939.58) + (522.221*alog(URRCAN)) &

+ (

- .043769*SUCWELL)+(.0000218360*SUCWELL*RLYR) & + (

- .253779*alog(URRCAN)*RLYR) + (3.38472*RLYR) &

- .337462 * (

- alog(FRLAG) & + (522.221*alog(URRLAG)) + (

- .043769*SUCWELLAG) & + (.0000218360*SUCWELLAG*(RLYR

- 1.)) & + (

- .253779*alog(URRLAG)*(RLYR

- 1.)) & + (3.38472*(RLYR

- 1.) ) ) ) ELSEIF (FRMETH.EQ.16) THEN FRCAN = EXP( (1

- .417206)*(

- 27.3542) + (2.31124*alog(URRCAN)) &

+ (.417206*alog(FRL AG)) &+ (

- .417206*2.31124*alog(URRCAN)) ) ELSEIF (FRMETH.EQ.17) THEN FRCAN = EXP(

- 20.0959 + 1.69380*alog(URRCAN) )

ENDIF ELSE FRCAN = 0.0 ENDIF

! METHOD 18 FOR AEO2010 IF (URRCAN .GT. 0.0) THEN IF(FRMETH .EQ. 18) THEN CX(1) = EXP((1

- .428588)*(

- 25.3204)) CX(2) = URRCAN**2.13897 CX(3) = FRLAG**0.428588 CX(4) = URRLAG**(

- 0.428588*2.13897) FRCAN = CX(1)*CX(2)*CX (3)*CX(4) ENDIF ELSE FRCAN = 0.0 ENDIF

RESADCAN = FRCAN * SUCWELL

!

----------------------------------------------------------------------

! COMPUTE THE TOTAL BEGINING

- OF

- YEAR RESERVES (IYR + 1) ! RESBOYCAN = CURRESCAN+RESADCAN

- oOGCNQPRD(SHGAS,IYR)

! ACCUMULATE THE RESERVE ADDITIONS FOR CALCULATION OF DELTA CUMRCAN = CUMRCAN + RESADCAN

! ASSIGN VARIABLES THAT ARE USED FOR SUMMARY REPORTING CANPCAP(IYR) = CURRESCAN * CURPR RCAN ! productive capc in year t REPWELLS(IYR) = SUCWELL ! successful gas wells REPRSVCAN(IYR) = CURRESCAN ! begin of year t REPADDCAN(IYR) = RESADCAN ! year t REPPRDCAN(IYR) = oOGCN QPRD(SHGAS,IYR) ! year t REPFRCAN(IYR) = FRCAN ! year t

! ASSIGN P/R RATIO OF RESERVE ADDITIONS EQUAL TO THE DECLINE RATE

! P/R RATIO VERSIONS FOR AEO2008

IF (PRMETH.EQ.2) THEN CX(1) = 6.74410 + (0.1 22492*ALOG(SUCWELL))+(0.050524*ALOG(FRCAN)) + (

- 0.885850*ALOG(URRCAN))CX(2) =

-

0.950196*(6.74410+(0.122492*ALOG(SUCWELLAG))+(0.050524*ALOG(FRLAG)) + (

- 0.885850*ALOG(URRLAG)))

PRRATCAN = (EXP(CX(1)) / (1.+EXP(CX(1)))) * ((PRRATCAN/(1.

- PRRATCAN))**0.950196) * EXP(CX(2)) ELSEIF (PRMETH.EQ.3) THEN CX(1) =

- 3.72743 + (0.125691*ALOG(SUCWELL))+(0.041256*ALOG(FRCAN))

CX(2) =

- 0.988484*(

- 3.72743+(0.125691*ALOG(SUCWELLAG))+(0.041256*ALOG(FRLAG)))

PR RATCAN = (EXP(CX(1)) / (1.+EXP(CX(1)))) * ((PRRATCAN/(1.

- PRRATCAN))**0.988484) * EXP(CX(2)) ELSEIF (PRMETH.EQ.4) THEN CX(1) =

- 77.7839 + (0.113017*ALOG(SUCWELL))+(0.040648*ALOG(FRCAN)) + (0.037233*RLYR)

CX(2) =

- 0.906469*(

- 77.7839+(0.113017*ALOG(SUCWELLAG))+(0.040648*ALOG(FRLAG)) + (0.037233*(RLYR

- 1.)))

PRRATCAN = (EXP(CX(1)) / (1.+EXP(CX(1)))) * ((PRRATCAN/(1.

- PRRATCAN))**0.906469) * EXP(CX(2)) ELSEIF (PRMETH.EQ.5) THEN PRR ATCAN = EXP((1.

- 0.949676)*5.95044)*(SUCWELL**0.115415)*(FRCAN**0.047450)*(URRCAN**

- 0.819842) & *(PRRATCAN**0.949676)*(SUCWELLAG**(

- 0.949676*0.115415))*(FRLAG**(

- 0.949676*0.047450)) & *(URRLAG**(

- 0.949676*

- 0.819842)) ELSEIF (PRMETH.EQ.6) THEN PRRATCAN = EXP((1.

- 0.988042)*

- 3.74209)*(SUCWELL**0.118412)*(FRCAN**0.038878) & *(PRRATCAN**0.988042)*(SUCWELLAG**(

- 0.988042*0.118412))*(FRLAG**(

- 0.988042*0.038878)) ELSEIF (PRMETH.EQ.7) THEN PRRATCAN = EXP((1.

- 0.905261)*

- 72.6293)*(SUCWELL**0.106506)*(FRCAN**0.038305)*EXP(0.034636*RLYR) & *(PRRATCAN**0.905261)*(SUCWELLAG**(

- 0.905261*0.106506))*(FRLAG**(

- 0.905261*0.038305)) & *EXP(

- 0.905261*.034636*(RLYR

- 1.)) ! P/R RATIO VERSIONS AEO2009 ELSEIF (PRMETH.EQ.8) THEN CX(1) = 4.37378 + (0.126575*ALOG(SUCWELL))+(0.049724*ALOG(FRCAN)) + (

- 0.689723*ALOG(URRCAN))

CX(2) =

- 0.960640*(4.37378+(0.126575*ALOG(SUCWELLAG) )+(0.049724*ALOG(FRLAG)) + (

- 0.960640*ALOG(URRLAG)))

PRRATCAN = (EXP(CX(1)) / (1.+EXP(CX(1)))) * ((PRRATCAN/(1.

- PRRATCAN))**0.960640) * EXP(CX(2)) ELSEIF (PRMETH.EQ.9) THEN CX(1) =

- 3.72717 + (0.125726*ALOG(SUCWELL))+(0.041304*ALOG(FR CAN))

CX(2) =

- 0.988834*(

- 3.72717+(0.125726*ALOG(SUCWELLAG))+(0.041304*ALOG(FRLAG)))

PRRATCAN = (EXP(CX(1)) / (1.+EXP(CX(1)))) * ((PRRATCAN/(1.

- PRRATCAN))**0.988834) * EXP(CX(2))ELSEIF (PRMETH.EQ.10)THEN CX(1) =

- 74.5150 + (0.115314*ALOG(SUCWELL))+(0.041412*ALOG(FRCAN)) + (0.035578*RLYR)

CX(2) =

- 0.912281*(

- 74.5150+(0.115314*ALOG(SUCWELLAG))+(0.041412*ALOG(FRLAG)) + (0.035578*(RLYR

- 1.)))

PRRATCAN = (EXP(CX(1)) / (1.+EXP(CX(1)))) * ((PRR ATCAN/(1.

- PRRATCAN))**0.912281) * EXP(CX(2)) ELSEIF (PRMETH.EQ.11) THEN PRRATCAN = EXP( 3.79347 + .119141*ALOG(SUCWELL) + .046723*ALOG(FRCAN) + (

- .641383)*ALOG(URRCAN) &

- .959920*(3.79347

- ALOG(PRRATCAN) + .119141*ALO G(SUCWELLAG) + .046723*ALOG(FRLAG) &

+ (

- .641383)*ALOG(URRCAN)) ) ELSEIF (PRMETH.EQ.12) THEN PRRATCAN = EXP(

- 3.74061 + .118366*ALOG(SUCWELL) + .038894*ALOG(FRCAN) &

- .988435*(

- 3.74061

- ALOG(PRRATCAN) + .1 18366*ALOG(SUCWELLAG) +.038894*ALOG(FRLAG)) ) ELSEIF (PRMETH.EQ.13) THEN PRRATCAN = EXP(

- 69.6324 +.108585*ALOG(SUCWELL) + .038994*ALOG(FRCAN) + .033118*RLYR &

- .911224*(

- 69.6324

- PRRATCAN + .108585*ALOG(SUCWELLAG) + .0389 94*ALOG(FRLAG) &

+ .0331188*(RLYR

- 1.)) ) ! P/R RATIO VERSIONS AEO2010 ELSEIF (PRMETH .EQ. 14) THEN CX(1) =

- 72.1364 + (0.117911*ALOG(SUCWELL))+(0.041469*ALOG(FRCAN)) + (0.03437*RLYR)

CX(2) = ((PRRATCAN/(1.

- PRRATCAN ))**0.916835) CX(3) =

- 0.916835*(

- 72.1364+(0.117911*ALOG(SUCWELLAG))+(0.041469*ALOG(FRLAG)) + (0.03437*(RLYR

- 1.)))

PRRATCAN = (EXP(CX(1))/(1.+EXP(CX(1))))*CX(2)*EXP(CX(3))
ENDIF

! BIND THE ANNUAL CHANGE IN THE PR RATIO

IF (IYR.GE.ICNBYR+3) THEN PRRATCAN = AMIN1(CURPRRCAN*1.05,PRRATCAN,0.12) PRRATCAN = AMAX1(CURPRRCAN*0.95,PRRATCAN,0.07) ENDIF

! REPORT COMPUTED VALUES TO NEMS IF (IYR.LT.IJUMPYR) THEN oOGPRRCAN(SHGAS,IYR+1) = PRRATCAN ! temp: em4 4

- 8

- 98 oOGRESCAN(SHGAS,IYR+1) = RESBOYCAN ! temp: em4 4

- 8

- 98 ENDIF
CN_P00LAG = CN_PRC00 ! FOR NEXT YEAR

RETURN END!********************************** ********************************

SUBROUTINE NGREP_CAN(IYR) IMPLICIT NONE

include'parametr' ! nems dimension parameters include'ncntrl' ! nems control variables include'ngparinc' include'ngtdminc' incl ude'ogsmimp' ! foreign input variables include'ogglobal'

REAL*4 NGCANOUT(9,MNUMYR) INTEGER*4 WEST/2/ ! ARRAY ID FOR WESTERN GAS INTEGER*4 K,IYR ! REPORTING YEAR INTEGER*4 R ! INDEX

!

--------------

! COMPUTE THE TOTAL FLOW AND CAPACITY

IF (PRTDBGG.EQ.1 ) THEN WRITE(NGUNIT,*) WRITE(NGUNIT,*) ' CURRENT YEAR', IYR+1989 WRITE(NGUNIT,*) ' ****************************************' WRITE(NGUNIT,* ) ' ***** CANADIAN RESERVES ACCOUNTING *****' WRITE(NGUNIT,*) ' GAS UNITS = BCF' WRITE(NGUNIT,*) ' ****************************************' WRITE(NGUNIT,*) WRITE(NGUNIT,700) WRITE(NGUNIT,*) WRITE (NGUNIT,801) FRCAN WRITE(NGUNIT,803) PRRATCAN WRITE(NGUNIT,*) WRITE(NGUNIT,804) RESADCAN WRITE(NGUNIT,805) CUMRCAN WRITE(NGUNIT,806) RESBOYCAN WRITE(NGUNIT,820) URRCAN WRITE(NGUNIT,*) WRITE(NGUNIT,812) SUCWELL WRITE(NGUNIT,*) WRITE(NGUNIT,814) oOGCNQPRD(WEST,IYR) WRITE(NGUNIT,816) CANPCAP(IYR) ENDIF

700 FORMAT(42X,'GAS')

801 FORMAT(1X,'FINDING RATE PARAMETER (FRCAN)',3X,F12.5,10X,F12.5) 803 FORMAT(1X,'P/R RATIO (PRRATCAN) ',3X,E12.5,10X,E12.5) 804 FORMAT(1X,'RESERVE ADDITIONS (RESADCAN) ',3X,F12.2,10X,F12.2) 805 FORMAT(1X,'CUMALATIVE RESERVES (CUMRCAN) ',3X,F12.2,10X,F12.2) 806 FORMAT(1X,'EOY RESERVES (RESBOYCAN) ',3X,F12.2,10X,F12.2) 812 FORMAT(1X,'SUCCESSFUL WELLS (WELLS) ',3X,F12.2,10X,F12.2) 814 FORMAT(1X,'CANADIAN PRODUCTION(oOGCNQPRD)',3X,F12.2,10X,F12.2)816 FORMAT(1X,'CANADIAN PRODUCTIVE CAPACITY ',3X,F12.2,10X,F12.2)

820 FORMAT(1X,'RECOVERABLE RESOURCES (URRCAN)',3X,F12.2,10X,F12.2)

! ASSIGN CANADIAN REPORTING VARIABLES AND WRITE SUMMARY REPORT

IF (CURIYR.EQ.LASTYR) THEN DO K=1,LASTYR NGCANOUT(1,K) = CANPCAP(K) NGCANOUT(2,K) = REPPRDCAN(K) NGCANOUT(3,K) = oOGQNGEXP(MNUMBX

- 3,K) NGCANOUT(5,K) = REPRSVCAN(K) NGCANOUT(6,K) = REPADDCAN(K) NGCANOUT(7,K) = REPFRCAN(K) NGCANOUT(8,K) = REPWELLS(K) NGCANOUT(9,K) = oOGCNPPRD(2,K ) IF (REPRSVCAN(K).NE.0.) NGCANOUT(4,K) = REPPRDCAN(K) / REPRSVCAN(K)

ENDDO

WRITE(NGUNIT,900) 900 FORMAT(2X,55('

- '),/,2X,'

--- ',3X,'CANADIAN NATURAL GAS SUPPLY ',
& 'AND DISPOSITION',2X,'

--- ',/,2X,55('

- '))

WRITE(NGUNIT,910) 910 FORMAT(9X,'PRODUCTIVE',33X,'P/R',17X,'RESERVE',5X,'FINDING',7X,
& 'GAS',8X,'WELLHEAD',/, &

2X,'YEAR',5X,'TARGET',5X,'PRODUCTION',4X,'IMPORTS', & 7X,'RATIO',4X,'RESERVES',4X,'ADDITIONS' ,5X,'RATES', & 7X,'WELLS',8X,'PRICE') WRITE(NGUNIT,920) (K+IBASYR

- 1,(NGCANOUT(R,K),R=1,9),K=1,LASTYR) 920 FORMAT(31(3X,I4,3F12.2,F12.4,5F12.2/))
ENDIF

RETURN END

!=============================================== ===================

! ROUTINE TO ADJUST CANADIAN UNCONVENTIONAL GAS PRODUCTION FROM NEB FORECAST

!==================================================================

SUBROUTINE NGCAN_FXADJ IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngtdminc' include 'ngcdmdinc' include 'ogglobal'REAL*4 SIGN,TECHFAC ! HIGH/LOW O&G TECH FACTORS REAL*4 VALUE, RESVAL ! MORE HIGH/LOW O&G TECH FACTORS REAL*4 ULTRES ! ULTIMATE UNCONV RESOURCE BASE (NEB) REAL*4 ULTSHL ! UTLIMATE SHALE GAS RESOURCE (GUESTIMATE) (ASSUME GIP 600TCF, 5% RECOVERY) ! REAL*4 ULTRES_2050 ! ULTIMATE UNCONV RESOURCE BASE (NEB) R evise Post 2030 to keep model running through 2050 REAL*4 RESTECH ! ASSUMED ANNUAL GROWTH IN RESOURCE BASE ! REAL*4 RESTECH_2050 ! ASSUMED ANNUAL GROWTH IN RESOURCE BASE Revise Post 2030 to keep model running through 2050 REAL*4 PKIYR ! INITIAL PEAK UNCONV PROD YEAR ! REAL*4 PKIYR_2050 ! INITIAL PEAK UNCONV PROD YEAR Revise Post 2030 to keep model running through 2050 ! REAL*4 BETA ! PARAMETER DEFINING UNCONV PROD GROWTH ! REAL*4 BETA2 ! PARAMETER ON PRODUCTION GROWTH REAL*4 CUR_ULTRES ! ULTIMATE RESOURCE AFT ADJ FOR TECHNOLOGY REAL*4 PRDIYR ! "YEAR" ON PROGRESSION UP RESOURCE CURVE, LAST YEAR ! REAL*4 CUMPRD ! CUMULATIVE PRODUCTION THIS YEAR ! REAL*4 CUMPRDLAG ! CUMULATIVE PRODUCTION LAST YEAR REAL*4 PRCADJ ! ADJUSTMENT OF PROD BECAUSE OF PRICE REAL*4 TECHADJ ! ADJUSTMENT OF PROD BECAUSE OF TECHNOLO GY REAL*4 LSTYR0 ! LAST YEAR OF ZERO PRODUCTION REAL*4 TECHGRW ! GROWTH IN PRODUCTION DUE TO TECH IMPROVEMENTS REAL*4 PARMA ! MULTIPLICATIVE FACTOR IN UNCONV PROD FUNCTION REAL*4 PARMB ! ADDITIVE FACTOR IN UNCONV PROD FUNCTION REAL*4 PARMC ! SLOPE ON DECLINE PART OF UNCONV PROD REAL*4 PARMD ! CONSTANT TERM ON DECLINE PART OF UNCONV PROD REAL*4 LSTYR ! LAST YEAR OF U NCONVENTIONAL PRODUCTION REAL*4 PERRES ! PERCENT OF ULTIMATE RESOURCE BASE AVAIL BEF PEAK YR ! REAL*4 PERRES_2050 ! PERCENT OF ULTIMATE RESOURCE BASE AVAIL BEF PEAK YR Revise Post 2030 to keep model running through 2050 REAL*4 PRD2 ! TWO POINTS ON THE UNCONVENTIONAL PRODUCTION CURVE REAL*4 RESADJ ! MODEL ASSUMPTION ABOUT RESOURCE UNCERTAINTY REAL*4 ROY_ADJ ! FACTOR FOR ADJUSTING PRICE TO REFLECT IMPACT OF ! INCREASED ROYALTY PAYMENTS IN ALBERTS STARTING IN 2009 REAL*4 CUM ! CUMULATIVE PRODUCTION IN HISTORICAL YEARS

INTEGER*4 RESBASE ! YEAR RESOURCE DEFINEDINTEGER*4 RTOVALUE ! RETURN VALUE FOR SENS ANALYSIS INTEGER*4 I,K

! EM4 TRACK

-- keep DATA RESBASE /2008/ DATA ULTRES/8000./ ! coalbed ESTIMATES FROM ICF, NOV 2008 INGAA STUDY, "AVAILABILITY, ECONOMICS & PRODUCTION POTENTIAL DATA ULTSHL/153000./ ! SHALE GAS OF NORTH AMERICAN UNCONVENTIONAL NATURAL GAS SUPPLIES" ! DATA ULTRES_2050/98000./ DATA PERRES/0.50/ ! DATA PERRES_2050/0.75/ DATA RESTECH/1.0/ ! DATA RESTECH_2050/1.005/ ! DATA RESTECH/. 000/ DATA PKIYR/2045./ ! 2028 ! DATA PKIYR_2050/2060./ ! 2028 ! DATA BETA/

- 0.1/ ! DATA BETA2/.00005/ DATA TECHGRW/0.01/ DATA LSTYR0/2004./

IF (MODYR.EQ.EHISYR+1 .AND. CURITR.EQ.1) THEN SIGN = RTOVALUE('OGTEC H ',1) RESADJ = RTOVALUE('OGUNCADJ',0) / 100. ! EM4 TRACK

-- keep

VALUE = 0.05 * RTOVALUE('OGTECADJ',0) / 100. RESVAL = 0.01 * RTOVALUE('OGTECADJ',0) / 100. TECHFAC = 1.0 IF (SIGN.EQ.0) TECHFAC = 1.

- VALUE IF (SIGN.EQ.2) TECHFAC = 1. + VALUE IF (SIGN.EQ.0) RESTECH = 1.

- RESVAL IF (SIGN.EQ.2) RESTECH = 1. + RESVAL ! IF (SIGN.EQ.0) RESTECH_2050 = 1.

- RESVAL ! IF (SIGN.EQ.2) RESTECH_2050 = 1. + RESVAL

CUM = 0.0 DO K=RESBASE,EHISYR CUM = CUM + CN_FIXSUP(4,K) ENDDO RESBASE = EHISYR + 1 ULTRES = ULTRES

- CUM ! ULTRES_2050 = ULTRES_2050

- CUM

PRDIYR = FLOAT (MODYR

- 1) ENDIF

IF ((MODYR.EQ.2010) .AND. CURITR.EQ.1) THEN ULTRES = ULTRES + ULTSHL ! ADD RESOURCES FOR SHALE PLAYS, ENDIF

! IF (CURIYR .EQ. 42) THEN ! ULTRES = ULTRES_2050 ! PERRES = PERRES_2050! RESTECH = RESTECH_2050

! PKIYR = PKIYR_2050 ! END IF

!!!! CUR_ULTRES = ULTRES * (1+RESTECH)**(FLOAT(MODYR

- RESBASE)) * (1.+RESADJ) CUR_ULTRES = ULTRES * RESTECH**(FLOAT(MODYR

- RESBASE)) * (1.+RESADJ)

! EM4 TRACK

-- keep
ROY_ADJ = 1.0 ! IF (MODYR.GE.2011) ROY_ADJ = 0.90

PRCADJ = ((oOGCNPPRD(2,CURIYR

- 1)*ROY_ADJ) / (2.0+(.08*FLOAT(MODYR

2008))))**0.1 TECHADJ = FLOAT(MODYR

- (LHISYR+1)) * (TECHGRW*TECHFAC) ! note how techfac set w/scalar

! EM4 TRACK

-- keep PARMA = (

- 3./2.) * (CUR_ULTRES*PERRES) / (PKIYR

- LSTYR0)**3. PARMB = (

- 1.*PARMA)*(PKIYR

- LSTYR0)**2. PARMC =

- (PARMB**2.) / (2.*CUR_ULTRES*(1.

- PERRES)) LSTYR = PKIYR + (2.*CUR_ULTRES*(1.

- PERRES)/PARMB)
PARMD =

- PARMC*LSTYR

IF (CURITR.EQ.1) PRDIYR = PRDIYR + 1. + (PRCADJ

- 1.) + TECHADJ IF (PRDIYR.LE.PKIYR) THEN PRD2 = (PARMA * (PRDIYR

- PKIYR)**2.) + PARMB ELSEIF (PRDIYR.LE.LSTYR) THEN PRD2 = (PARMC * PRDIYR) + PARMD ELSE PRD2 = 0.0 ENDIF
CN_FIXSUP(4,MODYR) = (1. + (PRCADJ

- 1.) + TECHADJ) * PRD2

CN_FIXSUP(2,MODYR) = CN_FIXSUP(3,MODYR)+CN_FIXSUP(4,MODYR)+CN_FIXSUP(5,MODYR)

WRITE(NGUNIT,1000) MODYR,(CN_FIXSUP(I,MODYR),I=4,5),PRDIYR,PRCADJ,TECHADJ,RESADJ 1000 FORMAT(1X,' CN_FIX

- UNC,MAC',I5,1X,6F10.3)

RETURN END

!******************************************************************
SUBROUTINE NGCAN_frOGSMC(CBMCFLG) ! overwrite ogsm vars, oOGRESCAN, oOGPRRCAN IMPLICIT NONE

include 'parametr' include 'ncntrl'include 'ngparinc' include 'ngtdminc' include 'ngitminc' include 'ngcdmdinc' include 'ogglobal' include 'ogglobalc'

INTEGER*4 cbmCflg ! 1=use ogsmc CBM calc, 0=do not use o gsmc INTEGER*4 cRG, cTYP ! CN REG, CN SUPPLY TYPE

REAL*4 TMC2BCF/35.315E

- 3/!conversion factor, bcf per mil cubic meters !

----------
oOGPRRCAN(2,CURIYR) = 1.0 ! =1 because oOGRESCAN filled w/ prod

CN_FIXSUP(1,MODYR) = 0.0 ! fixed supply, east CN DO cRG = 1,6 ! east CN= Prov 1

- 6, NS

- ON DO cTYP = 3,4 ! shallow, deep fixed sup, east CN CN_FIXSUP(1,MODYR) = CN_FIXSUP(1,MODYR) + &

cOGCNXPRD(cRG,cTYP,CURIYR) * & TMC2BCF ! conv MM m3 to BCF ENDDO cTYP = 7 ! unconv fixed sup, east CN CN _FIXSUP(1,MODYR) = CN_FIXSUP(1,MODYR) + & cOGCNXPRD(cRG,cTYP,CURIYR) * & ! unconv fixed sup, east CN TMC2BCF ! conv MM m3 to BCF ENDDO

oOGRESCAN(2,CURIYR) = 0.0 ! variable supply, west C N CN_FIXSUP(2,MODYR) = 0.0 ! fixed supply, west CN !tst CN_FIXSUP(4,MODYR) = 0.0 ! fixed supply, west CN CBM DO cRG = 7,MCANRG

- 1 ! west CN= Prov 7

- 11, MN

- Terr DO cTYP = 3,4 ! sh allow, deep variable sup, west CN oOGRESCAN(2,CURIYR) = oOGRESCAN(2,CURIYR) + & ! production, not resv cOGCNXPRD(cRG,cTYP,CURIYR) * & ! unconv fixed sup, east CN

TMC2BCF ! conv MM m3 to BCF !!! WRITE(6,*) 'cOGCNXPRD: ',MODYR,cRG,cTYP, cOGCNXPRD(cRG,cTYP,CURIYR)

ENDDO
! If cbmCflg=0, use CBM value generated in subr NGCAN_fxadj ! If cbmCflg=1, use CBM value generated by ogsm

- c methodology

IF (CBMCFLG.EQ.1) THEN cTYP = 7 CN_FIXSUP(4,MODYR) = CN_FIXSUP(4,MODYR) + & ! unconv fixed sup, west CN cOGCNXPRD(cRG,cTYP,CURIYR) * TMC2BCF ! conv MM m3 to BCFENDIF ENDDO CN_FIXSUP(2,MODYR) = CN_FIXSUP(3,MODYR)+CN_FIXSUP(4,MODYR)+CN_FI XSUP(5,MODYR)

!cn algorithm used in ngtdm

- c to overwrite ogsm

- c CBM results !cn AB_CBM(1) = 400.0 !cn AB_CBM(2) = 500.0 !600.0 !cn AB_CBM(3) = 600.0 !900.0 !cn cOGCNQPRD(1,7,K) = NGCNXPRD(1,7,K) !NS !cn IF (K .LT. 15) THEN !cn cOGCNQPRD(9,7,K) = NGCNXPRD(9,7,K) !cn ELSEIF (K .EQ. 15) THEN !cn cOGCNQPRD(9,7,K) = 21.0 !cn ELSEIF (K .EQ. 16) THEN !cn cOGCNQPRD(9,7,K) = 52.0 !cn ELSEIF (K .LE. 21) THEN !cn cOGCNQPRD(9,7,K) = 52.0 + (K

- 16)*(A B_CBM(1)

- 52)/(21

- 16) !INTERPOLATE BTWN 2005 & 2010 !cn ELSEIF (K .LE. 26) THEN !cn cOGCNQPRD(9,7,K) = AB_CBM(1) + (K

- 21)*(AB_CBM(2)

- AB_CBM(1))/(26

- 21) !INTERPOLATE BTWN 2010 & 2015 !cn ELSEIF (K .LE. 31) THEN !cn cOGCNQPRD(9,7,K) = AB_CBM(2) + (K

- 26)*(AB_CBM(3)

- AB_CBM(2))/(31

- 26) !INTERPOLATE BTWN 2015 & 2020 !cn ENDIF

!!! write(6,*) 'oOGRESCAN: ',CURIYR+1989, OOGRESCAN(2,CURIYR) ZOGRESNG(SNODES

- lSNODES

- 3) = oOGRESCAN(2,CURIYR) ZOGPRRNG(SNODES

- lSNODES

- 3) = oOGPRRCAN(2,CURIYR)

RETURN END

!******************************************************************

SUBROUTINE NGCAN_2OGSMC ! set prod, wpr for CN Prov IMPLICIT NONE

include 'parametr ' include 'ncntrl' include 'ngparinc' include 'ngtdminc' include 'ngcdmdinc' include 'ogglobal' include 'ogglobalc'

INTEGER*4 cRG, cTYP, I ! CN REG, CN SUPPLY TYPE INTEGER*4 AB/9/ ! 9=Alberta Province, CN INTEGER*4 cHYR/11/ ! use hist dat fr 2000 (11) !!! INTEGER*4 NGUNIT/98/ ! filename unit number (temp) REAL*4 SUMSUP REAL*4 TMC2BCF/35.315E

- 3/!conversion factor, bcf pe r mil cubic metersREAL*4 CF87US2CN REAL*4 CNPPRD(MCANRG

- 1) REAL*4 CNPPRDMU(MCANRG

- 1)

LOGICAL ONCE/.TRUE./

!

-- set price markup CNPPRDMU 87$cn/1000m3 (delta off Alberta price) IF (ONCE) THEN ONCE = .FALSE. DO cRG = 1,MCANRG

- 1 IF (cOGCNPPRD(cRG,3,cHYR) .GT. 0.) THEN CNPPRD(cRG) = cOGCNPPRD(cRG,3,cHYR) ELSEIF (cOGCNPPRD(cRG,4,cHYR) .GT. 0.) THEN CNPPRD(cRG) = cOGCNPPRD(cRG,4,cHYR) ELSEIF (cRG .EQ. 1) THEN CNPPRD(cRG) = cOGCNPPRD(AB,4,cHYR) ! Alberta ELSE CNPPRD(cRG) = CNPPRD(cRG

- 1) ENDIF ENDDO DO cRG = 1,MCANRG

- 1 CNPPRDMU(cRG) = CNPPRD(cRG)

- CNPPRD(A B) ! 87$cn/1000 m3 ENDDO !cn WRITE(6,*) 'CNPPRD:p',curiyr+1989,(CNPPRD(cRG),cRG=1,MCANRG

- 1) !cn WRITE(6,*) 'CNPPRD:m',curiyr+1989,(CNPPRDMU(cRG),cRG=1,MCANRG

- 1) ENDIF

SUMSUP = 0.0 DO cRG = 7,MCANRG

- 2 ! disaggregate using cOGCNXPRD, excl Terr

DO cTYP = 3,4 ! shallow, deep variable sup, west CN SUMSUP = SUMSUP + cOGCNXPRD(cRG,cTYP,CURIYR) ! MM m3

ENDDO ENDDO

cOGCNQPRD(:,:,CURIYR) = cOGCNXPRD(:,:,CURIYR) ! MM m3 DO cRG = 7,MCANRG

- 2 ! disaggregate using cOGCNXPRD, excl Terr

DO cTYP = 3,4 IF (SUMSUP .GT. 0.) THEN cOGCNQPRD(cRG,cTYP,CURIYR) = & ! MM m3 (oOGCNQPRD(2,CURIYR) / TMC2BCF) * & ! BCF to MM m3 cOGCNXPRD(cRG,cTYP,CURIYR) / SUMSUP ELSE cOGCNQPRD(cRG,cTYP,CURIYR) = 0.0 ! MM m3 ENDIF ENDDO ENDDO

SUMSUP = 0.0DO cRG = 7,MCANRG

- 2 ! disaggregate using cOGCNXPRD,

excl Terr

cTYP = 7 ! coalbed methane SUMSUP = SUMSUP + cOGCNXPRD(cRG,cTYP,CURIYR) ! MM m3 ENDDO DO cRG = 7,MCANRG

- 2 ! disaggregate using cOGCNXPRD, excl Terr

cTYP = 7 IF (SUMSUP .GT. 0.) THEN cOGCNQPRD(cRG,cTYP,CURIYR) = & ! MM m3 (CN_FIXSUP(4,MODYR) / TMC2BCF) * & ! unconv fixed sup, west CN cOGCNX PRD(cRG,cTYP,CURIYR) / SUMSUP

ELSE cOGCNQPRD(cRG,cTYP,CURIYR) = 0.0 ! MM m3 ENDIF ENDDO
CF87US2CN=(oMC_PCWGDP(CURIYR) / oMC_PCWGDP(

- 2)) * & ! 87$us to 87$cn (cMC_REXCUR(CURIYR)) * (cMC_PCWGDP(

- 2) / cMC_PCWGDP(CURIYR))

cOGCNPPRD(AB,3,CURIYR) = oOGCNPPRD(2,CURIYR) * & ! 87$us/mcf to 87$cn/1000 m3 TMC2BCF *1000. * & ! conv /mcf to /1000 m3 CF87US2CN ! conv 87$us to 87$cn !cn WRITE(6,*) 'CNPPRD:o',curiyr+1989,curitr,cOGCNPPRD(AB,3,curiyr),oOGCNPPRD(2,CURIYR)

DO cRG = 1,MCANRG

- 1 cOGCNPPRD(cRG,3,CURIYR) = cOGCNPPRD(AB,3,CURIYR) + CNPPRDMU(cRG) cOGCNPPRD(cRG,4,CURIYR) = cOGCNPPRD(AB,3,CURIYR) + CNPPRDMU(cRG) cOGCNPPRD(cRG,7,CURIYR) = cOGCNPPRD(AB,3,CURIYR) + CNPPRDMU(cRG) !!! DO cTYP = 3,4 ! shal/deep conventional !!! IF (cOGCNQPRD(cRG,cTYP,CURIYR) .EQ. 0.) THEN !!! cOGCNPPRD(cRG,cTYP,CURIYR) = 0.0 !!! ENDIF !!! ENDDO !!! cTYP = 7 ! coalbed methane (CBM) !!! IF (cOGCNQPRD(cRG,cTYP,CURIYR) .EQ. 0.) THEN !!! cOGCNPPRD(cRG,cTYP,CURIYR) = 0.0 !!! ENDIF ENDDO

!cn WRITE(6,*) 'CNPPRD: ',curiyr+1989,curitr,(cOGCNPPRD(cRG,3,curiyr),cRG=1,MCANRG

- 1) !cn WRITE(6,*) 'CNPPRD: ',curiyr+1989,curitr,(cOGCNPPRD(cRG,4,curiyr),cRG=1,MCANRG

- 1) !cn WRITE(6,*) 'CNPPRD: ',curiyr+1989,curitr,( cOGCNPPRD(cRG,7,curiyr),cRG=1,MCANRG

- 1)IF (FCRL .EQ. 1 .AND. CURIYR .EQ. LASTYR) THEN

!cn OPEN(UNIT=NGUNIT,FILE="M:/ogs/em4/ng_06ogsmC/runs/NGUNIT.txt") ! cOGCNPPRD: convt 87$cn/1000 m3 to 87$us/mcf : /(TMC2BCF *1000. * CF87US2CN) ! cOGCNQPRD: convt MM m3 to BCF : * TMC2BCF ! cOGCNXPRD: convt MM m3 to BCF : * TMC2BCF

write(NGUNIT,*) ' WELLHEAD PRICE, 87US$/MCF ACT PRD,BCF EXP PRD BCF'

write(NGUNIT,*) 'NOVA SCOTIA OFFSHORE' write(N GUNIT,*) ' YEAR', ' OGCNPPRD', ' OGCNQPRD', ' OGCNXPRD'

do i=1,IJUMPYR write(NGUNIT,*) i+1989,cOGCNPPRD(1,3,i)/(TMC2BCF *1000. *CF87US2CN), & cOGCNQPRD(1,3,i)* TMC2BCF, & cOGCNXPRD(1,3,i)* TMC2BCF enddo

write(NGUNIT,*) 'ONTARIO SHALLOW' write(NGUNIT,*) ' YEAR', ' OGCNPPRD', ' OGCNQPRD', ' OGCNXPRD'

do i=1,IJUMPYR write(NGUNIT,*) i+1989,cOGCNPP RD(6,3,i)/(TMC2BCF *1000. *CF87US2CN), & cOGCNQPRD(6,3,i)* TMC2BCF, & cOGCNXPRD(6,3,i)* TMC2BCF enddo

write(NGUNIT,*) 'SASKATCHEVAN SHALLOW' write(NGUNIT,*) ' YEAR', ' OGCNPPRD', ' OGCNQPRD', ' OGCNXPRD'

do i=1,IJUMPYR write(NGUNIT,*) i+1989,cOGCNPPRD(8,3,i)/(TMC2BCF *1000. *CF87US2CN), & cOGCNQPRD(8,3,i)* TMC2BCF, & cOGCNXPRD(8,3,i)* TMC2BCF enddo

write(NGUNIT,*) 'ALBERTA SHALLOW' write(NGUNIT,*) ' YEAR', ' OGCNPPRD', ' OGCNQPRD', ' OGCNXPRD'

do i=1,IJUMPYR write(NGUNIT,*) i+1989,cOGCNPPRD(9,3,i)/(TMC2BCF *1000. *CF87US2CN), & cOGCNQPRD(9,3,i)* TMC2BCF, & cOGCNXPRD(9,3,i)* TMC2BCF enddo

write(NGUNIT,*) 'ALBERTA DEEP' write(NGUNIT,*) ' YEAR', ' OGCNPPRD', ' OGCNQPRD', ' OGCNXPRD'do i=1,IJUMPYR write(NGUNIT,*) i+1989,cOGCNPPRD(9,4,i)/(TMC2BCF *1000. *CF87US2CN), & cOGCNQPRD(9,4,i)* TMC2BCF, & cOGCNXPRD(9,4,i)* TMC2BCF enddo

write(NGUNIT,*) 'B.C. DEEP' write(NGUNIT,*) ' YEAR', ' OGCNPPRD', ' OGCNQPRD', ' OGCNXPRD'

do i=1,IJUMPYR write(NGUNIT,*) i+198 9,cOGCNPPRD(10,4,i)/(TMC2BCF *1000. *CF87US2CN), & cOGCNQPRD(10,4,i)* TMC2BCF, & cOGCNXPRD(10,4,i)* TMC2BCF enddo

write(NGUNIT,*) 'COALBED METHANE NOVA SCOTIA' write(NGUNIT,*) ' YEAR', ' OGCNPPRD', ' OGCNQPRD', ' OGCNXPRD'

do i=1,IJUMPYR write(NGUNIT,*) i+1989,cOGCNPPRD(1,7,i)/(TMC2BCF *1000. *CF87US2CN), & cOGCNQPRD(1,7,i)* TMC2BCF, & cOGCNXPRD(1,7,i)* TMC2BCF enddo

write(NGUNIT,*) 'COALBED METHANE ALBERTA' write(NGUNIT,*) ' YEAR', ' OGCNPPRD', ' OGCNQPRD', ' OGCNXPRD'

do i=1,IJUMPYR write(NGUNI T,*) i+1989,cOGCNPPRD(9,7,i)/(TMC2BCF *1000. *CF87US2CN), & cOGCNQPRD(9,7,i)* TMC2BCF, & cOGCNXPRD(9,7,i)* TMC2BCF enddo

write(NGUNIT,*) 'COALBED METHANE B.C.' write(NGUN IT,*) ' YEAR', ' OGCNPPRD', ' OGCNQPRD', ' OGCNXPRD'

do i=1,IJUMPYR write(NGUNIT,*) i+1989,cOGCNPPRD(10,7,i)/(TMC2BCF *1000. *CF87US2CN), & cOGCNQPRD(10,7,i)* TMC2BCF, & cOGCNXPRD(10,7,i)* TMC2BCF enddo

!cn write(NGUNIT,*) ' YEAR', ' CAN LNG IMPORTS' !cn do i=1,IJUMPYR !cn write(NGUNIT,*) i+1989,cOGCNPPRD(1,5,i), NGCNQPRD(1,5,i), NGCNXPRD(1,5,i) !cn enddo

w rite(NGUNIT,*) ' YEAR', ' FRONTIER SHALLOW'do i=1,IJUMPYR write(NGUNIT,*) i+1989,cOGCNXPRD(11,4,i), & cOGCNXPRD(11,3,i) cOGCNQPRD(MCANRG,3,i) = cOGCNQPRD(MCANRG,3,i) + & cOGCNXPRD(11,3,i) enddo

write(NGUNIT,*) 'TOTAL CANADA' write(NGUNIT,*) ' YEAR', ' OGCNPPRD', ' OGCNQPRD' do i=1,IJUMPYR write(NGUNIT,*) i+1989,cOGCNPPRD(mcanrg,3,i)/(TMC2BCF *1000. *CF87US2CN), & cOGCNQPRD(mcanrg,3,i)* TMC2BCF

enddo

write(NGUNIT,*) 'TOTAL EXPORTS TO US, IMPORTS FROM US BCF' do i=1,IJUMPYR write(NGUNIT,*) i+1989,oOGQNGIMP(MNUMBX

- 3,I),oOGQNGEXP(MNUMBX

3,I) enddo

!cn write(NGUNIT,*) 'TOTAL CONSUMPTION, PIPE Fuel, L&P, in BCF' !cn !cn do i=1,IJUMPYR !cn Qtemp = 0 !cn QPFtemp = 0 !cn QLPtemp = 0 !c n do j=1,mcanrg

- 1 !cn Qtemp = Qtemp + cQGFRS(j,I)+cQGIRS(j,I)+cQGFCM(j,I)+cQGICM(j,I)+ & !cn cQGFIN(j,I)+cQGIIN(j,I)+cQGFTR(j,I)+cQGITR(j,I) + & !cn cQGFEL(j,I)+cQGIEL(j,I) !cn QPFtemp = QPFtemp + cQGPTR(j,i) !cn !cn QLPtemp = QLPtemp + cQLPIN(j,i) !cn enddo !cn DISCRtemp = (Qtemp + QPFtemp + QLPtemp) / cCFNGN(i) + & !cn oOGQNGIMP(MNUMBX

- 3,I)

- oOGQNGEXP(MNUMBX

- 3,I)

- & !cn cOGC NQPRD(mcanrg,3,i) !

- NGCNQPRD(1,5,i) !cn !cn write(NGUNIT,*) i+1989,Qtemp/cCFNGN(i),QPFtemp/cCFNGN(i),QLPtemp/cCFNGN(i),DISCRtemp !cn enddo !cn !cn write(NGUNIT,*) 'END

- USE PRICES ACROSS PROVINCES, US 1987 $/mcf' !cn !cn do j=1,IJ UMPYR !cn CF87US2CN = (cMC_GDPMPU(j) / cMC_GDPMPU(

- 2)) * (cMC_REXCUR(j)) * & !cn (cMC_PCWGDP(12) / cMC_PCWGDP(j)) !cn write(NGUNIT,*) 'YEAR ',j+IBASYR

- 1!cn write(NGUNIT,*) ' NS PE NB NF QC

ON MB SK AB BC TE' !cn WRITE(NGUNIT,261) (cPNGRS(I,j)*cCFNGN(j),I=1,MCANRG

- 1) !cn 261 FORMAT(1X,'PNGRS ',11F7.2) !cn WRITE(NGUNIT,262) (cPNGCM(I,j)*cCFNGN(j),I=1,MCANRG

- 1) !cn 262 FORMAT(1X,'PNGCM ',11F7. 2) !cn WRITE(NGUNIT,263) (cPNGIN(I,j)*cCFNGN(j),I=1,MCANRG

- 1) !cn 263 FORMAT(1X,'PNGIN ',11F7.2) !cn WRITE(NGUNIT,264) (cPNGTR(I,j)*cCFNGN(j),I=1,MCANRG

- 1) !cn 264 FORMAT(1X,'PNGTR ',11F7.2) !cn WRITE(NGUNIT,265) (cPNGEL(I,j)*cCFNGN(j),I=1,MCANRG

- 1) !cn 265 FORMAT(1X,'PNGEL ',11F7.2,/)

!cn WRITE(NGUNIT,*) 'T&D margin EL',cPNGEL(MCANRG,j)*cCFNGN(j)

- NGCNPPRD(mcanrg,3,i) !cn enddo

!!! CLOSE(UNIT=NGUNIT)

ENDIF !!!!!!!!!!!!!!!!!!!!end NGUNIT write block!!!!!!!!

RETURN END

!==================================================================

! ROUTINE TO REPORT CANADIAN LNG IMPORTS, IF LNG VARIABLE SUPPLY

! (FIXLNGFLG=.FALSE.) ! FILL C NLNGIMP(CURIYR)

!==================================================================

SUBROUTINE NGCAN_LNGVS IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngitminc' include 'ngtdmin c' include 'ogglobal'

INTEGER*4 NET ! REPRESENTS PK,OP NETWORK INTEGER*4 A ! COUNTERS

!

----------

oCNLNGIMP(CURIYR) = 0.0 DO NET=1,NETWORK A = NODE_2ARC(36,33) !HARDCODED, LNG IMP TO E.CAN oCNLNGIMP(CURIYR) = oCNLNGIMP(CURIYR) + FLOW(NET,A) A = NODE_2ARC(37,34) !HARDCODED, LNG IMP TO W.CANoCNLNGIMP(CURIYR) = oCNLNGIMP(CURIYR) + FLOW(NET,A) ENDDO

RETURN END

!==================================================================

! ROUTINE TO OVERWRITE CANADIAN IMPORT CAPACITY IN SIDE CASE RUNS

!==================================================================

SUBROUTINE N GCANCAP(METHOD) IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngitminc' include 'ngtdminc' include 'ngcdmdinc' include 'ngakinc' include 'ogglobal'

REAL*4 REFWHP(IBASYR:IBASYR+MNUMYR

- 1) ! NG WELLHD PRICE FROM BASE CASE RUN (87$/MCF) REAL*4 UCANCAP(NXMAPUS,IBASYR:IENDYR) ! REVISED IMPORT CAPACITY ON US SIDE OF BORDER REAL*4 UORGCAP(NXMAPUS,IBASYR:IENDYR) ! ORIGINAL IMPORT CAPACITY ON US SIDE OF BORDER REAL*4 CCANCAP(NXMAPUS,IBASYR:IENDYR) ! REVISED IMPORT CAPACITY ON CAN SIDE OF BORDER REAL*4 REF_CONS(5,LHISYR+1:IBASYR+MNUMYR

- 1

- 1) ! BASE CASE CONS REAL*4 TST_CONS(5) ! CURRENT BASE CO NS (FROM RESTART FILE) REAL*4 LAG_CONS(5) ! LAST YEARS BASE CONS REAL*4 BASE ! BASE PRICE TERM FR REFERENCE REAL*4 TEST ! PRICE TERM FR SIDE CASE TO COMPARE TO BASE REAL*4 PRCFAC ! PRICE FACTOR TO ADJUST ALL BORDER CROSSINGS REAL*4 PFAC(5) ! FACTOR TO ADJUST SPECIFIC BORDER CROSSINGS REAL*4 PAVG ! AVERAGE PRICE ADJUSTMENT FA CTOR REAL*4 CNFLOW ! ANNUAL FLOW ON CAN IMPORT ARC LAST YEAR REAL*4 CNFLOWLAG(NXMAPUS) ! ANNUAL FLOW ON CAN IMPORT ARC YEAR BEFORE LAST REAL*4 CNUTIL ! ANNUAL UTILIZTION ON CA N IMPORT ARC REAL*4 CN_GRW ! GROWTH FACTOR ON ALLOWED PIPE EXPREAL*4 CUMAKCAP ! IMPORT CAP TARGETED FOR

ANGTS, AFTER DECISION, BEFORE FLOW REAL*4 TOTBRD ! CURRENT T OTAL CAN IMPORT BORDER CAPACITY

INTEGER*4 FIRSTYR ! FIRST YEAR OF ADJUSTMENT (POTENTIALLY) INTEGER*4 METHOD ! METHOD FOR CAN PIPE ADJUST (1=PRICE,2=CONS) INTEGER*4 ARC1 ! CANADIAN IMPORT ARC ON CAN SIDE OF BOR DER INTEGER*4 ARC2 ! CANADIAN IMPORT ARC ON US SIDE OF BORDER INTEGER*4 CANOVR ! SWITCH 1=ADJUST CAN PIPELINE IN SIDE CASE, 0=DONT INTEGER*4 RTOVALUE INTEGER*4 I,J,K,L,N INTEGER*4 RGCON ! CONS REG (1

- 5) CORRESPONDING TO PARTICULAR BORDER XING INTEGER*4 MAPTMP(NXMAPUS) ! MAP BETWEEN 5 DEMAND GROUPS AND 8 BORDER XINGS INTEGER*4 JENDYR ! LAST YEAR VALUE CORRESPONDS TO IENDYR EXTERNAL RTOV ALUE

LOGICAL ONCE LOGICAL GRTONE

DATA MAPTMP /1,1,0,2,2,3,4,5/ DATA ONCE /.TRUE./

! NOTE: NO ADJUSTMENT MADE TO DEAL WITH ANGTS AND FLOW_THRU (SEE AEO98)

!

------------------------------------------------------------ ------------

! WELLHEAD PRICES IN 1987$ FROM OGBASE.D051200A RUN

! EM4 TRACK

-- keep DATA REFWHP /1.540,1.416,1.468,1.694,1.520,1.225,1.712,1.780, &

1.459,1.540,1.848,1.832,1.809,1.798,1.786,1.785,1.799, & 1.819,1.833,1.838,1.847,1.867,1.891,1.919,1.959,1.995, & 2.016,2.034,2.048,2.060,2.074,2.074,2.074,2.074,2.074, & 2.074,2.074,2.074,2.074,2.074,2.074, & 2.074,2.074,2.074,2.074,2.074, & 2.074 ,2.074,2.074,2.074,2.074, & 2.074,2.074,2.074,2.074,2.074, & 2.074,2.074,2.074,2.074,2.074/

! 1 2 3 4 aeo98b.d092797b

! EM4 TRACK

-- keep DATA REF_CONS / & 5000.1, 16524.0, 2519.2, 2124.8, 1647.6, & ! 2010 NGCANOVR 5076.7, 16682.1, 2623.8, 2185.4, 1661.4, & ! 2011 NGCANOVR5180.7, 16904.0, 2754.7, 2251.3, 1693.4, & ! 2012

NGCANOVR 5238.1, 17084.9, 2882.2, 2317.6, 1725.5, & ! 2013 NGCANOVR 5375.2, 17385.7, 3034.0, 2371.2, 1760.3, & ! 2014 NGCANOVR 5462.2, 17632.7, 3187.9, 2452.1, 1787.2, & ! 2015 NGCANOVR 5489.9, 17730.2, 3331.2, 2489.0, 1808.3, & ! 2016 NGCANOVR 5507.3, 17853.0, 3482.2, 2542.1, 1824.3, & ! 2017 NGCANOVR 5510.4, 18041.7, 3646.2, 2551.7, 1842.0, & ! 2018 NGCANOVR 5496.4, 18151.2, 3815.0, 2570.2, 1852.2 , & ! 2019 NGCANOVR 5496.4, 18151.2, 3815.0, 2570.2, 1852.2, & ! 2020 NGCANOVR 5496.4, 18151.2, 3815.0, 2570.2, 1852.2, & ! 2021 NGCANOVR 5496.4, 18151.2, 3815.0, 2570.2, 1852.2, & ! 2022 NGCANOV R 5496.4, 18151.2, 3815.0, 2570.2, 1852.2, & ! 2023 NGCANOVR 5496.4, 18151.2, 3815.0, 2570.2, 1852.2, & ! 2024 NGCANOVR 5496.4, 18151.2, 3815.0, 2570.2, 1852.2, & ! 2025 NGCANOVR 5496. 4, 18151.2, 3815.0, 2570.2, 1852.2, & ! 2026 NGCANOVR 5496.4, 18151.2, 3815.0, 2570.2, 1852.2, & ! 2027 NGCANOVR 5496.4, 18151.2, 3815.0, 2570.2, 1852.2, & ! 2028 NGCANOVR 5496.4, 18151.2, 3815 .0, 2570.2, 1852.2, & ! 2029 NGCANOVR 5496.4, 18151.2, 3815.0, 2570.2, 1852.2, & ! 2030 NGCANOVR 5496.4, 18151.2, 3815.0, 2570.2, 1852.2, & ! 2031 NGCANOVR 5496.4, 18151.2, 3815.0, 2570.2, 185 2.2, & ! 2032 NGCANOVR 5496.4, 18151.2, 3815.0, 2570.2, 1852.2, & ! 2033 NGCANOVR 5496.4, 18151.2, 3815.0, 2570.2, 1852.2, & ! 2034 NGCANOVR 5496.4, 18151.2, 3815.0, 2570.2, 1852.2, & ! 2035 NGCANOVR 5496.4, 18151.2, 3815.0, 2570.2, 1852.2, & ! 2036 NGCANOVR 5496.4, 18151.2, 3815.0, 2570.2, 1852.2, & ! 2037 NGCANOVR 5496.4, 18151.2, 3815.0, 2570.2, 1852.2, & ! 2038 NGCANOVR5496.4, 18151.2, 3815.0, 2570.2, 1852.2, & ! 2039

NGCANOVR 5496.4, 18151.2, 3815.0, 2570.2, 1852.2, & ! 2040 NGCANOVR 5496.4, 18151.2, 3815.0, 2570.2, 1852.2, & ! 2041 NGCANOVR 5496.4, 18151.2, 3815.0, 2570.2, 1852.2, & ! 2042 NGCANOVR 5496.4, 18151.2, 3815.0, 2570.2, 1852.2, & ! 2043 NGCANOVR 5496.4, 18151.2, 3815.0, 2570.2, 1852.2, & ! 2044 NGCANOVR 5496.4, 18151.2, 3815.0, 2570.2, 1852.2, & ! 2045 NGCANOVR 5496.4, 18151.2, 3815.0, 2570.2, 1852.2, & ! 2046 NGCANOVR 5496.4, 18151.2, 3815.0, 2570.2, 1852.2, & ! 2047 NGCANOVR 5496.4, 18151.2, 3815.0, 2570.2, 1852.2, & ! 2048 NGCANOVR 5496.4, 18151.2, 3815.0, 2570.2, 1852.2/ ! 2049 NGCANOVR

!

---------------------------------------------------------------

JENDYR = RTOVALUE('IJUMPCAL',2030)

CANOVR = RT OVALUE('NGCANOVR',0) IF (CANOVR.EQ.0) THEN IF (MODYR.GT.IBASYR) THEN DO I=1,5 LAG_CONS(I) = TST_CONS(I) ENDDO ELSE CNFLOWLAG = 0.0 ENDIF TST_CONS = 0.0 DO I=1,NETWORK TST_CONS(1) = TST_CONS(1) + NODE_DMD(I,1) + NODE_DMD(I,2) TST_CONS(2) = TST_CONS(2) + NODE_DMD(I,3) + NODE_DMD(I,4)+ &

NODE_DMD(I,5) TST_CONS(3) = TST_CONS(3) + NODE_DMD(I,8) TST_CONS(4) = TST _CONS(4) + NODE_DMD(I,12) TST_CONS(5) = TST_CONS(5) + NODE_DMD(I,9) ENDDO
WRITE(NGUNIT,1000) (TST_CONS(I),I=1,5),MODYR

- 1 1000 FORMAT(8X,5(F9.1,','),' & ! ',I4,' NGCANOVR ')

IF (MODYR.GE.LHISYR+2) TH EN DO I=1,NXMAPUS RGCON = MAPTMP(I) IF (RGCON.NE.0) THEN ARC1 = NODE_2ARC(CAN_XMAPUS(I,3),CAN_XMAPUS(I,2))ARC2 = NODE_2ARC(CAN_XMAPUS(I,2),CAN_XMAPUS(I,1)) CNFLOW = 0 .0 DO N=1,NETWORK CNFLOW = CNFLOW + FLOW(N,ARC2) ! LAST YEAR'S FLOW ENDDO

UCANCAP(I,IBASYR) = CURPCAP(ARC2,IBASYR) DO K=IBASYR+1,MODYR UCANC AP(I,K) = UCANCAP(I,K

- 1) + PLANPCAP(ARC2,K) ENDDO

CNUTIL = CNFLOW / UCANCAP(I,MODYR

- 1)

! WRITE(6,*) ' CNFLOW ',MODYR,I,CNFLOW,CNFLOWLAG(I)

IF (CNFLOW.LT.(CNFLOWLAG(I)*0.98)) THEN CN_GRW = 0.0 ELSE CN_GRW = ((TST_CONS(RGCON)/LAG_CONS(RGCON))*CNFLOW)*0.99
ENDIF
! WRITE(6,*) ' CNCH ',MODYR,I,CNFLOW,CN_GRW

! CN_GRW = 1. + (0.5*((oQNGAS(11,CURIYR+2)/oQ NGAS(11,CURIYR+1))

- 1.)) ! UCANCAP(I,MODYR) = AMAX1(UCANCAP(I,MODYR),(UCANCAP(I,MODYR

1)*CN_GRW)) UCANCAP(I,MODYR) = AMAX1(UCANCAP(I,MODYR),CN_GRW)

PLANPCAP(ARC2,MODYR) = UCANCAP(I,MODYR)

- UCANCAP(I,MODYR

1) PLANPCAP(ARC1,MODYR) = 0.0

CNFLOWLAG(I) = CNFLOW ENDIF ENDDO

! MAKE ADJUSTMENTS FOR CAPACITY OUT OF US WHEN ANGTS COMES ON

IF ( ( MODYR.GE.(AKPIP1

- FR_PCNSYR(1)) .AND. MODYR.LE.AKPIP1+1 ) .OR. & ( MODYR.GE.(AKPIP2

- 1) .AND. MODYR.LE.AKPIP2+1 ) ) THEN DO I=4,NXMAPUS

RGCON = MAPTMP(I) IF (RGCON.NE.0) THEN ARC2 = NODE_2ARC(CAN_XMAPUS(I,2),CAN_XMAPUS(I,1)) CUMAKCAP = CUMAKCAP + PLANPCAP(ARC2,MODYR) ENDIF ENDDO ELSE CUMAKCAP = 0.0 ENDIF IF (MODYR.EQ.AKPIP1.OR.MODYR.EQ.AKPIP1+1.OR.MODYR.EQ.AKPIP2.OR.MODYR.EQ.AKPI P2+1) THEN TOTBRD = 0.0DO I=4,NXMAPUS TOTBRD = TOTBRD + UCANCAP(I,MODYR) ENDDO CN_GRW = (TOTBRD + QAK_ALB(MODYR)

- QAK_ALB(MODYR

- 1)

- CUMAKCAP) / TOTBRD

CUMAKCAP = 0.0 IF (CN_GRW.GT.1. 0) THEN DO I=4,NXMAPUS RGCON = MAPTMP(I) IF (RGCON.NE.0) THEN ARC1 = NODE_2ARC(CAN_XMAPUS(I,3),CAN_XMAPUS(I,2)) ARC2 = NODE_2ARC(CAN_XMAPUS(I,2),CA N_XMAPUS(I,1)) UCANCAP(I,MODYR) = UCANCAP(I,MODYR) * CN_GRW PLANPCAP(ARC2,MODYR) = UCANCAP(I,MODYR)

- UCANCAP(I,MODYR

- 1) PLANPCAP(ARC1,MODYR) = 0.0

ENDIF ENDDO ENDIF ENDIF

IF (MODYR.EQ.AKPIP1+1) CUMAKCAP = 0.0

DO I=1,NXMAPUS IF (I.NE.3) THEN ARC1 = NODE_2ARC(CAN_XMAPUS(I,3),CAN_XMAPUS(I,2)) ARC2 = NODE_2ARC(CAN_XMAPUS(I,2),CAN_XMAPUS(I,1)) PLANPCAP(ARC1,MODYR) = PLANPCAP(ARC1,MODYR) + PLANPCAP(ARC2,MODYR)

ENDIF ENDDO ENDIF

RETURN ENDIF

IF (ONCE) THEN DO I= 1,NXMAPUS IF (I.NE.3) THEN ARC2 = NODE_2ARC(CAN_XMAPUS(I,2),CAN_XMAPUS(I,1)) UCANCAP(I,IBASYR) = CURPCAP(ARC2,IBASYR) DO K=IBASYR+1,JENDYR UCANCAP(I,K) = UCANCAP(I,K

- 1) + PLANPCAP(ARC2 ,K) UORGCAP(I,K) = UCANCAP(I,K) ENDDO ENDIF ENDDO ONCE = .FALSE. ENDIF

IF (METHOD.EQ.1) THEN ! ADJUSTMENT BASED ON PRICE FIRSTYR = LHISYR + 2 DO K=FIRSTYR,JENDYR

- 2 J = K

- IBASYR + 1! EM4 TRACK

-- keep BASE = (REFWHP(K) * 0.5) + (REFWHP(K+1) * 0.3) + &

(REFWHP(K+2) * 0.2) TEST = (oOGWPRNG(13,J) * 0.5) + (oOGWPRNG(13,J+1) * 0.3) + &

(oOGWPRNG(13,J+2) * 0 .2) PRCFAC = 1.+ (((TEST/BASE)

- 1.)*0.5) IF (PRCFAC .GT. 1.0) THEN DO I=1,NXMAPUS IF (I.NE.3) THEN UCANCAP(I,K+2) = UORGCAP(I,K+2) * PRCFAC ENDIF ENDDO ENDIF ENDDO ENDIF

! WRITE (NGUNIT,*) ' OCAN,METHOD,MODYR,LHISYR ',METHOD,MODYR,LHISYR

FIRSTYR = MODYR

IF (METHOD.EQ.2 .AND. MODYR.GE.LHISYR+2) THEN FIRSTYR = MODYR

DO I=1,NETWORK TST_CONS( 1) = TST_CONS(1) + NODE_DMD(I,1) + NODE_DMD(I,2) TST_CONS(2) = TST_CONS(2) + NODE_DMD(I,3) + NODE_DMD(I,4)+ &

NODE_DMD(I,5) TST_CONS(3) = TST_CONS(3) + NODE_DMD(I,8) TST_CONS(4) = TST_CONS(4) + NODE_DMD(I,12) TST_CONS(5) = TST_CONS(5) + NODE_DMD(I,9) ENDDO

GRTONE = .TRUE. DO I=1,5 PFAC(I) = TST_CONS(I) / REF_CONS(I,MODYR

- 1) IF (PFAC(I).LT.1.0) GRTONE = .F ALSE. ENDDO

! WRITE(NGUNIT,*) ' OCAN PFAC ',MODYR,(PFAC(I),I=1,5) ! WRITE(NGUNIT,*) ' OCAN OCAP ',MODYR,(UCANCAP(I,MODYR),I=1,8)

IF (GRTONE) THEN UCANCAP(1,FIRSTYR) = UORGCAP(1,FIRSTYR) * PFAC(1) UCANCAP (2,FIRSTYR) = UORGCAP(2,FIRSTYR) * PFAC(1) UCANCAP(4,FIRSTYR) = UORGCAP(4,FIRSTYR) * PFAC(2) UCANCAP(5,FIRSTYR) = UORGCAP(5,FIRSTYR) * PFAC(2) UCANCAP(6,FIRSTYR) = UORGCAP(6,FIRSTYR) * PFAC(3) UCANCAP(7,FIRSTYR) = UO RGCAP(7,FIRSTYR) * PFAC(4) UCANCAP(8,FIRSTYR) = UORGCAP(8,FIRSTYR) * PFAC(5) ENDIF

! DO K=MODYR,JENDYR ! WRITE(NGUNIT,*) ' OCAN NCP1 ',K,(UCANCAP(I,K),I=1,8) ! ENDDOENDIF

DO I=1,NXMAPUS IF (I.NE.3) THEN ARC2 = NODE_2ARC(CAN_XMAPUS(I,2),CAN_XMAPUS(I,1)) DO K=FIRSTYR,JENDYR DO J=K+1,JENDYR UCANCAP(I,J) = AMAX1(UCANCAP(I,J),UCANCAP(I,K)) ENDDO IF (K.NE.IBASYR) & PLANPCAP(ARC2,K) = UCANCAP(I,K)

- UCANCAP(I,K

- 1) ENDDO ENDIF ENDDO

! DO K=FIRSTYR,JENDYR ! WRITE(NGUNIT,*) ' OCAN NCP2 ',K,(UCANCAP(I,K),I=1,8) ! ENDDO

DO K=FIRSTYR,JENDYR DO I=1,NXMAPUS IF (I.NE.3) THEN ARC1 = NODE_2ARC(CAN_XMAPUS(I,3),CAN_XMAPUS(I,2)) PLANPCAP(ARC1,K) = 0.0 ENDIF ENDDO DO I=1,NXMAPUS IF (I.NE.3) THEN ARC1 = NODE_2ARC(CAN_XMAPUS(I,3),CAN_XM APUS(I,2)) ARC2 = NODE_2ARC(CAN_XMAPUS(I,2),CAN_XMAPUS(I,1)) PLANPCAP(ARC1,K) = PLANPCAP(ARC1,K) + PLANPCAP(ARC2,K) ENDIF ENDDO ENDDO

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = ! ! READ MEXICO INPUT DATA ! ! = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =

SUBROUTINE NGINIT_MEX(NGMISC) IMPLICIT NONE

include'parametr' ! nems dimension parameters include'ncntrl' ! nems control variables include'ngparinc' ! ngtdm parameters include'ngtdminc' include'ngdtminc' ! ngtdm system variables include'ogglobal'REAL*4 DUMMY(4) ! PLACEHOLDER FOR GROWTH RATE

INTEGER*4 NR ! LOOP INTEGER*4 N ! LOOP INTEGER*4 IFLG, PRV_IFLG ! END OF DATA FLAG INTEGER*4 DELTA ! NUM YRS GROW APPLIED INTEGER*4 IYR ! YEAR INDEX (1,2,3...) INTEGER*4 JYR ! YEAR INDEX (1,2,3...) INTEGER*4 NGMISC ! INPUT UNIT NUMBER

!

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

! READ SWITCH TO READ OR SET IMPORT VOLUMES CALL NEXTDATA(NGMISC) READ (NGMISC,*) LNGDATA

! READ PRODUCTION AND CONSUMPTION INPUT FROM MEXICO ! USED TO DETERMINE MEXICO IMPOR TS AND EXPORTS TO US

!

-- PRODUCTION AND CONSUMPTION IN MEXICO IYR = 0

CALL NEXTDATA(NGMISC) DO WHILE (IYR .NE. YR2PEMEX) READ (NGMISC,*) IYR, (PEMEX_PRD(N,IYR),N=1,PEMEX_NR), &

IEA_PRD(IYR), IEA_CON (IYR)

! CONVERT FR MMcfd TO Bcf/yr AND TOTAL TPEMEX_PRD(IYR) = 0.0

DO NR=1,PEMEX_NR PEMEX_PRD(NR,IYR) = PEMEX_PRD(NR,IYR) * 0.365 TPEMEX_PRD(IYR) = TPEMEX_PRD(IYR) + PEMEX_PRD(NR,IY R) ENDDO ENDDO

!

-- PRODUCTION GROWTH RATES BY MEX REGION IFLG = 99999 PRV_IFLG = 99999

CALL NEXTDATA(NGMISC) DO WHILE (IFLG .NE. 0) READ (NGMISC,*) IFLG, (DUMMY(N),N=1,PEMEX_NR) IF (IFLG .NE. 0) THEN DO NR=1,PEMEX_NR PRD_GFAC(NR,IFLG) = DUMMY(NR) ENDDO DELTA = IFLG

- PRV_IFLG ! FILL IN YEARS BETWEEN INPUT DATA IF (DELTA .GT. 1) THEN DO IYR=PRV_IFLG,IFLG

- 1 DO NR=1,PEMEX_NR PRD_GFAC(NR,IYR) = PRD_GFAC(NR,PRV_IFLG)ENDDO ENDDO ENDIF PRV_IFLG = IFLG ELSE ! F ILL IN YEARS AFTER LAST INPUT DATA DO IYR=PRV_IFLG,BASEYR+IJUMPYR

- 1

DO NR=1,PEMEX_NR PRD_GFAC(NR,IYR) = PRD_GFAC(NR,PRV_IFLG) ENDDO ENDDO ENDIF ENDDO

!

-- CONSUMPTION FACTORS FOR EACH SECTOR ! ANNUAL RATE OF CHANGE IN CONSUMPTION

IFLG = 99999 PRV_IFLG = 99999 CALL NEXTDATA(NGMISC) DO WHILE (IFLG .NE. 0) READ (NGMISC,*) IFLG, (DUMMY( N),N=1,4) IF (IFLG .NE. 0) THEN PEMEX_GFAC(IFLG) = DUMMY(1) IND_GFAC(IFLG) = DUMMY(2) ELE_GFAC(IFLG) = DUMMY(3) RC_GFAC(IFLG) = DUMMY(4) DELTA = IFLG

- PRV_IFLG ! FILL IN YEARS BETWEEN INPUT DATA IF (DELTA .GT. 1) THEN DO IYR=PRV_IFLG,IFLG

- 1 PEMEX_GFAC(IYR) = PEMEX_GFAC(PRV_IFLG) IND_GFAC(IYR) = IND_GFAC(PRV_IFLG) ELE_GFAC(IYR) = ELE_GFAC(PRV_IFLG) RC_GFAC(IYR) = RC_GFAC(PRV_IFLG) ENDDO ENDIF PRV_IFLG = IFLG ELSE ! FILL IN YEARS AFTER LAST INPUT DATA DO IYR=PRV_IFLG,BASEYR+IJUMPYR

- 1 PEMEX_GFAC(IYR) = PEMEX_GFAC(PRV_IFLG) IND_GFAC(IYR) = IND_GFAC(PRV_IFLG) ELE_GFAC(IYR) = ELE_GFAC(PRV_IFLG) RC_GFAC(IYR) = RC_GFAC(PRV_IFLG) ENDDO ENDIF ENDDO

! SHARE OF HIST CONSUMP TO SECTOR/PEMEX CALL NEXTDATA(NGMISC)READ (NGMISC,*) HPEMEX_SHR, HIND_SHR, HELE_SHR, HRC_SHR ! SHARE OF SECTOR CONSUMPTION TO SOUTH CALL NEXTDATA(NGMISC) READ (NGMISC,*) SPEMEX_SHR, SIND_SHR, SELE_SHR, SRC_SHR ! SHARE OF SECTOR CONSUMPTION TO NORTH CALL NEXTDATA(NGMISC) READ (NGMISC,*)NPEMEX_SHR, NIND_SHR, NELE_SHR, NRC_SHR

!

-- EXPORTS FROM MEXICO, IMPORTS TO MEXICO

CALL NEXTDATA(NGMISC) DO IYR=BASEYR,YR2PEMEX+2 ! include steo years READ (NGMISC,*) JYR, EXP_FRMEX(JYR), IMP_TOMEX(JYR) ENDDO CALL NEXTDATA(NGMISC) READ (NGMISC,*) DEXP_FRMEX, DFAC_TOMEX

!

-- FA CTORS FOR SHARING TOTAL IMP/EXP ACROSS US/MEX BORDERS

IYR = 0 CALL NEXTDATA(NGMISC) DO WHILE (IYR .LT. YR2PEMEX+2) READ (NGMISC,*) IYR, (MEXIMP_SHR(N,IYR), N=1,MEXBORDER) ENDDO ! READ/SET SPLITS FOR FORECAST YEARS DO IYR=YR2PEMEX+3, IJUMPCALYR DO N=1,MEXBORDER MEXIMP_SHR(N,IYR) = MEXIMP_SHR(N,IYR

- 1) ENDDO ENDDO

IYR = 0 CALL NEXTDATA(NGMISC) DO WHILE ( IYR .LT. YR2PEMEX+2) READ (NGMISC,*) IYR, (MEXEXP_SHR(N,IYR), N=1,MEXBORDER) ENDDO ! READ/SET SPLITS FOR FORECAST YEARS DO IYR=YR2PEMEX+3, IJUMPCALYR DO N=1,MEXBORDER MEXEXP_SHR(N,IYR) = MEX EXP_SHR(N,IYR

- 1) ENDDO ENDDO

! READ LNG DATA BY REGION IYR = 0 CALL NEXTDATA(NGMISC) DO WHILE (IYR .LT. 2050) READ (NGMISC,*) IYR, (MEXLNG(N,IYR), N=1,NUMREG) ENDDO

! READ BAJA DATA CALL NEXTDATA(NGMISC)DO WHILE (IYR .LT. 2050) READ (NGMISC,*) IYR, BAJA_FIX(IYR) ENDDO

N = 1 CALL NEXTDATA(NGMISC) DO WHILE (N .LT. 5) READ (NGMISC,*) BAJA_CAP(N), BAJA_PRC(N) N=N+1 ENDDO

CALL NEXTDATA(NGMISC) READ (NGMISC,*) BAJA_STAGE, BAJA_LAG, BAJA_STEP, BAJA_MAX

!

-- END READ OF MEXICO DATA

RETURN END

!==================================================================

! SET MEXICO IMPOR TS AND EXPORTS

!==================================================================

SUBROUTINE NGOUT_MEX IMPLICIT NONE

! THIS SUBROUTINE WILL MAP MEXICAN IMPORTS AND EXPORTS TO THEIR ! APPROPRIATE NGTDM REGIONS

include'parametr' ! nems dimension parameters include'ncntrl' ! nems control variables include'ngparinc' ! ngtdm parameters include'ngtdminc' include'ngdtminc' ! ngtdm system variables include'ogsm imp' include'ogglobal'

INTEGER*4 IYR, NYR ! LOOP YEAR INTEGER*4 NR ! LOOP VARIABLES INTEGER*4 N ! LOOP INTEGER*4 M ! LOOP

REAL*4 PEMEX_CON(YR1PEMEX:IENDYR) REAL*4 IND_CON(YR1PEMEX:IENDYR) REAL*4 ELE_CON(YR1PEMEX:IENDYR) REAL*4 RC_CON(YR1PEMEX:IENDYR) REAL*4 TOT_CON(YR1PEMEX:IENDYR) REAL*4 STOT_CON(YR1PEMEX:IENDYR) REAL*4 NTOT_CON(YR1PEMEX:IENDYR)

R EAL*4 MEXPRD(PEMEX_NR,YR1PEMEX:IENDYR) REAL*4 TOT_PRD(YR1PEMEX:IENDYR)REAL*4 STOT_PRD(YR1PEMEX:IENDYR) REAL*4 NTOT_PRD(YR1PEMEX:IENDYR)

REAL*4 SPRD_CON(YR1PEMEX:IENDYR) REAL*4 NPRD_CON(YR1PEMEX:IENDYR) REAL*4 TPRD_CON(YR1PEMEX:IENDYR) REAL*4 PRC_FAC REAL*4 EMEXPRD(4) ! EXPECTED=ACTUAL MEXICAN PRODUCTION BY 4 QUADRANT REGIONS

LOGICAL ONCE/.TRUE./ IF (ONCE) THEN ONCE = .FALSE.

!

-- MEXICO CONSUMPTION

-- ! PARSE HIST CON TO SECTORS/PEMEX

DO IYR=BASEYR,YR2PEMEX PEMEX_CON(IYR) = HPEMEX_SHR * IEA_CON(IYR) IND_CON(IYR) = HIND_SHR * IEA_CON(I YR) ELE_CON(IYR) = HELE_SHR * IEA_CON(IYR) RC_CON(IYR) = HRC_SHR * IEA_CON(IYR)

TOT_CON(IYR) = IEA_CON(IYR) ENDDO ! APPLY GROWTH TO SECTOR CONSUMP DO IYR=YR2PEMEX+ 1, IJUMPYR+BASEYR

- 1 PEMEX_CON(IYR) = PEMEX_CON(IYR

- 1) * (1. + PEMEX_GFAC(iyr)) IND_CON(IYR) = IND_CON(IYR

- 1) * (1. + IND_GFAC(iyr)) ELE_CON(IYR) = ELE_CON(IYR

- 1) * (1. + ELE_GFAC(iyr)) RC_CON(IYR) = RC_CON(IYR

- 1) * (1. + RC_GFAC(iyr))

TOT_CON(IYR) = PEMEX_CON(IYR) + IND_CON(IYR) + &

ELE_CON(IYR) + RC_CON(IYR) ENDDO

! SPLI T CONSUMP INTO N & S (TOTAL SECTORS) DO IYR=BASEYR, IJUMPYR+BASEYR

- 1

STOT_CON(IYR) = PEMEX_CON(IYR)*SPEMEX_SHR + & IND_CON(IYR)*SIND_SHR + & ELE_CON(IYR)*SELE_SHR + & RC_CON(IYR)*SRC_SHR NTOT_CON(IYR) = PEMEX_CON(IYR)*NPEMEX_SHR + & IND_CON(IYR)*NIND_SHR + & ELE_CON(IYR)*NELE_SHR + & RC_CON(IYR)*NRC_SHR ENDDO

!

-- MEXICO PRODUCTION

--

DO IYR=BASEYR,YR2PEMEX ! HISTORICAL YEARS SPLIT IEA PROD INTO PEMEX REGIONS

DO NR=1,PEMEX_NRMEXPRD(NR,IYR) = IEA_PRD(IYR) * & (PEM EX_PRD(NR,IYR) / TPEMEX_PRD(IYR)) TOT_PRD(IYR) = IEA_PRD(IYR) ENDDO
STOT_PRD(IYR) = MEXPRD(1,IYR) + MEXPRD(2,IYR) NTOT_PRD(IYR) = MEXPRD(3,IYR) ! SURPLUS/DEFICIT SPRD_CON(IYR) = STOT_PRD(IYR)

- STOT_CON(IYR) NPRD_CON(IYR) = NTOT_PRD(IYR)

- NTOT_CON(IYR) TPRD_CON(IYR) = TOT_PRD(IYR)

- TOT_CON(IYR) ENDDO

! SET MEX PRODUCTION

DO IYR=YR2PEMEX+1, IJUMPYR+BASEYR

- 1 ! FORE CAST YEARS TOT_PRD(IYR) = 0.0 IF (NCNMX.EQ.2 .OR. NCNMX.EQ.3) THEN ! NEW METHOD USING INGM INPUTS

CALL NGMEX_INGM(IYR,EMEXPRD) MEXPRD(1,IYR) = EMEXPRD(3) MEXPRD(2,IYR) = EMEXPRD(4) MEXPRD(3,IYR) = EMEXPRD(1) + EMEXPRD(1) DO NR=1,4 TOT_PRD(IYR) = TOT_PRD(IYR) + EMEXPRD(NR) ENDDO ELSE ! OLD METHOD WITH GROWTH FACTORS AND PRICE ADJUSTME NTS

DO NR=1,PEMEX_NR PRC_FAC = (oOGWPRNG(MNUMOR,IYR

- BASEYR+1) & ! Patch put in by Dana as per Mary Hutzler to get variation across cases /(6.14*oMC_PCWGDP(

- 2)/oMC_PCWGDP(19)))**0.031 25

- 1. ! $6.00 is set to be approx avg import prc over forecast period for AEO2008 PRC_FAC = AMIN1(PRC_FAC,0.05)

WRITE(NGUNIT,*) 'mexfac',IYR,NR,PRD_GFAC(NR,IYR),PRC_FAC MEXPRD(NR,IYR) = MEXPRD(NR,IYR

- 1) * (1.+ PRD_GFAC(NR,IYR)+PRC_FAC)

TOT_PRD(IYR) = TOT_PRD(IYR) + MEXPRD(NR,IYR) ENDDO ENDIF STOT_PRD(IYR) = MEXPRD(1,IYR) + MEXPRD(2,IYR) NTOT_PRD(IYR) = MEXPRD(3,IYR) ! SURPLUS/DEFICIT SPRD_CON(IYR) = STOT_PRD(IYR)

- STOT_CON(IYR) + (MEXLNG(1,IYR)) + (MEXLNG(2,IYR))

NPRD_CON(IYR) = NTOT_PRD(IYR)

- NTOT_CON(IYR) + (MEXLNG(3,IYR)) + (MEXLNG(4,IYR)) + (MEXLNG(5,IY R))

TPRD_CON(IYR) = TOT_PRD(IYR)

- TOT_CON(IYR) + & (MEXLNG(1,IYR)) + (MEXLNG(2,IYR))+ (MEXLNG(3,IYR)) + (MEXLNG(4,IYR)) + (MEXLNG(5,IYR))

! CALC EXP FR MEX, IMP TO MEXIF (IYR.GE.YR 2PEMEX+3) THEN ! BEYOND STEO YEARS (STEO

YEARS ARE READ INTO IMP/EXP ARRAYS

IF (TPRD_CON(IYR) .GT. 0.0) THEN EXP_FRMEX(IYR) = TPRD_CON(IYR) ELSE EXP_FRMEX(IYR) = DEXP_FRMEX ENDIF IF (TPRD_CON(IYR) .LT. 0.0) THEN IMP_TOMEX(IYR) = EXP_FRMEX(IYR)

- TPRD_CON(IYR) ! was + 80., PG2 changed 2002 calibration to match actual imports vs. implied fr prod

- cons. ELSE

IMP_TOMEX(IYR) = IMP_TOMEX(IYR

- 1) * DFAC_TOMEX EXP_FRMEX(IYR) = EXP_FRMEX(IYR) + IMP_TOMEX(IYR) ENDIF ENDIF ENDDO

!

-- US IMPORTS/EXPORTS FROM MEXICO AT BORDER CROSSINGS

-- ! FILL IN NGTDM US IMP/EXPORT ARR AY ! (US IMP ARE MEX EXP, US EXP ARE MEX IMP) DO IYR=BASEYR, IJUMPCALYR

NYR = IYR

- BASEYR +1 DO NR=1,MEXBORDER MEXIMP(NR,NYR) = EXP_FRMEX(IYR) * MEXIMP_SHR(NR,IYR) MEXEXP(NR,NYR) = IMP_TOMEX(IYR) * MEXEXP_SHR(NR,IYR) ENDDO WRITE(NGUNIT,*) 'mexico',IYR,TOT_CON(IYR),TOT_PRD(IYR),TPRD_CON(IYR)

ENDDO

ENDIF ! END OF DO ONCE CONDITIONAL

! MAP IMPORTS AND EXPOR TS TO VARIABLES DO N = 1,IJUMPYR oOGQNGIMP(7,N) = MEXIMP(1,N) oOGQNGEXP(7,N) = MEXEXP(1,N) oOGQNGIMP(8,N) = MEXIMP(2,N) oOGQNGEXP(8,N) = MEXEXP(2,N) oOGQNGIMP(9,N) = MEXIMP(3,N) oOGQNGEXP(9,N) = MEXEXP( 3,N) oOGQNGIMP(MNUMBX

- 2,N) = oOGQNGIMP(7,N)+oOGQNGIMP(8,N)+oOGQNGIMP(9,N)

oOGQNGEXP(MNUMBX

- 2,N) = oOGQNGEXP(7,N)+oOGQNGEXP(8,N)+oOGQNGEXP(9,N) ENDDO

RETURN END

!=========================================================== =======

! WRITE MEXICO RESULTS!==================================================================

SUBROUTINE NGREP_MEX(IYR) IMPLICIT NONE

include'parametr' ! nems dimension parameters include'ncntrl' ! nems control variables include'ngparinc' ! ngtdm parameters include'ngtdminc' include'ngdtminc' ! ngtdm system variables include'ogglobal'

INTEGER*4 M ! LOOP INTEGER*4 IYR ! REPORTING YEAR

!

--------------

IF (PRTDBGL.EQ.1) THEN ! OGSM REPORTING FLAG VARIABLE

WRITE(NGUNIT,*) WRITE(NGUNIT,*) ' CURRENT YEAR', IYR+IBASYR WRITE(NGUNIT,*) ' ********************* *******************' WRITE(NGUNIT,*) ' ***** MEXICAN GAS IMPORTS/EXPORTS *****' WRITE(NGUNIT,*) ' GAS UNITS = BCF' WRITE(NGUNIT,*) ' ****************************************' WRITE(NGUNIT,*) WRITE(NGUNIT,720) WRITE(NGUNIT,905) (oOGQNGIMP(M,IYR),M=7,9) WRITE(NGUNIT,906) (oOGQNGEXP(M,IYR),M=7,9) WRITE(NGUNIT,*) WRITE(NGUNIT,907) (oOGPNGIMP(M,IYR),M=7,9) WRITE(NGUNIT,908) (oOGPNGEXP(M,IYR),M=7,9)

720 FORMAT(36X,'TEXAS',5X,'ARIZONA/NEW MEXICO',5X,'CALIFORNIA') 905 FORMAT(1X,'BORDER CROSSING

- IMPORTS',2F15.2,5X,F15.5) 906 FORMAT(1X,'BORDER CROSSING

- EXPORTS',2F15.2,5X,F15.5) 907 FORMAT(1X,'BORDER PRICES

- IMPORTS ',2F15.2,5X,F15.5) 908 FORMAT( 1X,'BORDER PRICES

- EXPORTS ',2F15.2,5X,F15.5)

ENDIF

RETURN END

!==================================================================

! SET BAJA GAS TO MEXICO AND TOTAL INTO BAJA

!====================================================== ============
SUBROUTINE NGBAJA_LNG IMPLICIT NONEinclude'parametr' ! nems dimension parameters include'ncntrl' ! nems control variables include'ngparinc' ! ngtdm parameters include'ngtdminc' in clude'ngdtminc' ! ngtdm system variables include'ogglobal'

INTEGER*4 M ! LOOP INTEGER*4 N ! LOOP INTEGER*4 I ! LOOP REAL*4 DELTA REAL*4 ADD(5) ! MARKET PRICE ADJUSTMENT, ADDED TO TRIGGER WHEN STAGE NOT UNDER CONSTRUCTION ALREADY INTEGER BUSY(MNUMYR) INTEGER BAJA_YR INTEGER FORYR

!

--------- LOGICAL ONCE/.FALSE./

! SET PRICES FOR TESTING PURPOSES ONLY ! IF (MODYR.GT.2010) THEN ! oPBAJA(CURIYR) = 4.05 ! ELSEIF (MODYR.GT.2008) THEN ! oPBAJA(CURIYR) = 3.05 ! ELSE ! oPBAJA(CURIYR) = 2.00 ! ENDIF

IF (.NOT.ONCE) THEN DO M=1,IJUMPYR BAJA_FLOW(M) = 0.0 BUSY(M) = 0 ENDDO ONCE=.TRUE. ENDIF

! PROCESS PROFIT VECTOR

ADD = 0.0 DO I=2,3 ! force 1st step so don't add price adjustment, 3 is max number of steps

ADD(I) = oMKTPRC_ADD(CURIYR) ENDDO

! Changed following to prevent LNG in Baja prior to 2008 when Costa Azul comes on ! IF (MODYR.GE.YR2PEMEX.AND.LNGDATA.NE.0) THEN

IF (MODYR.GE.2006.AND.LNGDATA.NE.0 .AND. BAJA_STAGE.LE.5) THEN IF (oPBAJA(CURIYR) .GE. (BAJA_PRC(BAJA_STAGE)+ADD(BAJA_ STAGE)).AND. &

oPBAJA(CURIYR

- 1) .GE. (BAJA_PRC(BAJA_STAGE)+ADD(BAJA_STAGE)).AND. &oPBAJA(CURIYR

- 2) .GE. (BAJA_PRC(BAJA_STAGE)+ADD(BAJA_STAGE)))

THEN IF (BUSY(CURIYR) .EQ. 0 .AND. BAJA_STAGE.LT.5) THEN

BAJA_MAX = BAJA_MAX + BAJA_CAP(BAJA_STAGE) BAJA_YR = CURIYR + BAJA_LAG IF (BAJA_YR .LE. IJUMPYR) THEN ! if cap utz is < 1, then cannot add capacity

FORYR = BAJA_YR + BAJA_STEP

- 1

IF (FORYR.GT.IJUMPYR) FORYR = IJUMPYR DO M= CURIYR,FORYR BUSY(M) = 1 ENDDO DO M= BAJA_YR,FORYR N = M DO WHILE (N.LE.IJUMPYR) BAJA_FLOW(N) = AMIN1(BAJA_FLOW(N) + BAJA_CAP(BAJA_STAGE)/3.0, & BAJA_FLOW(N)+BAJA_CAP(BAJA_STAGE)/BAJA_STEP) IF (BAJA_FLOW(N).GT.BAJA_MAX) BAJA_FLOW(N) = BAJA_MAX WRITE(NGUNIT,*) 'LNG_BAJA',MODYR,n+IBASYR

- 1, & BAJA_FLOW(N),BAJA_MAX N = N+1 ENDDO ENDDO ENDIF BAJA_STAGE = BAJA_STAGE + 1 ENDIF ENDIF ELSEIF (LNGDATA.EQ.0) THEN DO M= CURIYR,IJUMPYR BAJA_FLOW(M) = BAJA_FIX(M) ENDDO ENDIF
WRITE(NGUNIT,*)'baja',MODYR,oPBAJA(CURIYR),BAJA_FLOW(CURIYR)

! MAP LNG FLOW FROM BAJA to CALIFORNIA

RETURN END

!

------------------------------------------------------------------------

-----
SUBROUTINE NGADD_MEX ! called if NCRL=1 to set future years

IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngtdminc' include 'ngitminc'include 'ogglobal'

REAL*4 DEL ! TEMPORARY HOLDER OF DIFFERENCE INTEGER*4 A ! HOLD ARRAY NUMBER INTEGER*4 XING ! BAJA BORDER CROSSING INTEGER*4 I ! INDEX

IF (MODYR.GE.1999) THEN CALL NGREP_MEX(CURIYR) CALL NGBAJA_LNG ELSE BAJA_FLOW = 0.0 ENDIF

DEL = AMAX1(0.0,MEXLNG(5,MODYR+1)

- BAJA_FLOW(CURIYR+1)) MEXLNG(5,MO DYR+1) = AMIN1(MEXLNG(5,MODYR+1),BAJA_FLOW(CURIYR+1)) IF (FIXLNGFLG) THEN oQBAJA(CURIYR+1) = BAJA_FLOW(CURIYR+1)

- MEXLNG(5,MODYR+1) ELSE A = NODE_2ARC(35,12) ! Baja to California PLANPCAP(A,MODYR+1) = (BAJA_FLO W(CURIYR+1)

- MEXLNG(5,MODYR+1))

- & (BAJA_FLOW(CURIYR)

- MEXLNG(5,MODYR))

oQBAJA(CURIYR) = FLOW(PKNET,A) + FLOW(OPNET,A) ENDIF DO I=1,MEXBORDER oOGQNGEXP(CANBORDER+I,CURIYR+1) = MEXEXP(I,CURIYR+1) oOGQNGIMP(CANBORDER+I,CURIYR+1) = MEXIMP(I,CURIYR+1) ENDDO XING = CANBORDER+MEXBORDER ! CALIFORNIA CROSSING oOGQNGEXP(XING,CURIYR+1) = oOGQNGEXP(XING,CURIYR+1) + DEL oOGQNGIMP(XING,CURIYR+1) = oOGQNGIMP(XING,CURIYR+1) + oQBAJA(CURIYR+1)

! RELATED TO FIXLNGFLG FALSE ! A = NODE_2ARC(35,12) ! Baja to California ! PLANPCAP(A,MODYR+1) = (BAJA_FLOW(CURIYR+1)

- MEXLNG(5,MODYR+1))

- & ! (BAJA_FLOW(CURIYR)

- MEXLNG(5,MODYR)) ! oQBAJA(CURIYR) = FLOW(PKNET,A) + FLOW(OPNET,A)

RETURN END

!========================================================================

=====

SUBROUTINE NGME X_INGM(year,EMEXPRD) IMPLICIT NONE

include'parametr' ! nems dimension parameters include'ncntrl' ! nems control variablesinclude'ngparinc' ! ngtdm parameters include'ngtdminc' include'ngdtminc' ! ngtdm system variables include'ogglobal' include'pmmrpt' include'macout' include'ogsmimp'

integer*4 year REAL*4 EMEXPRD(4) INTEGER*4 R ! LOOP INTEGER*4 T ! LOOP INTEGER*4 S ! Supply Step INTEGER*4 X, iyr real*4 temp

!Existing reserves

iyr=year

- baseyr+1 SPPrc=RFIPQCLL(2,iyr,1)*MC_JPGDP(2008

- 1989) !Imported Low

- Sulfur Light Crude SPPrc=SPP rc/6.054 ! convert from bbl to mmbtu if ((NCNMX.eq.2).and.(curitr.eq.1)) BPPrc=BPPrc*BPPrcGr

If (year.eq.2009) then

do r=NCREG+1,NUMREG

- 1 do t=1,5 ResE(r,t) = IRes(r,t) PrdE(r,t) = IRes(r,t) * (IPR(r,t) /(1.0

- IPR(r,t))) IRGX(r,t) = IRG(r,t)/(1.0+IRG(r,t))

!Undiscovered resources

do s=1,STEP_MX(r

- NCREG) EResNlag(s,r,t) = 0. AIMASP(s,r,t) = IMASP(1,s,r,t) + (DMasp(1,s,r,t) * (SPPrc

BPPrc)) AFMASP(s,r,t) = FMASP(1,s,r,t) + (DMasp(1,s,r,t) * (SPPrc

BPPrc)) SFC(s,r,t) = 0.0

PrdN(s,r,t) = 0.0 URGX(s,r,t) = URG(1,s,r,t)/(1+URG(1,s,r,t)) enddo ! S enddo ! t enddo ! r

endif do r=NCREG +1,NUMREG

- 1 do t=1,5 RigMx(iyr,r) = IRigA(1,1) * (1+RGrwth(1,iyr)) if (curitr.eq.1) then ! set lags PrdElag(r,t)=PrdE(r,t) do s=1,STEP_MX(r)PrdNlag(s,r,t)=PrdN(s,r,t) SFClag(s,r,t) = SFC(s,r,t) SFCXlag(s,r,t)=SFCX(s,r,t) EResNlag(s,r,t)=EResN(s,r,t) enddo endif

!Existing Reserves

PrdE(r,t) = (ResE(r,t) + 0.5* IRGX(r,t) * PrdElag(r,t)) * IPR(r,t) ResE(r,t) = ResE(r,t) + IRGX(r,t) * PrdElag(r,t)

- PrdE(r,t)

! Undiscovered Resources write(*,*) 'debug step',STEP_MX(r

- NCREG)

Do s=1,STEP_MX(r

- NCREG) ! convert oOGWPRNG to $2008

temp=AMin1(1.0, (SFC(s,r ,t) + DFr(2,s,r,t)) ,(( (MC_JPGDP(2008

- 1989)*oOGWPRNG(r,iyr))

- AIMASP(s,r,t))/( AFMASP(s,r,t)

- AIMASP(s,r,t))))

SFCX(s,r,t) = AMax1(SFC(s,r,t),temp) EResNX(s,r,t) = EResNlag(s,r,t) + (SRCX(s,r,t)

- SRCXlag(s,r,t)) * URes(2,s,r,t) + PrdNlag (s,r,t) * URGX(s,r,t)

Trig1(x,r,t) = Trig1(x,r,t)+( PrdNlag(s,r,t) * URGX(s,r,t) * RRq(x,s,r,t))

TRigX(x,r,t) = TRigX(x,r,t)+ ( (EResNX(s,r,t)

- EResNlag(s,r,t)) * RRq(x,s,r,t))

temp=AMIN1(1.0,((RigMx(iyr,r)

- Trig1(x,r,t))/(TRigX(x,r,t)

- Trig1(x,r,t))))

TRigY(x,r,t) = AMAX1(0.0,temp) SFC(s,r,t) = SFClag(s,r,t) + (SFCX(s,r,t)

- SFClag(s,r,t)) *TrigY(x,r,t)

EResNY(s,r,t) = EResNlag(s,r,t) + (SFC(s,r,t)

- SFCl ag(s,r,t)) * URes(2,s,r,t) + PrdNlag(s,r,t) * URGX(s,r,t)

TRig(r,t) = Trig(r,t)+ ((EResNY(s,r,t)

- EResNlag(s,r,t)) * RRq(x,s,r,t))

PrdN(s,r,t) = (EResNY(s,r,t) + EResNlag(s,r,t))/2.0* PRat(2,s,r,t) write(*,*) 'debug mex calc',year,PrdN(s,r ,t),EResNY(s,r,t),EResNlag(s,r,t),PRat(2,s,r,t),s,r,t

EResN(s,r,t) = EResNY(s,r,t)

- PrdN(s,r,t) enddo enddo !t enddo !r

! Output

do r=NCREG+1,NUMREG

- 1 PrdA(r)=0.0 reserves(r)=0.0 Do t=1,5 Do s=1,STEP_MX(r) PrdA(r) = PrdN(s,r,t)+PrdA(r) reserves(r)=EResN(s,r,t)+reserves(r) enddoPrdA(r)=PrdA(r)+PrdE(r,t) enddo enddo

d o r=1,4 EMEXPRD(r)=PrdA(r+NCREG) write(*,*) 'debug mex prd',emexprd(r),r,year enddo

return end

!========================================================================

=====

Subroutine NGC AN_INGM

IMPLICIT NONE

include'parametr' ! nems dimension parameters include'ncntrl' ! nems control variables include'ngparinc' ! ngtdm parameters include'ngtdminc' include'ngdtminc' ! ngtdm syste m variables include'ogglobal' include'pmmrpt' include'macout'

INTEGER*4 R ! LOOP INTEGER*4 T ! LOOP INTEGER*4 S ! Supply Step INTEGER*4 X real*4 temp

SPPrc=RFIPQCLL(2,curiyr,1)*MC_JPGDP(2008

- 1989) !Imported Low

- Sulfur Light Crude SPPrc=SPPrc/6.054 ! convert from bbl to mmbtu if (curitr.eq.1) BPPrc=BPPrc*BPPrcGr ! write(*,*) 'debug td prices',SPPrc,BPPrc,curiyr

!Existing reserves If (curiyr.eq.21) then !2010

do r=1,NCREG do t=1,5 ResE(r,t) = IRes(r,t) PrdE(r,t) = IRes(r,t) * (IPR(r,t) /(1.0

- IPR(r,t))) IRGX(r,t) = IRG(r,t)/(1.0+IRG(r,t))

! Undiscovered resources

do s=1,STEP_CN(r) EResNlag(s,r,t) = 0.AIMASP(s,r,t) = IMASP(1,s,r,t) + (DMasp(1,s,r,t) * (SPPrc

BPPrc)) AFMASP(s,r,t) = FMASP(1,s,r,t) + (DMasp(1,s,r,t) * (SPPrc

BPPrc)) SFC(s,r,t) = 0.0

PrdN(s,r,t) = 0.0 URGX(s,r,t) = URG(1,s,r,t)/(1+URG(1,s,r,t)) enddo ! S enddo ! t enddo ! r

endif

do r=1,NCREG do t=1,5 RigMx(curiyr,r) = IRigA(r,1) * (1+RGrwth(r,curiyr) ) if (curitr.eq.1) then ! set lags PrdElag(r,t)=PrdE(r,t) do s=1,STEP_CN(r) PrdNlag(s,r,t)=PrdN(s,r,t) SFClag(s,r,t) = SFC(s,r,t) SFCXlag(s,r,t)=SFCX(s,r,t) EResNlag(s,r,t)=EResN(s,r,t) enddo endif

!Existing Reserves

PrdE(r,t) = (ResE(r,t) + 0.5* IRGX(r,t) * PrdElag(r,t)) * IPR(r,t) ResE(r,t) = ResE(r,t) + IRGX(r,t) * PrdElag(r,t)

- PrdE(r,t)

! Undiscovered Resources

x=1 ! temp til get more rig data Do s=1,STEP_CN(r) ! if (curiyr.eq.22) write(*,*) 'debug conversions',oOGCNPPRD(r,curiyr),AIMASP(s,r,t),s

temp=AMin1(1.0, (SFC(s,r,t) + DFr(1,s,r,t)) ,& (( (MC_JPGDP(2008

- 1989)*oOGCNPPRD(r,curiyr))

- AIMASP(s,r,t))/( AFMASP(s,r,t)

- AIMASP(s,r,t))))

SFCX(s,r,t) = AMax1(SFC(s,r,t),temp) EResNX(s,r,t) = EResNlag(s,r ,t) + (SRCX(s,r,t)

- SRCXlag(s,r,t)) * URes(1,s,r,t) + PrdNlag(s,r,t) * URGX(s,r,t)

Trig1(x,r,t) = Trig1(x,r,t)+( PrdNlag(s,r,t) * URGX(s,r,t) * RRq(x,s,r,t))

TRigX(x,r,t) = TRigX(x,r,t)+ ( (EResNX(s,r,t)

- EResNlag(s,r,t)) * RRq(x,s,r,t))

temp=AMIN1(1.0,((RigMx(curiyr,r)

- Trig1(x,r,t))/(TRigX(x,r,t)

- Trig1(x,r,t))))

TRigY(x,r,t) = AMAX1(0.0,temp) SFC(s,r,t) = SFClag(s,r,t) + (SFCX(s,r,t)

- SFClag(s,r,t)) *TrigY(x,r,t)

EResNY(s,r,t) = EResNlag(s,r,t) + (SFC(s, r,t)

- SFClag(s,r,t)) * URes(1,s,r,t) + PrdNlag(s,r,t) * URGX(s,r,t)TRig(r,t) = Trig(r,t)+ ((EResNY(s,r,t)

- EResNlag(s,r,t)) *

RRq(x,s,r,t))

PrdN(s,r,t) = (EResNY(s,r,t) + EResNlag(s,r,t))/2.0* PRat(1,s,r,t)

EResN(s,r,t) = EResNY(s ,r,t)

- PrdN(s,r,t) !write(*,*) 'debug last',PrdN(s,r,t),EResNY(s,r,t),curiyr,curitr,r,s,t

enddo enddo !t enddo !r

! Output

do r=1,NCREG PrdA(r)=0.0 reserves(r)=0.0 Do t=1,5 Do s=1,STEP_CN(r) PrdA(r) = PrdN(s,r,t)+PrdA(r)

reserves(r)=EResN(s,r,t)+reserves(r)

enddo PrdA(r)=PrdA(r)+PrdE(r,t) if ((t.le.2).and.(r.eq.2)) write(*,*) 'debug td prod1',prda(r),prde(r,t),r,t,curiyr+baseyr

- 1

enddo write(*,*) 'debug td prod2',prda(r),r,curiyr+baseyr

- 1 enddo if (curitr.eq.1) oOGRESCAN(1,curiyr)=r eserves(1) if (curitr.eq.1) oOGRESCAN(2,curiyr)=reserves(2) oOGCNQPRD(1,Curiyr)=PrdA(1) oOGCNQPRD(2,curiyr)=Prda(2) oOGPRRCAN(1,curiyr)=PrdA(1)/reserves(1) oOGPRRCAN(2,curiyr)=PrdA(2)/reserves(2) !write(*,*) 'debug td prr1',Prda(1),reserves(1),oOGPRRCAN(1,curiyr)

write(*,*) 'debug td prr2',Prda(2),reserves(2),oOGPRRCAN(2,curiyr)

return end

!========================================================================

=====

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

! ROUTINE TO TRIGGER BUILDING OF ALASKAN PIPELINE TO ALBERTA

! ONLY CALLED IF CURITR.EQ.1

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =SUBROUTINE OLD_NGAKPTRIG ! trigger based on Alb price IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngitminc' include 'ngakinc' include 'ngtdminc' include 'ogglobal'

REAL*4 AKCOMPPRC REAL*4 NGFRPIPE_TAR REAL* 4 MINPRC REAL*4 FE_FUELADJ ! ADJUSTMENT IN PIPELINE FLOW TO ALBERTA WITH FE PIPELINE FUEL IMPROVEMENT SCENARIO

INTEGER*4 I INTEGER*4 JENDYR ! LAST YEAR VALUE CORRESPONDS TO IENDYR EXTERNAL RTOVALUE INTEGER RTOVALUE

!

--- -----------------------------------------

JENDYR = RTOVALUE('IJUMPCAL',2030)

IF (CURIYR.EQ.1) THEN AKPIP1 = 0 AKPIP2 = 0 QAK_ALB = 0.0 ENDIF
IF (MODYR+FR_PCNSYR(1).LT.FR_PMINYR(1)) RETURN

AKCOMPPRC = NGFRPIPE_TAR(MODYR,1)+FR_PMINWPR(1)+FR_PTREAT(1)+FR_PFUEL(1)+FR_PRISK(1)

FE_FUELADJ = (1.0

- (AK_PCTPIP(3) * FE_PFUEL_FAC(MODYR))) / (1.0

- AK_PCTPIP(3))

IF (AKPIP1.EQ.0 .OR. AKPIP2.EQ.0) THEN ! EM4 TRACK

-- routine not used

MINPRC = 100.0 DO I=1,FR_PPLNYR(1) MINPRC = AMIN1(oOGCNPPRD(2,CURIYR

- I),MINPRC) ENDDO IF ((oOGCNPPRD(2,CURIYR

1)*(1.+FR_PDRPFAC(1))).GT.oOGCNPPRD(2,CURIYR

- 2)) THEN

MINPRC = AMIN1( (oOGCNPPRD(2,CURIYR

- 1) * (1.+ (FR_PDRPFAC(1)/2.))),MINPRC )

ENDIF

IF (AKPIP1.EQ.0) THEN IF (MINPRC.GE.AKCOMPPRC) THENAKPIP1 = MODYR + FR_PCNSYR(1) QAK_ALB(AKPIP1) = FE_FUELADJ * FR_PVOL(1) / 2. DO I=AKPIP1+1,JENDYR QAK_ALB(I) = FE_FUELADJ * FR_PVOL(1) ENDDO ENDIF ELSE IF (MODYR.GE.AKPIP1+1 .AND. AKPIP2.EQ.0) THEN IF (MINPRC.GE.(AKCOMPPRC+FR_PADDTAR(1))) THEN AKPIP2 = MODYR+1 QAK_ALB(AKPIP2) = FE_FUELADJ * FR_PVOL(1) * (1. + (FR_PEXPFAC(1)/2.) )

DO I=AKPIP2+1,JENDYR QAK_ALB(I) = FE_FUELADJ * FR_PVOL(1) * (1. + FR_PEXPFAC(1)) ENDDO ENDIF ENDIF ENDIF

WRITE (NGUNIT,*) ' AKSWITCH => ACTUAL & NEEDED ',MODYR,MINPRC,AKCOMPPRC

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

! ROUTINE TO TRIGGER BUILDING OF ALASKAN PIPELINE TO ALBE RTA

! ONLY CALLED IF CURITR.EQ.1

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

SUBROUTINE NGAKPTRIG(HGRW) IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngitminc' include 'ngakinc' include 'ngtdminc' include 'ogglobal'

REAL*4 AKCOMPPRC REAL*4 NGFRPIPE_TAR REAL*4 MINPRC REAL*4 TOTAL REAL*4 MINWPR ! TRANSFER HOLD FOR FR_PMINWPR FOR TECH CASES REAL* 4 TECHFAC ! GENERAL TECHNOLOGY RUN TIME FACTOR REAL*4 NERVFAC ! NERVOUS FACTOR DUE TO DECLINING PRICES REAL*4 DELTA ! DECLINING PRICE INDICATOR REAL*4 REMWT ! HOLDING ARRAY FOR WEIGHT TERMSREAL*4 AVGFUT ! AVERAGE EXPECTED FUTURE PRICE (NEXT 3

YEARS) REAL*4 FE_FUELADJ ! ADJUSTMENT IN PIPELINE FLOW TO ALBERTA WITH FE PIPELINE FUEL IMPROVEMENT SCE NARIO

INTEGER*4 HGRW ! INDICATOR EXPECTING HIGH CONS GROWTH (=1 YES, =0 NO) INTEGER*4 RTOVALUE ! RETURN VALUE FOR SENS ANALYSIS INTEGER*4 TECHCASE ! REF=1, LTEC=0, HTEC=1 INTEGER*4 I,J INTEGER*4 JENDYR ! LAST YEAR VALUE CORRESPONDS TO IENDYR EXTERNAL RTOVALUE

LOGICAL ONCE,ONCE2 DATA ONCE /.TRUE./,ONCE2/.TRUE./

!

--------------------------------------------

JENDYR = RTOVALUE('IJUMPCAL',2030)

IF (CURIYR.EQ.1) THEN AKPIP1 = 0 AKPIP2 = 0 QAK_ALB = 0.0 ENDIF

! ANGTS CAN ONLY TURN ON IF MACKENZIE DELTA NOT UNDER CONSTRUCTION

IF (MDPIP1.NE.0 .AND. MDPIP1.GT.MODYR) RETURN

! RESET EARLIEST START YEAR

IF (HGRW.EQ.1 .AND. ONCE 2) THEN FR_PMINYR(1) = FR_PMINYR(1)

- 2 ONCE2 = .FALSE. ENDIF FR_PMINYR(1) = MAX(FR_PMINYR(1),(MDPIP1

- FR_PCNSYR(1))) IF ((MODYR + FR_PCNSYR(1)) .LT. FR_PMINYR(1)) RETURN

! IF ((MODYR+FR_PCNSYR(1).LT.FR_PMINYR(1) .AN D. HGRW.EQ.0) .OR. MDPIP1.EQ.0 ) RETURN ! IF (MODYR.LT.MDPIP1 .AND. HGRW.EQ.0) RETURN

FE_FUELADJ = (1.0

- (AK_PCTPIP(3) * FE_PFUEL_FAC(MODYR))) / (1.0

- AK_PCTPIP(3))

IF (ONCE) THEN !gtl TOTAL = 0.0 !gtl DO I=1,IJUMPYR !gtl TOTAL = TOTAL + oAKGTL_NGCNS(I) !gtl ENDDO !gtl IF (TOTAL .GT. 0.0001) THEN !gtl FR_PMINWPR(1) = FR_PMINWPR(1) + 0.15 ! ESIMATE OF AVG ADD COST SHOULD GTL USE CHEAP GAS (?incl treat & fuel)!gtl ENDIF

TECHCASE = RTOVALUE ('OGTECH ',1) TECHFAC = 0.0 IF (TECHCASE.EQ.0) TECHFAC = FLOAT(RTOVALUE('OGTECADJ',0))/100. IF (TECHCASE.EQ.2) TECHFAC =

- 1. * FLOAT(RTOVALUE('OGTECADJ',0))/100.

ONCE = .FALSE. ENDIF
MINWPR = FR_PMINWPR(1) * (1. + ((REAL(MODYR

LHISYR+1)/REAL((LASTYR+IBASYR

- 1)

- (LHISYR+1))) * TECHFAC * 0.25) ) + &

FR_PTREAT(1) + FR_PFUEL(1)

! AKCOMPPRC = 3.15 * oMC_PCWGDP(

- 2) / oMC_PCWGDP(11) ! 3.15 = 1.30 tar + 0.8 FR _PMINWPR(1) + 0.35 FR_PRISK(1) + ALB_TO_L48 ! (?? TREAT & FUEL) AKCOMPPRC = NGFRPIPE_TAR(MODYR,1) + MINWPR + FR_PRISK(1) + ALB_TO_L48

IF (AKPIP1.EQ.0 .OR. AKPIP2.EQ.0) THEN ! MINPRC = 100.0

MINPRC = 0.0 ! a04 IF (AK PIP1.EQ.0) THEN DO I=1,FR_PPLNYR(1) !a04 MINPRC = AMIN1(oOGWPRNG(MNUMOR,CURIYR

- I),MINPRC)

MINPRC = MINPRC + (oOGWPRNG(MNUMOR,CURIYR

- I) * PRCWTS(I)) ! a04 ENDDO

ELSE DO I=1,3 MINPRC = MINPRC + (oOGWPRNG(MNUMOR,CURIYR

- I) * PRCWTS2(I)) ! a04 ENDDO

ENDIF NERVFAC = 0.0 DO I=1,4 DELTA = oOGWPRNG(MNUMOR,CURIYR

- I)

- oOGWPRNG(MNUMOR,CURIYR

- I

- 1) IF (DELTA.LE.0.0) NERVF AC = NERVFAC

- (DELTA * 0.5) ENDDO NERVFAC = NERVFAC / 4. AKCOMPPRC = AKCOMPPRC + NERVFAC

IF (CURIYR.LE.IJUMPYR

- 2) THEN AVGFUT = 0.0 DO I=1,3 AVGFUT = AVGFUT + (oOGWPRNG(MNUMOR,CURIYR+ I

- 1) * FUTWTS(I)) ENDDO ENDIF

! IF ((oOGWPRNG(MNUMOR,CURIYR

1)*(1.+FR_PDRPFAC(1))).GT.oOGWPRNG(MNUMOR,CURIYR

- 2)) THEN ! MINPRC = AMIN1( (oOGWPRNG(MNUMOR,CURIYR

- 1) * (1.+ (FR_PDRPFAC(1)/2.))),MINPRC )! ENDIF

IF (AKPIP1.EQ.0) THEN IF (HGRW.EQ.1 .OR. (MINPRC.GE.AKCOMPPRC .AND. oOGWPRNG(MNUMOR,CURIYR

- 1).GE.AKCOMPPRC & .AND. oOGWPRNG(MNUMOR,CURIYR

2).GE.AKCOMPPRC )) THEN ! .AND. oOGWPRNG( MNUMOR,CURIYR

2).GE.AKCOMPPRC .AND. AVGFUT.GE.AKCOMPPRC)) THEN ! IF (HGRW.EQ.1 .OR. ((MINPRC/AKCOMPPRC).GT.1.10) ) THEN ! AKPIP1 = MAX(MDPIP1,MODYR) + 3 ! ELSE

AKPIP1 = MODYR + FR_PCNSYR(1) ! ENDIF

IF(AKPIP1.LE.JENDYR) QAK_ALB(AKPIP1) = FE_FUELADJ * FR_PVOL(1) / 2.

DO I=AKPIP1+1,JENDYR QAK_ALB(I) = FR_PVOL(1) * FE_FUELADJ ENDDO ENDIF ELSE IF (MODYR.GE.AKPIP1+3 .AND. AKPIP2.EQ.0) THEN ! a04 IF (MDPIP2.NE.0 .AND. MODYR.GT.MDPIP2) THEN ! IF (MINPRC.GE.(AKCOMPPRC+FR_PADDTAR(1)) .AND. AVGFUT.GE.(AKCOMPPRC+FR_PADDTAR(1))) THEN

IF (MINPRC.GE.(AKCOMPPRC+FR_PADDTAR(1))) THEN AKPIP2 = MODYR+1 IF(AKPIP2.LE.JENDYR) QAK_ALB(AKPIP2) = FE_FUELADJ * FR_PVOL(1) * (1. + (FR_PEXPFAC(1)/2.) )

DO I=AKPIP2+1,JENDYR QAK_ALB(I) = FE_FUELADJ * FR_PVOL(1) * (1. + FR_PEXPFAC(1)) ENDDO

ENDIF ! a04 END IF

ENDIF ENDIF

WRITE (NGUNIT,1010) MODYR,MINPRC,oOGWPRNG(MNUMOR,CURIYR

1),oOGWPRNG(MNUMOR,CURIYR

- 2),AVGFUT,NERVFAC,AKCOMPPRC,AKPIP1,AKPIP2 1010 FORMAT(1X,'AKSWITCH => ACTUAL,T

- 1,T

- 2,FUTURE,NERV,NEEDED ',I5,6F11.6,2I5)

R ETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

! ROUTINE TO TRIGGER BUILDING OF PIPELINE FR MAC DELTA TO ALBERTA

! ONLY CALLED IF CURITR.EQ.1

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

SUBROUTINE NGMDPTRIG(HGRW)IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngitminc' include 'ngakinc' include 'ngtdminc' include 'ngcdmdinc' include 'ogglobal'

REAL*4 MDCOMPPRC REAL*4 NGFRPIPE_TAR REAL*4 MINPRC REAL*4 MINWPR ! TRANSFER HOLD FOR FR_PMINWPR FOR TECH CASES REAL*4 TECHFAC ! GENERAL TECHNOLOGY RUN TIME FACTOR REAL*4 DMDGRW ! CHANGE IN EX P CONS GROWTH FR CUR TIL WHEN PIPE FINISHED REAL*4 AVGFUT ! AVERAGE EXPECTED FUTURE PRICE (NEXT 3 YEARS) REAL*4 NERVFAC ! NERVOUS FACTOR DUE TO DECLINING PRICES REAL*4 DELTA ! DECLINING PRICE INDICATOR

INTEGER*4 HGRW ! INDICATES IF EXPECT HIGH CONS GROWTH (=1 YES, =0 NO) INTEGER*4 TECHCASE ! REF=1, LTEC=0, HTEC=1 INTEGER*4 I INTEGER*4 RTOVALUE ! RETURN VALUE FOR SENS ANALYSIS INTEGER*4 JENDYR ! LAST YEAR VALUE CORRESPONDS TO IENDYR EXTERNAL RTOVALUE LOGICAL ONCE DATA ONCE /.TRUE./

!

--------------------------------------------

JEN DYR = RTOVALUE('IJUMPCAL',2030)

IF (CURIYR.EQ.1) THEN MDPIP1 = 0 MDPIP2 = 0 QMD_ALB = 0.0 HGRW = 0 ENDIF

IF (AKPIP1.NE.0 .AND. AKPIP1.GT.MODYR) RETURN

IF (MODYR+FR_PCNSYR(2).LT.FR_PMINYR(2)) RETURN

IF (ONCE) THEN TECHCASE = RTOVALUE('OGTECH ',1) TECHFAC = 0.0 IF (TECHCASE.EQ.0) TECHFAC = RTOVALUE('OGTECADJ',0.0)/100. IF (TECHCASE.EQ.2) TECHFAC =

- 1. * RTOVALUE('OGTECADJ',0.0)/100.ONCE = .FALSE. ENDIF
IF (CURIYR+FR_PCNSYR(2).LE.IJUMPYR) THEN DMDGRW = oQNGAS(MNUMCR,CURIYR+FR_PCNSYR(2)) / oQNGAS(MNUMCR,CURIYR) ELSE DMDGRW = 1.0 ENDIF ! IF (DMDGRW.GT.1.1) HGRW = 1

MINWPR = FR_PMINWPR(2) * (1. + ((RE AL(MODYR

LHISYR+1)/REAL((LASTYR+IBASYR

- 1)

- (LHISYR+1))) * TECHFAC * 0.25) ) & ! * (1.+ 0.3*((oEXSPEND(1,CURIYR)/oEXSPEND(1,2005

- IBASYR+1))

- 1.)) &

* (1.+ 0.3*((oEXSPEND(1,CURIYR)/828.1056)

- 1.)) & ! hardwire a 2005 valu e from aeo2009, since redefined

+ FR_PTREAT(2) + FR_PFUEL(2)

! MDCOMPPRC = 3.15 * oMC_PCWGDP(

- 2) / oMC_PCWGDP(11) ! 3.15 = 1.30 tar + 0.8 FR_PMINWPR(2) + 0.35 FR_PRISK(2) + ALB_TO_L48 MDCOMPPRC = NGFRPIPE_TAR(MODYR,2) + MINWPR + FR_PRISK(2) + ALB_TO_L48

IF (MDPIP1.EQ.0 .OR. MDPIP2.EQ.0) THEN MINPRC = 100.0 MINPRC = 0.0 ! a04 DO I=1,FR_PPLNYR(2) ! a04 MINPRC = AMIN1(oOGWPRNG(MNUMOR,CURIYR

- I),MINPRC)

MINPRC = MINPRC + oOGWPRNG(M NUMOR,CURIYR

- I) ! a04 ENDDO MINPRC = MINPRC / FR_PPLNYR(2) ! a04 ! IF ((oOGWPRNG(MNUMOR,CURIYR

1)*(1.+FR_PDRPFAC(2))).GT.oOGWPRNG(MNUMOR,CURIYR

- 2)) THEN ! MINPRC = AMIN1( (oOGWPRNG(MNUMOR,CURIYR

- 1) * (1.+ (FR_PDRPFAC(2)/2.))),MINPRC ) ! ENDIF

NERVFAC = 0.0 DO I=1,4 DELTA = oOGWPRNG(MNUMOR,CURIYR

- I)

- oOGWPRNG(MNUMOR,CURIYR

- I

- 1) IF (DELTA.LE.0.0) NERVFAC = NE RVFAC

- (DELTA * 0.5) ENDDO NERVFAC = NERVFAC / 4. MDCOMPPRC = MDCOMPPRC + NERVFAC

IF (CURIYR.LE.IJUMPYR

- 2) THEN AVGFUT = 0.0 DO I=1,3 AVGFUT = AVGFUT + (oOGWPRNG(MNUMOR,CURIYR+I

- 1) * FUTWTS( I)) ENDDO ENDIFIF (MDPIP1.EQ.0) THEN

! a04 IF ( (MINPRC.GE.MDCOMPPRC .AND. oOGWPRNG(MNUMOR,CURIYR

1).GE.oOGWPRNG(MNUMOR,CURIYR

- 2)) .OR. HGRW.EQ.1) THEN

IF ( (MINPRC.GE.MDCOMPPRC .AND. AVGFUT.GE.MDCOMPPRC) .OR. HGRW .EQ.1) THEN ! a04

MDPIP1 = MODYR + FR_PCNSYR(2) IF(MDPIP1.LE.JENDYR) THEN QMD_ALB(MDPIP1) = FR_PVOL(2) / 2. CN_FIXSUP(5,MDPIP1) = QMD_ALB(MDPIP1) ENDIF DO I=MDPIP1+1,JENDYR QMD_ALB(I) = FR_PVOL(2) CN_FIXSUP(5,I) = QMD_ALB(I) ENDDO ENDIF ELSE IF (MODYR.GE.MDPIP1+3 .AND. MDPIP2.EQ.0) THEN !!!!!! IF (AKPIP1.EQ.0 .OR. (AKPIP1.NE.0 .AND. MODYR.GE.AKPIP1) ) THEN ! a04 IF (AKPIP1.NE.0 .AND. MODYR.GT.AKPIP1) THEN

IF (MINPRC.GE.(MDCOMPPRC+FR_PADDTAR(2)) .AND. AVGFUT.GE.(MDCOMPPRC+FR_PADDTAR(2)) ) THEN

MDPIP2 = MODYR+1 IF(MDPIP2.LE.JENDYR) THEN QMD_ALB(MDPIP2) = FR_PVOL(2 ) * (1. + (FR_PEXPFAC(2)/2.) ) CN_FIXSUP(5,MDPIP2) = QMD_ALB(MDPIP2) ENDIF DO I=MDPIP2+1,JENDYR QMD_ALB(I) = FR_PVOL(2) * (1. + FR_PEXPFAC(2)) CN_FIXSUP(5,I) = QMD_ALB(I) ENDDO ENDIF ! a04 ENDIF

ENDIF ENDIF

WRITE (NGUNIT,1000) MODYR,MINPRC,MDCOMPPRC,AVGFUT,NERVFAC,HGRW 1000 FORMAT(1X,' MDSWITCH => ACTUAL & NEEDED ',I4,1X,4F7.4,2X,I1)

RETURN END

!************************************************************************ ***************! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

! CODE TO REPRESENT SOME OF CANADA SUPPLY

!************************** ********************************************** ***************! = = = = = = = = = = = = = = = = = = = = = = = = = = = =!************************************************************************

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

! COAL

- TO

- GAS

! THIS SUBROUTINE WILL: ! 1. OBTAIN MINEMOUTH COAL PRICE AND WELLHEAD NG PRICE ! 2. CALC ANNUALIZED CAPREC+FXOC+OVC COSTS ! 3. DETERMINE WHETHER TO BUILD A CTG PLANT ! BASED ON THE PROFITABILITY OF THE MANSFIELD

- BLACKMAN ! 4. ONCE BUILT, THE CTG PL ANT WILL PROVIDE NG TO THE PIPELINE SUPPLY ! 5. COGEN WILL BE SUPPLIED TO THE GRID AT WHOLESALE MARKET PRICE ! !************************************************************************

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

SUBROUTINE NGCOAL2GAS IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ogglobal' include 'ngitminc' include 'ngtdminc' ! COMMON BLOCK WITH CTG VARIABLES include 'ngcdmdinc'

INTEGER*4 IYR ! YEAR INDEX VARIABLE INTEGER*4 RGN ! REGION INDEX VARIABLE INTEGER*4 REG ! NGTDM REGION INDEX VARIABLE INTEGER*4 CD ! CENSUS DIVISION INDEX VARIABLE INTEGER*4 JENDYR ! LAST YEAR VALUE CORRESPONDS TO IENDYR INTEGER*4 RTOVALUE ! External routine to get options EXTERNAL RTOVALUEREAL*4 CTGCOAL(MNUMCR,LHISYR:IENDYR) ! coal consumption for

syngas REAL*4 COGENCAP(MNUMCR,LHISYR:IENDYR)! cogen capacity

JENDYR = RTOVALUE('IJUMPCAL',2030)

DO REG=1,DNODES NG_AVG_PRICE(REG)=(NODE_ENDPR(1,REG)*PKSHR_YR)+& (NODE_ENDPR(2,REG)*(1

- PKSHR_YR))

! ADD CARBON TAX TO COAL PRICE ! THEN CONVERT 87$/MMBTU TO 87$/MCF !!! COAL_PRICE WILL COME FROM PCLGAS (87$/MMBTU) !!! REMEMBER TO CHANGE PCLEL TO PCLGAS !!!

CALL NGCD2NG ! MAP CD TO NGTDM REGIONS FOR PCLEL

COAL_PRICE(REG,MODYR)= (PCLGASNG(REG,MODYR)+oJCLIN(CURIYR))*1029/1000

CALL NG_EMM2CTG ! MAP NERC REGIONS TO NGTDM DENODES

CALL NGCTG_INVEST(REG) CALL NGCTG_ADJCST(REG) CTG_ PRICE(REG)=CTG_INVADJ(REG)+COAL_PRICE(REG,MODYR) ! INVEST COST + COAL PRICE ENDDO

CALL NGCHGCTG_BLDLIM(REG)

DO REG=1,DNODES Q_CTGPRD(REG,MODYR+1)= CUMCTGBLD(REG,MODYR+1)*CTG_PUCAP*0.90*365/1000 ! BCF/YR (90% UTZ)

SNG COAL(REG,MODYR+1)=SNGCOAL(REG,MODYR+1)+Q_CTGPRD(REG,MODYR+1) ! BCF/YR ENDDO

!COMBINE NGTDM REGIONS INTO CDs

DO CD=1,MNUMCR

- 2 Q_CTGPRDCD(1,MODYR+1)=0.0 ENDDO

DO REG=1,DNODES Q_CTGPRDCD(NG_CENMAP(REG),MODYR+1) = Q_CTGPRDCD(NG_CENMAP(REG),MODYR+1) + Q_CTGPRD(REG,MODYR+1)

COGENCAP(NG_CENMAP(REG),MODYR+1)=(CUMCTGBLD(NG_CENMAP(REG),MODYR+1)* & CTG_PUCAP*0.365)*CTG_BASCGG*CTG_BCLTON*(1000) ENDDO

oQCLGAS(11,CURIYR+1) = 0.0 oQCLGHP(11,CURIYR+1) = 0.0

DO CD=1,MNUMCR

- 2oQCLGAS(CD,CURIYR+1)=SNGCOAL(CD,MODYR+1)*CTG_BASCOL

! TOT COAL CONS. TRILL BTU/YR

oQCLGAS(11,CURIYR+1)=oQCLGAS(11,CURIYR+1 )+oQCLGAS(CD,CURIYR+1) CTGCOAL(CD,MODYR+1)=SNGCOAL(CD,MODYR+1)*oCFNGCL(CURIYR+1) ! CTG COAL CONSUM TRILL BTU/YR

oQCLGHP(CD,CURIYR+1)=oQCLGAS(CD,CURIYR+1)

- CTGCOAL(CD,MODYR+1) ! H&P COAL CONS. TRILL BTU/YR

oQ CLGHP(11,CURIYR+1)=oQCLGHP(11,CURIYR+1)+oQCLGHP(CD,CURIYR+1)

CGN2GR(CD,MODYR+1)=Q_CTGPRDCD(CD,MODYR+1)*CTG_BASCGG*CTG_BCLTON*(10**6) !COGEN TO GRID MWh/YR (NO CO2 CAPTURE)

CGNSELF(CD,MODYR+1)=Q_CTGPRDCD(CD,MODYR+1)*CTG_BASCGS*CTG_BCLTON*(1 0**6) !COGEN FOR SELF MWh/YR (NO CO2 CAPTURE)

!!!VERIFY UNITS!!! GWH/YR

oCGOGSGEN(CD,CURIYR+1,1,1)=CGN2GR(CD,MODYR+1)/1000 !1=COAL; 1=SOLD TO GRID

oCGOGSGEN(CD,CURIYR+1,1,2)=CGNSELF(CD,MODYR+1)/1000 !1=COAL; 2=OWN USE

oCGOGSCAP(CD,CURIYR+1,1)=COGENCAP(CD,MODYR+1) ENDDO

CALL NGCTG_RPT

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

! READ CTG CAPITAL INVESTMENT DATA

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

SUBROUTINE NGREAD_CTGINVEST(NGMISC) IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngtdminc' !common block with CTG variables include 'ngitminc' include 'nghistinc'

CHARACTER*1 CH ! CHAR USED TO END LOOP CHARACTER*1 CHDUM ! DUMMY READ CHAR REAL*4 INFL_RT ! LOCAL INFLATION RATE REAL*4 FEDTAX_RT ! LOCAL FEDTAX RATE REAL*4 STTAX_RT(DNODES) ! LOCAL STATE TAX RATE INTEGER*4 NGMISC ! INPUT FILE UNIT NUMBER INTEGER*4 DUMMYREG ! PLACEHOLDER FOR READ REGION INTEGER*4 IYR ! 4

- DIGIT YEAR INTEGER*4 CD ! CENSUS DIVISION INDEX VARIABLEINTEGER*4 DMDRGN/9/ ! 9 CENSUS DIVISIONS INTEGER*4 RGN,R ! NGTDM REGION INDEX VARIABLE INTEGER*4 CT ! COAL TYPE INDEX VARIABLE INTEGER*4 K,J ! YEAR INDEX VARIABLES INTEGER*4 JENDYR ! LAST YEAR VALUE COR RESPONDS TO IENDYR INTEGER*4 RTOVALUE ! External routine to get options EXTERNAL RTOVALUE

JENDYR = RTOVALUE('IJUMPCAL',2030) ! chg to ftab rpt yr $ using N

- F ! chg to 1987$ using GDP ! READ IN Nelson Farr year$ conversion used for LP, Ref, HP runs

CALL NEXTDATA(NGMISC) READ(NGMISC,*) YR1$4 ! N

- F year$ conversion for LOW PRICE CASE

! READ NELSO N REFINERY COST INDICES

CALL NEXTDATA(NGMISC) CH = 'A' DO WHILE (CH .NE. '#') READ(NGMISC,10) CHDUM, IYR, NRCI_INV(IYR), NRCI_LABOR(IYR), & NRCI_ OPER(IYR) IF (CHDUM .EQ. '#') CH = CHDUM ENDDO

10 FORMAT(A1,6X,I4,3F12.1)

!!! READ FED/ST TAXES. TOOK FROM PMM, ROUGHLY MAPPED INTO NGTDM DEMAND REGIONS !!! NEED TO IMPROVE STATE TAXES FOR NGTDM DEMAND REGIONS !!! CURRENT DATA DID NOT CHANGE ACROSS YEARS. WILL READ ONCE, THEN FILL YR ARRAY

CALL NEXTDATA(NGMISC) DO RGN=1,DNODES READ(NGMISC,*) DUMMYREG,INFL_RT,FEDTAX_RT, &

STTAX_RT(RGN) ENDDO DO IYR=LHISYR,JENDYR !!!VERIFY WHICH YEARS. DO RGN= 1,DNODES STAXRAT(RGN,IYR)=STTAX_RT(RGN) ENDDO INFLRAT(IYR)=INFL_RT FTAXRAT(IYR)=FEDTAX_RT ENDDO

!

-- CAPITAL

- RELATED

CALL NEXTDATA(NGMISC)READ(NGMISC,*) INS_FAC READ(NGMISC,*) TAX_FAC READ(NGMISC,*) MAINT_FAC READ(NGMISC,*) OTH_FAC
INS_FAC = INS_FAC/ 100. TAX_FAC = TAX_FAC/ 100. MAINT_FAC = MAINT_FAC / 100. OTH_FAC = OTH_FAC/ 100.

CALL NEXTDATA(NGMISC) READ(NGMISC,*) BEQ_OPRAVG, BEQ_OPRHRSK READ(NGMISC,*) EMRP_OPRAVG, EMRP_OPRHRSK READ(NGMISC,*) EQUITY_OPRAVG, EQUITY_OPRHRSK READ(NGMISC,*) BEQ_BLDAVG, BEQ_BLDHRSK READ(NGMISC,*) EMRP_BLDAVG , EMRP_BLDHRSK READ(NGMISC,*) EQUITY_BLDAVG, EQUITY_BLDHRSK READ(NGMISC,*) BA_PREM

CALL NEXTDATA(NGMISC) READ(NGMISC,*) (PCLADJ(CD),CD=1,DMDRGN)

CALL NEXTDATA(NGMISC) READ(NGMISC,*) CTG_CAPYR$ ! CTG CAP COS T YEAR $ READ(NGMISC,*) PRJSDECOM ! SALVAGE VALUE READ(NGMISC,*) CTG_BLDYRS ! Construction yrs for CTG READ(NGMISC,*) CTG_PRJLIFE ! Project life yrs for CTG READ(NGMISC,*) CTG_OSBLFAC ! Outside bat tery limit (already in ISBL for CTG) READ(NGMISC,*) CTG_PCTENV ! HomeOffice +Contractor's Fee READ(NGMISC,*) CTG_PCTCNTG ! Contractor's +Owner's Contingency READ(NGMISC,*) CTG_PCTLND ! Land READ(NGMISC,*) CTG_PCTSPECL ! Prepaid Royalties &License +Start_up costs READ(NGMISC,*) CTG_PCTWC ! Working Capital READ(NGMISC,*) CTG_STAFF_LCFAC ! Supervisory & other Staffing (% of Op Labor) READ(NGMISC,*) CTG_OH_LCFAC ! Be nefits & other OH (% of Op Labor + Staffing)
CTG_PCTENV = CTG_PCTENV/ 100. CTG_PCTCNTG= CTG_PCTCNTG/ 100. CTG_PCTLND = CTG_PCTLND/ 100. CTG_PCTSPECL = CTG_PCTSPECL/ 100. CTG_PCTWC = CTG_PCTWC/ 100. CTG_STAFF_LCFAC = CTG_STAFF_LCFAC/ 100. CTG_OH_LCFAC = CTG_OH_LCFAC/ 100. ! CTG control data CALL NEXTDATA(NGMISC) READ(NGMISC,*) CTG_FSTYR ! first year CTG unit builds allowed, 4

- d igit READ(NGMISC,*) CTG_INCBLD !notused ! USE CTG_PUCAP BELOW READ(NGMISC,*) CTG_DCLCAPCST ! decline rate on cap costREAD(NGMISC,*) CTG_DCLOPRCST !notused ! decline rate on

operating cost READ(NGMISC,*) CTG_BAS HHV ! coal HHV (mmBTU/ton) READ(NGMISC,*) CTG_BASCOL ! BASE COAL CONSUMPTION (MBTU/SCF CTG) READ(NGMISC,*) CTG_BCLTON ! BASE COAL CONSUMPTION (TON/MSCF) READ(NGMISC,*) CTG_BASSIZ ! base CTG size (MM scf d) READ(NGMISC,*) CTG_BASCGS ! base CTG cogen to self (MWH/TON) READ(NGMISC,*) CTG_BASCGSCO2 ! base CTG cogen to self (MWH/TON)WITH CO2 CAPTURE READ(NGMISC,*) CTG_BASCGG ! base CTG cogen to grid (MWH/TON)
REA D(NGMISC,*) CTG_BASCGGCO2 ! base CTG cogen to grid (MWH/TON)WITH CO2 CAPTURE

CALL NEXTDATA(NGMISC) READ(NGMISC,*) CTG_NCL ! Number of coal types (1 per region) DO CT=1,CTG_NCL ! num coal types for CTG (ie no. ngtdm regions?)

READ(NGMISC,*) CTG_NAM(CT), & ! name of coal type (use DNODES???) CTG_CO2, & ! CTG co2 emis fac CTG_INVLOC(CT),& ! CTG location factor, padd 2 basis LABORLOC(CT) ! LABOR FACTOR

DO IYR=LHISYR,JENDYR ! CTG_CO2FAC(CT,IYR) = CTG_CO2 ! CTG co2 emis fac CTG_CGTFAC(CT,IYR) = CGFAC ! MW/ MM scfd, CG cap total CTG _CGGFAC(CT,IYR) = CGFAC * CGGD ! MW/ MM scfd, cogen to grid ENDDO ENDDO

CALL NEXTDATA(NGMISC) READ(NGMISC,*) CTG_PUCAP,& ! read CTG PUCAP (MM scfd)

XBM_ISBL,& XBM_LABOR C TG_PLNBLD = 0.0 ! initialize planned CTG blds (cap)

!!!NEED TO UPDATE ANY PLANNED CTG BUILD INFORMATION!!!

CH = '+' CALL NEXTDATA(NGMISC) DO WHILE (CH .NE. '#') READ(NGMISC,*) R,K,CTG_BLDX !CHANGE THIS VARIABLE!!! IF (K.EQ.0) THEN CH = '#' ELSE CTG_PLNBLD(R,K) = CTG_BLDX * CTG_PUCAP ! convert to MMcfDO J=K,JENDYR ! fill in values to

end of forecast

CTG_PLNBLD(R,J) = CTG_PLNBLD(R,K) ENDDO ENDIF ENDDO

CALL NEXTDATA(NGMISC) READ(NGMISC,*)CTG_BLDX READ(NGMISC,*)CTG_IINDX READ(NGMISC,*)CTG_SINVST

RETURN ! END ! END NGREAD_CTGINVEST

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

! CALC ANNUALIZED CAPITAL COSTS, OPERATING COSTS, OVC

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

SUBROUTINE NGCTG_INVEST(REG) ! BEGIN NGCTG_INVEST SUB IMPLICIT NONE ! ! include 'parametr' include 'ncntrl' include 'ngparinc' include 'ogglobal' include 'ngtdminc' !common block with CTG variables

INTEGER*4 REG ! NGTDM REGION INDEX VARIABLE INTEGER*4 YR ! YR INDEX VARIABLE REAL*4 SUM ! LOCAL SUM REAL*4 CTG_CAPUTZ ! CTG CAP * 90% UTZ REAL*4 CGNOVR(DNODES) ! cogen transmission factor

! INITIALIZE VARIABLES

BM_ISBL = 0.0 BM_LABOR = 0.0 FEDST_TAX = 0.0 CTG_RECRAT = 0.0 CTG_CAPUTZ = CTG_PUCAP*0.90

YR2$4 = 2007 !!!CHANGE TO FTAB RTP YR$ VARIABLE!!! NFINV =NRCI_INV(YR2$4) / NRCI_INV(CTG_CAPYR$) ! CHNG TO ftab rpt yr NFLABOR=NRCI_LABOR(YR2$4)/ NRCI_LABOR(1987) ! labor given in 87$

BM_ISBL = XBM_ISBL * NFINV ! CHNG TO rpt yr MM $ BM_ISBL = BM_ISBL * & ! CHNG TO 87$ / cdoMC_PCWGDP(1987

- IBASYR+1)/ oMC_PCWGDP(YR2$4

- IBASYR+1)

BM_LABOR = XBM_LABOR * NFLABOR ! CHNG TO rpt yr $ BM_LABOR = BM_LABOR * & ! CHNG TO 87$ / cd oMC_PCWGDP(1987

- IBASYR+1)/ oMC_PCWGDP(YR2$4

- IBASYR+1)

! SET REQUIRED RECOVERY RATE BASED ON BUILD OR OPERATING DECISION

F EDST_TAX = FTAXRAT(MODYR) + STAXRAT(REG,MODYR)

- &

(FTAXRAT(MODYR) * STAXRAT(REG,MODYR)) ! Fed & State Income Tax Rate
! CTG_RECRAT: Cost of Capital (after taxes)
CTGCOE(MODYR) = oMC_RMGFCM_10NS(CURIYR)/100. + (BEQ_BLDAVG * EMRP_BLDAVG) + oEXTRARISK(MODYR) CTGCOD(MODYR) = ((oMC_RMCORPBAA(CURIYR)/100. + BA_PREM)*(1.

- FEDST_TAX)) + oEXTRARISK(MODYR) CTG_RECRAT = CTGCOD(MODYR) *(1.

- EQUITY_BLDAVG) +CTGCOE(MODYR)*EQUITY_BLDAVG

! SET CAPITAL RECOVERY (CAPREC) COSTS
CTG_ISBL(REG) = CTG_INVLOC(REG) *BM_ISBL / 1000. ! ISBL (MM 87$) CTG_LABOR(REG) = LABORLOC(REG) *BM_LABOR ! Oper labor (87$/cd)

! TOTAL FIELD COSTS (ISBL + OSBL)

CTG_TFCST(REG) = (1. + CTG_OSBLFAC) *CTG_ISBL(REG) ! (MM 87$)

! ONE

- TIME COSTS
LAND(REG) = CTG_PCTLND * CTG_TFCST(REG) ! land (MM 87$) WRKCAP(REG) = CTG_PCTWC * CTG _TFCST(REG) ! WorkCap (MM 87$) OTCFAC = CTG_PCTENV + CTG_PCTCNTG + CTG_PCTLND + & ! ContrFee,Contg,Land,Royalties,Wcap

CTG_PCTSPECL + CTG_PCTWC CTG_OTC(REG) = OTCFAC * CTG_TFCST(REG) ! (MM 87$)

! TOTAL PROJECT INVESTMENT (TOT FIELD COST + ONE TIME COST)

CTG_TPI(REG) = CTG_TFCST(REG) + CTG_OTC(REG) ! (MM 87$) CTG_PRJINV(REG) = CTG_TPI(REG)*1000. /CTG_CAPUTZ ! (87$/ MCF)! FIXED CAPITAL INVESTMENT

CTG_FCI(REG) = CTG_TPI(REG)

- WRKCAP(REG) ! (MM 87$) CTG_CAPINV(REG) = CTG_FCI(REG)*1000. /CTG_CAPUTZ ! (87$/MCF)

! TOTAL DEPRECIABLE INVESTMENT (assumed approx = Fixed Capital Investment)
CTG_TDI(REG) = CTG_FCI(REG) ! (MM 87$)

SUM = 0.0 DO YR=1,CTG_BLDYRS SUM = SUM +(1.+CTG_RECRAT)**YR ENDDO FV_CONSTR = SUM /CTG_BLDYRS ! FV over build years PV_PRJ = 1. /((1.+CTG_RECRAT)**CTG_PRJLIFE) ! PV of prj fr end of life (salvage/decom) LC_LIFE =(CTG_RECRAT *((1.+CTG_RECRAT)**CTG_PRJLIFE)) / & ! Levelized cost (((1.+CTG_RECRAT)**CTG_PRJLIFE)

- 1.) ! Capital Recovery

FVI_CONSTR = (1.+CTG_RECRAT)**CTG_BLDYRS ! FV for instantaneous payment TPI_START(REG) = FVI_CONSTR *LAND(REG) + & ! MM 87$, TPI for startup yr FV_CONSTR *(CTG_FCI(REG)

- LAND(REG)) + & ! (note: LAND=0 in data) WRKCAP(REG) RCI_START(REG) = PV_PRJ *(LAND(REG) +WRKCAP(REG) + &

PRJSDECOM) ! MM 87$,recoverable invest at startup PVI_START(REG) = TPI_START(REG)

- RCI_START(REG) ! MM 87$, PV for proj investment ACAPRCV(REG) = LC_LIFE *PVI_START(REG) ! MM 87$, Annual Cap Recovery ! Below: Pv,srl *Av = 1/PRJLIFE ! assuming tax life =asset life ADEPREC(REG) = CTG_TDI(REG) /CTG_PR JLIFE ! MM 87$, Annual Levelized depreciation (SRL method) ADEPTAXC(REG) = ADEPREC(REG) *FEDST_TAX ! MM 87$, Levelized depreciation tax credit, after tax ! MM 87$, CFC (after tax credit taken) ACAPCHRGAT(REG) = ACAPRCV(REG)

- ADEPTAXC(REG) ! MM 87$, Annual cap charge, after tax credit DCAPCHRGAT(REG) = ACAPCHRGAT(REG) *1000000. /365. ! 87$/cd, Daily cap charge, after tax credit! CAPITAL RECOVERY COSTS, AFTER TAXES (CAPREC)
CAPREC(REG) = DCAPCHRGAT(REG) /(1000.*CTG_CAPUTZ) ! 87$/MCF

! SET TOTAL FIXED OPERATING COSTS (FXOC) ! Capital

- related FXOC 87$/cd (convt fr MM 87$/yr)
FXOC_INS(REG) = CTG_FCI(REG) * INS_FAC * 1000000./365. ! Insurance FXOC_TAX(REG) = CTG_FCI(REG) * TAX_FAC * 1000000./365. ! Local Tax FXOC_MAINT(REG) = CTG_FCI(REG) * MAINT_FAC * 1000000./365. ! Maintenance FXOC_OTH(REG) = CTG_FCI(REG) * OTH_FAC * 1000000./365. ! Supplies, OH, Env FXOC_CAP(REG) = FXOC_INS(REG) + FXOC_TAX(REG) + FXOC_MAINT(REG) + FXOC_OTH(REG)

! Labor

- related FXOC 87$/cd (already converted)

FXOC_STAFF(REG) = CTG_LABOR(REG) * CTG_STAFF_LCFAC ! Supervisory & Staff FXOC_OH(REG) =(CTG_LABOR(REG) + FXOC_STAFF(REG)) * CTG_OH_LCFAC ! Benefits & OH FXOC_LABOR(R EG) = CTG_LABOR(REG) + FXOC_STAFF(REG) + FXOC_OH(REG)

! FXOC total:
FXOC(REG) = (FXOC_CAP(REG) + FXOC_LABOR(REG)) /(1000.*CTG_CAPUTZ) ! 87$/cd per MCF CTG_INVCST(REG)=FXOC(REG)+CAPREC(REG) ! UNADJUSTED CTG INVEST MENT COST 87$/MCF

!CALC CREDIT FOR SELLING COGEN TO GRID AND TRANSPORT COST

CGNCRED(REG)=CTG_BASCGG*CTG_BCLTON*EWSPRCNCD(REG,MODYR) ! 87$/MCF CGNOVR(REG)=NGCTGOVR(REG)*NGCTGFCF(REG)*CTG_CAPUTZ/365 CGNTRNS(REG)=CTG_BASCGG*CTG_BCLTON*CGNOVR(REG) ! 87$/MCF CTG_FCST(REG)=CTG_INVCST(REG)

- CGNCRED(REG)+CGNTRNS(REG) ! final ctg cost 87$/mcf

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

! DETERMINE MIN/MAX BUILD LIMITS FOR CTG

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =SUBROUTINE NGCTG_BLDLIM(EYR) IMPLICIT NONE

include 'parametr' include 'ncntrl ' include 'ngparinc' include 'ogglobal' include 'ngtdminc' ! common block with CTG variables

INTEGER*4 EYR ! num yrs economic to bld CTG

REAL*4 KFAC ! Mansfield

- Blackman model REAL*4 PHI ! Mansfield

- Blackman model REAL*4 SHRBLD ! Mansfield

- Blackman model

IF (NCTGBLT(MODYR+1).LE.CTG_BLDX) THEN KFAC =

- ALOG( (CTG_BLDX/NCTGBLT(MODYR+1))

- 1.0) ! ratio of # allowed/#blt

PHI =

- .3165 + (0.23221*CTG_IINDX) + &

(0.533*CTG_PINDX)

- (0.027*CTG_SINVST) SHRBLD = 1./ (1.+ EXP(

- KFAC

- (EYR*PHI))) IF((oPNGIN(11,CURIY R)/oPDSIN(11,CURIYR)).LT.1.00)THEN CTGBND = CTG_BLDX * SHRBLD * (oPNGIN(11,CURIYR)/oPDSIN(11,CURIYR))**(1.2)

ELSE CTGBND = CTG_BLDX * SHRBLD ENDIF ELSE CTGBND = 0.0 ENDIF

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

! SET MIN AND MAX BUILD ALLOWED FOR TOTAL CTG

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

SUBROUTINE NGCHGCTG_BLDLIM IMPLI CIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngtdminc'

INTEGER*4 REG,RGN,R ! REGION INDEX VARIABLES INTEGER*4 EYR ! num yrs economic to bld CTG INTEGER*4 CNT ! COUNT OF NUM RGNS PROF TO BUILDREAL*4 NCTGBLT_ 0 ! base num of economic CTG

units, M

- B REAL*4 NCTGBLT_PREV ! track # CTG units blt, M

- B REAL*4 CTG_TPLNBLD ! total CTG plan'd blds REAL*4 PCLNAT ! N ATIONAL CTG PRICE REAL*4 PNGNAT ! NATIONAL NG PRICE REAL*4 PROFIT(DNODES) ! CTG PROFIT REAL*4 SUM ! SUM OF PROFIT REAL*4 CUT ! CUTOFF FOR BUILDS REAL*4 ROUND ! FUNCTION TO ROUND OFF

LOGICAL FIRST/.TRUE./

PROFIT=0.0 NORMPROF=0.0 SUM=0.0 CNT=0.0

IF (FIRST) THEN NCTGBLT(MODYR) = 1 ! initialize to 1 NCTGBLT_0 = 1 ! keep original base build for backup

NCTGBLT_PREV = NCTGBLT(MODYR) ! initially set existing to original base build

FIRST=.FALSE. ENDIF

DO RGN=1,DNODES PROFIT(RGN)=NG_AVG_PRICE(RGN)

- CTG_PRICE(RGN) ENDDO
IF(MODYR.GE.CTG_FSTYR)THEN ! BUILD CTGs DO R=1,DNODES IF(PROFIT(R).GT.0.00001)THEN CNT=CNT+1 SUM=SUM+PROFIT(R) NORMPROF(R)=PROFIT(R) ENDIF ENDDO

IF(SUM.EQ.0.00)SUM = 1.00 IF(CNT.EQ.0)CNT = 1

DO R=1,DNODES NORMPROF(R)=NORMPROF(R)/SUM ENDDO

SUM=0.0 DO R=1,DNODES SUM=SUM+NORMPROF(R) ENDDOCUT=SUM/(CNT+1) IF (CNT.GT.1.00) THEN DO R=1,DNODES IF (NORMPROF(R).LE.CUT) NORMPROF(R)=0.0 ENDDO ENDIF

SUM=0.0 CNT=0

DO R=1,DNODES NORMPROF(R)=ROUND(NORMPROF(R)) SUM=SUM+NORMPROF(R) ENDDO

DO R=1,DNODES IF (NORMPROF(R).NE.0.00) CNT=CNT+1 IF (SUM.NE.1.00 .AND. CNT.NE.0) NORMPROF(R)=1/CNT ENDDO

PCLNAT = 0.0 PNGNAT = 0.0

DO R=1, DNODES PCLNAT = PCLNAT + CTG_PRICE(R)* NORMPROF(R) PNGNAT = PNGNAT + NG_AVG_PRICE(R)* NORMPROF(R) ENDDO

IF (PCLNAT.GT.0.00001) THEN CTG_PINDX = PNGNAT / PCLNAT ELSE CTG_PINDX=0.00 ENDIF

EYR = 1 ! assumes NCTLBLT reset every year

NCTGBLT(MODYR+1) = NCTGBLT_PREV CALL NGCTG_BLDLIM(EYR) CTG_BUILD = CTGBND

- (NCTGBLT(MODYR+1)

- 1) IF (CTG_BUILD.LE.0.00001) CTG_BUILD=0.00 NCTGBLT_PREV= NCTGBLT(MODYR+1)+CTG_BUILD ELSE CTGBND = 0.0 ! UP PER BOUND CTG_BUILD = 0.0 ! NO. BUILT MODYR ENDIF
NCTGBLT(MODYR+1) = NCTGBLT_PREV

DO R=1,DNODES CUMCTGBLD(R,MODYR+1)=CUMCTGBLD(R,MODYR)+CTG_BUI LD*NORMPROF(R) ENDDO

RETURN END! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

! ADJUST CTG CAPITAL COSTS TO ACCOUNT FOR LEARNING AND RESOURCE DEPLETION

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

SUBROUTINE NGCTG_ADJCST(REG) IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngtdminc' ! common block with CTG variables

INTEGER*4 REG ! NGTDM REGION INDEX VARIABLE INTEGER*4 CTG_BASYR ! FIRST YR CTG BUILDS REAL*4 CTG_INVBAS(DNODES) ! base CTG in vestment before adjustment REAL*4 CTG_CSTADD(DNODES) ! 87$/mcf, CTG cost adder if prodc >500 mcf/cd REAL*4 CTGPRODC(DNODES) ! CTG production (MCF/cd)

LOGICAL ONCE/.TRUE./

CTG_INVBAS(REG) = CTG_FCST(REG)

IF(Q_CTGPRD(REG,MODYR

- 1).GT.0.000001)THEN CTG_BASYR=MODYR

- 1

CTG_INVADJ(REG) = CTG_INVBAS(REG) * (1.

- CTG_DCLCAPCST)**(MODYR

CTG_BASYR)

! CTG_CSTADD expected = 0 for L P,ref

CTGPRODC(REG) = Q_CTGPRD(REG,MODYR

- 1)*(10**6)/365 ! CONVERT BCF/YR TO MCF/DAY

!IF PRODUCTION EXCEEDS 1127308 MCF/DAY !COST ADDER TO ACCOUNT FOR RESOURCE DEPLETION (WATER COMPETITION)

CTG_CSTADD(REG) = 15*TANH(0.4*(AMAX1(0.,(CTGPRODC(REG) /1127308)

- 1.))) ! fr A.Kydes 10

- 16

- 07

CTG_INVADJ(REG) = CTG_INVADJ(REG) + CTG_CSTADD(REG) ELSE CTG_INVADJ(REG)= CTG_FCST(REG) ENDIF

RETURN END! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

! Map NERC region data for TRCTLOVR, TRCTLFCF ! into NGTDM DENODES variables NGCTGOVR, NGCTGFCF (hardcoded) ! and EWSPRCN into EWSPRCNCD (wholesale m kt price) ! (only representative NERC regions used, not 5

- 9)

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

SUBROUTINE NG_EMM2CTG IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ogglobal' include 'ngtdminc'

INTEGER*4 Y4,Y2 ! 4DIGIT, 2DIGIT YEAR INDEX VARIABLES INTEGER*4 REG ! NGTDM REGION INDEX VARIABLES INTEGER*4 I ! GENERIC INDEX INTEGER*4 ICNT ! COUNTER INTEGER*4 MAPNG_NERC(3,DNODES ) ! MAPPING BETWEEN NGTDM AND NERC REGIONS INTEGER*4 JENDYR ! LAST YEAR VALUE CORRES PONDS TO IENDYR INTEGER*4 RTOVALUE ! External routine to get options EXTERNAL RTOVALUE ! 1 2 3 4 5 6 7 8 9 10 11 12 DATA ((MAPNG_NERC(I,REG),REG=1,DNOD ES),I=1,3) /7, 3, 1, 5, 1, 1, 2, 11, 11, 8, 12, 13, & 0, 6, 4, 10, 3, 9, 10, 12, 0, 0, 0, 0, & 0, 0, 0, 0, 9, 0, 0, 0, 0, 0, 0, 0/

JENDYR = RTOVALUE('IJUMPCAL',2030)

NGCTGOVR = 0.0 NGCTGFCF = 0.0 EWSPRCNCD(1:DNODES,MODYR) = 0.0

DO REG=1,DNODES ICNT = 0 DO I=1,3 IF (MAPNG_NERC(I,REG).NE.0) THEN NGCTGOVR(REG) = NGCTGOVR(REG) + oTRCTLOVR(MAPNG_NERC(I,REG)) NGCTGFCF(REG) = NGCTGFCF(REG) + oTRCTLFCF(MAPNG_NERC(I,REG)) DO Y4=LHISYR,JENDYR Y2 = Y4

- IBASYR+1 EWSPRCNCD(REG,Y4) = E WSPRCNCD(REG,Y4) + oEWSPRCN(MAPNG_NERC(I,REG),Y2)ENDDO ICNT = ICNT+1 ENDIF ENDDO NGCTGOVR(REG) = NGCTGOVR(REG) / ICNT NGCTGFCF(REG) = NGCTGFCF(REG) / ICNT DO Y4=LHISYR,JENDYR Y2 = Y4

- IBASYR+1 EWSPRCNCD(REG,Y4) = EWSPRCNCD(REG,Y4) / ICNT ENDDO ENDDO

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

! MAP CDS TO NGTDM REGIONS FOR PCLGAS, REMEMBER TO CHANGE PCLEL TO PCLGAS

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

SUBROUTINE NGCD2NG IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ogglobal' include 'ngtdminc'

INTEGER*4 YR4,YR2 ! 4DIGIT, 2DIGIT YEAR INDEX VARIABLES INTEGER*4 RG,D ! NGTDM,CD REGION INDEX VARIABLE

INTEGER*4 JENDYR ! LAST YEAR VALUE CORRESPONDS TO IENDYR INTEGER*4 RTOVALUE ! External routine to get options EXTERNAL RTOVALUE

JENDYR = RTOVALUE('IJUMPCAL',2030)

DO D=1,MNUMCR

- 2 oPCLGAS(D,CURIYR)=oPCLEL(D,CURIYR)

- PCLADJ(D) ENDDO

DO YR 4 = LHISYR,JENDYR YR2 = YR4

- IBASYR+1 DO RG=1,DNODES PCLGASNG(RG,YR4)=oPCLGAS(NG_CENMAP(RG),YR2) ENDDO ENDDORETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

! NGCTG_RPT SUBROUTINE TO WRITE CTG INVESTMENT REPORT

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

SUBROUTINE NGCTG_RPT ! BEGIN NGCTG_RPT SUB IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngitminc' include 'ogglobal' include 'ngtdminc' !common block with CTG variables

INTEGER*4 R,CD ! REGION INDEX VARIABLE INTEGER*4 JEND INTEGER*4 JEN DYR ! LAST YEAR VALUE CORRESPONDS TO IENDYR INTEGER*4 RTOVALUE ! External routine to get options EXTERNAL RTOVALUE

LOGICAL FIRSTWRITE/.TRUE./ ! LOGICAL TO WRITE RPT HEADER ONLY ONCE

JENDYR = RT OVALUE('IJUMPCAL',2030)

!!! IF(FIRSTWRITE)THEN WRITE(NGUNIT,211)(R,R=1,DNODES) FIRSTWRITE=.FALSE. !!! ENDIF

WRITE(NGUNIT,201) MODYR,(CTG_INVCST(R),R=1,DNODES) !!! WRITE(NGUNIT,202) MODYR,(FXOC(R),R=1,DNODES) !!! WRITE(NGUNIT,203) MODYR,(FXOC_CAP(R),R=1,DNODES) !!! WRITE(NGUNIT,204) MODYR,(FXOC_LABOR(R),R=1,DNODES) !!! WRITE(NGUNIT,205) MODYR,(CAPREC(R),R=1,DNODES) !!! WRITE(NGUNIT,206) MODYR,(WRKCAP(R),R=1,DNODES) WRITE(NGUNIT,224) MODYR,(CGNCRED(R),R=1,DNODES) WRITE(NGUNIT,225) MODYR,(CGNTRNS(R),R=1,DNODES) WRITE(NGUNIT,207) MODYR,(CTG_FCST(R),R=1,DNODES) WRITE(NGUNIT,208) MODYR,(CTG_INVADJ(R),R=1,DNODES) WRITE(NGUNIT,217) MODYR,(NODE_ ENDPR(1,R),R=1,DNODES) WRITE(NGUNIT,218) MODYR,(NODE_ENDPR(2,R),R=1,DNODES) WRITE(NGUNIT,210) MODYR,(NG_AVG_PRICE(R),R=1,DNODES) WRITE(NGUNIT,221) MODYR,oJCLIN(CURIYR) WRITE(NGUNIT,220) MODYR,(PCLGASNG(R,MODYR),R=1,DNODES) WRI TE(NGUNIT,209) MODYR,(CTG_PRICE(R),R=1,DNODES) WRITE(NGUNIT,212) MODYR,(Q_CTGPRD(R,MODYR),R=1,DNODES)WRITE(NGUNIT,213) MODYR,CTGBND WRITE(NGUNIT,219) MODYR,CTG_BUILD WRITE(NGUNIT,214) MODYR,(CUMCTGBLD(R,MODYR),R=1,DNODES) WRITE(NGUNIT,215) MODYR,NCTGBLT(MODYR)

- 1 WRITE(NGUNIT,216) MODYR,(oQCLGAS(CD,CURIYR),CD=1,MNUMCR) WRITE(NGUNIT,222) MODYR,(oQCLGHP(CD,CURIYR),CD=1,MNUMCR) WRITE(NGUNIT,223) MODYR,oCFNGCL(CURIYR) WRITE(NGUNIT,226) MODYR,(NORMPR OF(R),R=1,DNODES)

201 FORMAT('UNADJ CTG INVEST ',I4,1X,<DNODES>F10.4) 202 FORMAT('FIXED OPER COST ',I4,1X,<DNODES>F10.4) 203 FORMAT('FIXED OP COST CAP ',I4,1X,<DNODES>F10.4) 204 FORMAT('FIXED OP COST LAB ',I4,1X,<DNODES>F10.4) 205 FORMAT( 'CAPITAL RECOVERY ',I4,1X,<DNODES>F10.4) 206 FORMAT('WORKING CAPITAL ',I4,1X,<DNODES>F10.4) 207 FORMAT('FINAL INV COST ',I4,1X,<DNODES>F10.4) 208 FORMAT('ADJUST CTG INVEST ',I4,1X,<DNODES>F10.4) 209 FORMAT('CTG PRICE W/ COAL ',I4,1X,<DNO DES>F10.4) 210 FORMAT('NG AVG PRICE ',I4,1X,<DNODES>F10.4) 211 FORMAT('REGION 87$/MCF ',5X,12I10) 212 FORMAT('CTG Q PROD BCF/YR ',I4,1X,<DNODES>F10.4) 213 FORMAT('BOUND ',I4,1X,<DNODES>F10.4) 214 FORMAT('CUM NO.REG PLANTS ',I4,1X,<DNODES>F10.4) 215 FORMAT('CUM NO.NAT PLANTS ',I4,1X,F10.4) 216 FORMAT('COAL CONS. QCLGAS ',I4,1X,<MNUMCR>F10.4) 222 FORMAT('COAL CONS. QCLGHP ',I4,1X,<MNUMCR>F10.4) 217 FORMAT('NG PEAK PRICE ',I4,1X ,<DNODES>F10.4) 218 FORMAT('NG OFF PEAK PRICE ',I4,1X,<DNODES>F10.4) 219 FORMAT('Build ',I4,1X,F10.4) 220 FORMAT('COAL PRICE (unad) ',I4,1X,<DNODES>F10.4) 221 FORMAT('JCLIN ',I4,1X,F10.4) 223 FORMAT('CFNGCL ',I4,1X,F10.4) 224 FORMAT('COGEN CREDIT ',I4,1X,<DNODES>F10.4) 225 FORMAT('COGEN TRANSMIT CST ',I4,1X,<DNODES>F10.4) 226 FORMAT('NORM PROFIT SPLIT ',I4,1X,<DNODES>F10.4)

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

! FUNCTION TO ROUND TO THE NEAREST EVEN NUMBER IN HUNDREDTHS PLACE

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

REAL FUNCTION ROUND(DIGITS) IMPLICIT NONE

include 'parametr' include 'ncntrl' include 'ngparinc' include 'ngtdminc'

INTEGER*4 ROUNDNUMREAL*4 DIGITS ! NUMBER TO BE ROUNDED OFF REAL*4 NEW_DIGITS

ROUNDNUM = DIGITS * 100 IF(MOD(ROUNDNUM,2).EQ.0)THEN NEW_DIGITS = DIGITS ELSE NEW_DIGITS = DIGITS + 0.01 ENDIF
NEW_DIGITS = INT(NEW_DIGITS*100) ROUND = NEW_DIGITS/100

RETURN E ND

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

! ROUTINE TO TRANSFER NEMS GLOBAL VARIABLES TO LOCAL ! VARIABLES FOR USE IN NGTDM (DONE TO FACILITATE RUNNING W/NRCAN)

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

SUBROUTINE NGGLB_INTRANS IMPLICIT NONE include 'parametr' include 'ncntrl' include 'cdsparms' include 'emmparm' include 'coalout' include 'convfact' include 'emablk' include 'emission' inclu de 'intout' include 'macout' include 'mpblk' include 'pmmout' include 'qblk' include 'uefdout' include 'ngrpt' include 'ngtdmout' include 'ngtdmrep' include 'ogsmout' include 'resdrep' inclu de 'udatout' include 'cogen' include 'mxpblk' include 'ogglobal' include 'efpout' include 'uecpout' include 'commrep'

INTEGER*4 I,JoAKGTL_NGCNS(1:IJUMPYR) = AKGTL_NGCNS(1:IJUMPYR) oCAP_CEN(:,:,1:IJUMPYR) = CAP_CEN(:,:,1:IJUMPYR) oCAP_CEX(:,:,1:IJUMPYR) = CAP_CEX(:,:,1:IJUMPYR) oCAP_NEN(:,:,1:IJUMPYR) = CAP_NEN(:,:,1:IJUMPYR) oCAP_NEX(:,:,1:IJUMPYR) = CAP_NEX(:,:,1:IJUMPYR) oCFNGC(1:IJUMP YR) = CFNGC(1:IJUMPYR) oCFNGN(1:IJUMPYR) = CFNGN(1:IJUMPYR) oCFNGU(1:IJUMPYR) = CFNGU(1:IJUMPYR) oCLSYNGQN(:,1:IJUMPYR) = CLSYNGQN(:,1:IJUMPYR) oEI2NGA(:,1:IJUMPYR) = EI2NGA(:,1:IJUMPYR) oEQGCELGR(:,1:IJUMPYR) = EQGCELGR(:,1:IJUMPYR) oEQGFELGR(:,1:IJUMPYR) = EQGFELGR(:,1:IJUMPYR) oEQGIELGR(:,1:IJUMPYR) = EQGIELGR(:,1:IJUMPYR) oIT_WOP(1:IJUMPYR,:) = IT_WOP(1:IJUMPYR,:) oXIT_WOP = XIT_WOP oJMGTR(1:IJUMPYR) = JMGTR(1:IJUMPYR) oJNGTR(1:IJUMPYR) = JNGTR(1:IJUMPYR) oMC_CPI(:,1:IJUMPYR) = MC_CPI(:,1:IJUMPYR) oMC_ECIWSP(1:IJUMPYR) = MC_JECIWSP(1:IJUMPYR) oMC_PCWGDP(

- 2:I JUMPYR) = MC_JPGDP(

- 2:IJUMPYR) oMC_REALRMGBLUS(1:IJUMPYR) = MC_RMGBLUSREAL(1:IJUMPYR) oMC_RMPUAANS(1:IJUMPYR) = MC_RMCORPPUAA(1:IJUMPYR) oMC_WPI(1:IJUMPYR) = MC_WPI(1:IJUMPYR) oMC_WPI055(1:IJUMPYR) = MC_WPI0 55(1:IJUMPYR) oMC_RMGFCM_10NS(1:IJUMPYR) = MC_RMTCM10Y(1:IJUMPYR) oMC_RMCORPBAA(1:IJUMPYR) = MC_RMCORPBAA(1:IJUMPYR) oMC_COMMFLSP(:,1:12,1:IJUMPYR) = CMTotalFlspc(:,1:12,1:IJUMPYR) * 1000. oNGARCMP = NGARCMP oNGCAPS(:,:,1:IJUMPYR) = NGCAPS(:,:,1:IJUMPYR) oNGFLOWS(:,:,1:IJUMPYR) = NGFLOWS(:,:,1:IJUMPYR) oNGPIPCAP(:,1:IJUMPYR) = NGPIPCAP(:,1:IJUMPYR) oNGSTRCAP(:,1:IJUMPYR) = NGSTRCAP(:,1:IJUMPYR) oOGCCAPPRD(:,1:I JUMPYR) = OGCCAPPRD(:,1:IJUMPYR) oOGCNPPRD(:,1:IJUMPYR) = OGCNPPRD(:,1:IJUMPYR) oOGCNQPRD(:,1:IJUMPYR) = OGCNQPRD(:,1:IJUMPYR) oOGGROWFAC(1:IJUMPYR) = OGGROWFAC(1:IJUMPYR) oOGPNGEXP(:,1:IJUMPYR) = OGPNGEXP(: ,1:IJUMPYR) oOGPNGIMP(:,1:IJUMPYR) = OGPNGIMP(:,1:IJUMPYR) oOGPRCEXP(1:IJUMPYR) = OGPRCEXP(1:IJUMPYR) oOGPRDADOF(:,1:IJUMPYR) = OGPRDADOF(:,1:IJUMPYR) oOGPRDADON(:,1:IJUMPYR) = OGPRDADON(:,1:IJUMPYR) oOGPRDNG(:,1:IJUMPYR) = OGPRDNG(:,1:IJUMPYR) oOGPRDNGOF(:,1:IJUMPYR) = OGPRDNGOF(:,1:IJUMPYR) oOGPRDNGON(:,1:IJUMPYR) = OGPRDNGON(:,1:IJUMPYR) oOGPRRCAN(:,1:IJUMPYR) = OGPRRCAN(:,1:IJUMPYR) ! oOGPRRNG89 = OGPRRNG89 oOGPRRNGOF(:,1:IJUMPYR) = OGPRRNGOF(:,1:IJUMPYR) oOGPRRNGON(:,1:IJUMPYR) = OGPRRNGON(:,1:IJUMPYR) oOGPRSUP(1:IJUMPYR) = OGPRSUP(1:IJUMPYR) oOGSUPGAS(:,:,1:IJUMPYR) = OGSUPGAS(:,:,1:IJUMPYR) oOGNGRSV(:,1:IJUMPYR) = OGNGRSV(:,1:IJUMPYR) oOGQNGREP(:,1:IJUMPYR) = OGQNGREP(:,1:IJUMPYR)oEXSPEND(:,1:IJUMPYR) = EXSPEND(:,1:IJUMPYR)

! oOGPR_BNG = OGPR_BNG ! oOGPR_CAR(

- 1:IJUMPYR) = OGPR_CAR(

- 1:IJUMPYR) ! oOGPR_CNG = OGPR_CNG ! oOGPR_HNG = OGPR_HNG ! oOGPR_RNG = OGPR_RNG oOGPRCOAK(:,1:IJUMPYR) = OGPRCOAK(:,1:IJUMPYR) oOGQANGTS(1:IJUMPYR) = OGQANG TS(1:IJUMPYR) oOGQNGEXP(:,1:IJUMPYR) = OGQNGEXP(:,1:IJUMPYR) oOGQNGIMP(:,1:IJUMPYR) = OGQNGIMP(:,1:IJUMPYR) oOGRESCAN(:,1:IJUMPYR) = OGRESCAN(:,1:IJUMPYR) oOGRESNGOF(:,1:IJUMPYR) = OGRESNGOF(:,1:IJUMPYR) oOG RESNGON(:,1:IJUMPYR) = OGRESNGON(:,1:IJUMPYR) oOGTAXPREM(:,1:IJUMPYR) = OGTAXPREM(:,1:IJUMPYR) ! oOGWPNG89 = OGWPNG89 oOGHHPRNG(1:IJUMPYR) = OGHHPRNG(1:IJUMPYR) oOGWPRNG(:,1:IJUMPYR) = OGWPRNG(:, 1:IJUMPYR) oXOGWPRNG = XOGWPRNG oOGWPTDM(:,1:IJUMPYR) = OGWPTDM(:,1:IJUMPYR) oPBAJA(1:IJUMPYR) = PBAJA(1:IJUMPYR) oQBAJA(1:IJUMPYR) = QBAJA(1:IJUMPYR) oPGCELGR(:,1:IJUMPYR) = P GCELGR(:,1:IJUMPYR) oPGFCM(:,1:IJUMPYR) = PGFCM(:,1:IJUMPYR) oPGFEL(:,1:IJUMPYR) = PGFEL(:,1:IJUMPYR) oPGFELGR(:,1:IJUMPYR) = PGFELGR(:,1:IJUMPYR) oPGFIN(:,1:IJUMPYR) = PGFIN(:,1:IJUMPYR) oPGFRS(: ,1:IJUMPYR) = PGFRS(:,1:IJUMPYR) oPGFTR(:,1:IJUMPYR) = PGFTR(:,1:IJUMPYR) oPGFTRFV(:,1:IJUMPYR) = PGFTRFV(:,1:IJUMPYR) oPGFTRPV(:,1:IJUMPYR) = PGFTRPV(:,1:IJUMPYR) oPGICM(:,1:IJUMPYR) = PGICM(:,1: IJUMPYR) oPGIEL(:,1:IJUMPYR) = PGIEL(:,1:IJUMPYR) oPGIELGR(:,1:IJUMPYR) = PGIELGR(:,1:IJUMPYR) oPGIIN(:,1:IJUMPYR) = PGIIN(:,1:IJUMPYR) oPGIRS(:,1:IJUMPYR) = PGIRS(:,1:IJUMPYR) oPGITR(:,1:IJUMPYR) = PGITR(:,1:IJUMPYR) oPMGTR(:,1:IJUMPYR) = PMGTR(:,1:IJUMPYR) oPNGCM(:,1:IJUMPYR) = PNGCM(:,1:IJUMPYR) oPNGEL(:,1:IJUMPYR) = PNGEL(:,1:IJUMPYR) oPNGIN(:,1:IJUMPYR) = PNGIN(:,1:IJUMPYR) oPNGRS(:,1:IJUMPYR) = PNGRS(:,1:IJUMPYR) oPNGTR(:,1:IJUMPYR) = PNGTR(:,1:IJUMPYR) oPRNG_PADD(:,1:IJUMPYR) = PRNG_PADD(:,1:IJUMPYR) oQGCELGR(:,1:IJUMPYR) = QGCELGR(:,1:IJUMPYR) oQGFC M(:,1:IJUMPYR) = QGFCM(:,1:IJUMPYR) oQGFEL(:,1:IJUMPYR) = QGFEL(:,1:IJUMPYR) oQGFELGR(:,1:IJUMPYR) = QGFELGR(:,1:IJUMPYR) oQGFIN(:,1:IJUMPYR) = QGFIN(:,1:IJUMPYR) oQGFHM(:,1:IJUMPYR) = QGFHM(:,1 :IJUMPYR) oQGFRS(:,1:IJUMPYR) = QGFRS(:,1:IJUMPYR) oQGFTR(:,1:IJUMPYR) = QGFTR(:,1:IJUMPYR) oQGFTRFV(:,1:IJUMPYR) = QGFTRFV(:,1:IJUMPYR) oQGFTRPV(:,1:IJUMPYR) = QGFTRPV(:,1:IJUMPYR) oQGICM(:,1:IJUMP YR) = QGICM(:,1:IJUMPYR)oQGIEL(:,1:IJUMPYR) = QGIEL(:,1:IJUMPYR) oQGIELGR(:,1:IJUMPYR) = QGIELGR(:,1:IJUMPYR) oQGIIN(:,1:IJUMPYR) = QGIIN(:,1:IJUMPYR) oQGIHM(:,1:IJUMPYR) = QGIHM(:,1:IJUMPYR) oQGIRS(:,1:IJUMPYR) = QGIRS(:,1:IJUMPYR) oQGITR(:,1:IJUMPYR) = QGITR(:,1:IJUMPYR) oQGPTR(:,1:IJUMPYR) = QGPTR(:,1:IJUMPYR) oQLPIN(:,1:IJUMPYR) = QLPIN(:,1:IJUMPYR) oQNGAS(:,1:IJUMPYR) = QNGAS(:,1:IJUMPYR) oQNGEL(:,1:IJUMPYR) = QNGEL(:,1:IJUMPYR) oUCAPOSU(:,1:IJUMPYR) = UCAPOSU(:,1:IJUMPYR) oUCAPOSN(:,1:IJUMPYR) = UCAPOSN(:,1:IJUMPYR) oUCAPOSC(:,1:IJUMPYR) = UCAPOSC(:,1:IJUMPYR) oPRSEL(:,1:IJUMPYR) = PRSEL(:,1:IJUMPYR) oPDSIN(:,1:IJUMPYR) = PDSIN(:,1:IJUMPYR) oPRSTR(:,1:IJUMPYR) = PRSTR(:,1:IJUMPYR) oPELIN(:,1:IJUMPYR) = PELIN(:,1:IJUMPYR) oRFQT DCRD(:,1:IJUMPYR) = RFQTDCRD(:,1:IJUMPYR) oSPGFELGR(:,1:IJUMPYR,:) = SPGFELGR(:,1:IJUMPYR,:) oSPGIELGR(:,1:IJUMPYR,:) = SPGIELGR(:,1:IJUMPYR,:) oSQGFELGR(:,1:IJUMPYR,:) = SQGFELGR(:,1:IJUMPYR,:) oSQGIELGR(:,1:IJUMPYR,: ) = SQGIELGR(:,1:IJUMPYR,:) oGMD_ALB(1:IJUMPYR) = GMD_ALB(1:IJUMPYR) oGAK_ALB(1:IJUMPYR) = GAK_ALB(1:IJUMPYR) oNGSCRV_MIN(1:IJUMPYR) = NGSCRV_MIN(1:IJUMPYR) oNGSCRV_MAX(1:IJUMPYR) = NGSCRV_MAX(1:IJUMPYR) oNGSCRV_Q(1:IJUMPYR) = NGSCRV_Q(1:IJUMPYR) oNGSCRV_P(1:IJUMPYR) = NGSCRV_P(1:IJUMPYR) oNGSCRV_Q0(1:IJUMPYR) = NGSCRV_Q0(1:IJUMPYR) oNGSCRV_P0(1:IJUMPYR) = NGSCRV_P0(1:IJUMPYR) oNGSCRV_ELAS = NGSCRV_ELAS oNGSCRV_PER = NGSCRV_PER oOGCAPIMP(:,1:IJUMPYR) = OGCAPIMP(:,1:IJUMPYR) oCNLNGIMP(1:IJUMPYR) = CNLNGIMP(1:IJUMPYR) oMKTPRC_ADD(1:IJUMPYR) = MKTPRC_ADD(1:IJUMPYR) oOGSHALENG(1:IJUMPYR) = OGSHALENG(1:IJUMPYR) oOGPRDUGR(:,:,1:IJUMPYR) = OGPRDUGR(:,:,1:IJUMPYR) oNGBAL(1:IJUMPYR) = NGBAL(1:IJUMPYR) oEL_MRKUP_BETA = EL_MRKUP_BETA oQNG_NONELEC(:,1:IJUMPYR,:) = QNG_NONELEC(:,1:IJUMPYR,:) oCPSB(:,1:IJUMPYR) = CPSB(:,1:IJUMPYR) oCPSBT(:,1:IJUMPYR) = CPSBT(:,1:IJUMPYR) oACGPR_RESCOM(:,1:IJUMPYR) = ACGPR_RESCOM(:,1:IJUMPYR) oARESCOM(:,1:IJUMPYR) = ARESCOM(:,1:IJUMPYR) oUDTAR(:,1:IJUMPYR) = UDTAR(:,1:IJUMPYR) oEWSPRCN(:,1:IJUMPYR) = EWSPRCN(:,1:IJUMPYR) oCGOGSGEN(:,1:IJUMPYR,:,:) = CGOGSGEN(:,1:IJUMPYR,:,:) oTRCTLOVR(:) = TRCTLOVR(:) oTRCTLFCF(:) = TRCTLFCF(:) oQCLGAS(:,1:IJUMPYR) = QCLGAS(:,1:IJUMPYR) oQCLGHP(:,1:IJUMPYR) = QCLGHP(:,1:IJUMPYR) oPCLGAS(:,1:IJUMPYR) = PCLGAS(:,1:IJUMPYR) oXPCLGAS(:,1:MNXYR) = XPCLGAS(:,1:MNXYR) oPCLEL(:,1:IJU MPYR) = PCLEL(:,1:IJUMPYR)oCFNGCL(1:IJUMPYR) = CFNGCL(1:IJUMPYR) oJCLIN(1:IJUMPYR) = JCLIN(1:IJUMPYR) oEXTRARISK(BASEYR:IJUMPCALYR) = EXTRARISK(BASEYR:IJUMPCALYR) oEMETAX(:,1:IJUMPYR) = EMETAX(:,1: IJUMPYR) oEMLIM(:,1:IJUMPYR) = EMLIM(:,1:IJUMPYR) oCNGAVAIL(:,1:IJUMPYR) = CNGAVAIL(:,1:IJUMPYR)

DO J=1,MNUMCR

- 2 DO I=oRECSYEAR,IJUMPCALYR oRSGASCUST(I,J) = RSGASCUST(I,J) ENDDO ENDDO

RETURN END

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =

! ROUTINE TO TRANSFER LOCAL VARIABLES TO NEMS GLOBAL VARIABLES ! (DONE TO FACILITATE RUNNING W/NRCAN)

! = = = = = = = = = = = = = = = = = = = = = = = = = = = =
SUBROUTINE NGGLB_OUTTRANS IMPLICIT NONE include 'parametr' include 'ncntrl' include 'cdsparms' include 'emmparm' include 'coalout' include 'convfact' include 'emablk' include 'emission' include 'intout' include 'macout' include 'mpblk' include 'pmmout' include 'qblk' include 'uefdout' include 'ngrpt' include 'ngtdmout' include 'ngtdmrep' include 'ogsmout' include 'resdrep' include 'udatout' include 'cogen' include 'mxpblk' include 'ogglobal' include 'efpout' include 'uecpout'

INTEGER*4 I,J

AKGTL_NGCNS(1:IJUMPYR) = oAKGTL_NGCNS(1:IJUMPYR)CAP_CEN(:,:,1:IJUMPYR) = oCAP_CEN(:,:,1:IJUMPYR) CAP_CEX(:,:,1:IJUMPYR) = oCAP_CEX(:,:,1:IJUMPYR) CAP_NEN(:,:,1:IJUMPYR) = oCAP_NEN(:,:,1:IJUMPYR) CAP_NEX(:,:,1:IJUMPYR) = oCAP_NEX(:,:,1:IJUMPYR) CFNGC(1:IJUMPYR) = oCFNGC(1:IJUMPYR) CFNGN(1:IJUMPYR) = oCFNGN(1:IJUMPYR) CFNGU(1:IJUMPYR) = oCFNGU(1:IJUMPYR) CLSYNGQN(:,1:IJUMPYR) = oCLSYNGQN(:,1:IJUMPYR) EI2NGA(:,1:IJUMPYR) = oEI2NGA(:,1:IJUMPYR) EQGCELGR(:,1:IJUMPYR) = oE QGCELGR(:,1:IJUMPYR) EQGFELGR(:,1:IJUMPYR) = oEQGFELGR(:,1:IJUMPYR) EQGIELGR(:,1:IJUMPYR) = oEQGIELGR(:,1:IJUMPYR) IT_WOP(1:IJUMPYR,:) = oIT_WOP(1:IJUMPYR,:) XIT_WOP = oXIT_WOP JMGTR(1:IJUMPYR) = oJMGTR(1:IJUMPYR) JNGTR(1:IJUMPYR) = oJNGTR(1:IJUMPYR) MC_CPI(:,1:IJUMPYR) = oMC_CPI(:,1:IJUMPYR) MC_JECIWSP(1:IJUMPYR) = oMC_ECIWSP(1:IJUMPYR) MC_JPGDP(

- 2:IJUMPYR) = oMC_PCWGDP(

- 2:IJUMPYR) MC_RMGBLUSREAL(1:IJUMPYR) = oMC_REALRMGBLUS(1:IJUMPYR) MC_RMCORPPUAA(1:IJUMPYR) = oMC_RMPUAANS(1:IJUMPYR) MC_WPI(1:IJUMPYR) = oMC_WPI(1:IJUMPYR) MC_WPI055(1:IJUMP YR) = oMC_WPI055(1:IJUMPYR) MC_RMTCM10Y(1:IJUMPYR) = oMC_RMGFCM_10NS(1:IJUMPYR) MC_RMCORPBAA(1:IJUMPYR) = oMC_RMCORPBAA(1:IJUMPYR) NGARCMP = oNGARCMP NGCAPS(:,:,1:IJUMPYR) = oNGCAPS(:,:,1:IJUMPYR ) NGFLOWS(:,:,1:IJUMPYR) = oNGFLOWS(:,:,1:IJUMPYR) NGPIPCAP(:,1:IJUMPYR) = oNGPIPCAP(:,1:IJUMPYR) NGSTRCAP(:,1:IJUMPYR) = oNGSTRCAP(:,1:IJUMPYR) OGCCAPPRD(:,1:IJUMPYR) = oOGCCAPPRD(:,1:IJUMPYR) OGCNPPRD(:,1:I JUMPYR) = oOGCNPPRD(:,1:IJUMPYR) OGCNQPRD(:,1:IJUMPYR) = oOGCNQPRD(:,1:IJUMPYR) OGGROWFAC(1:IJUMPYR) = oOGGROWFAC(1:IJUMPYR) OGPNGEXP(:,1:IJUMPYR) = oOGPNGEXP(:,1:IJUMPYR) OGPNGIMP(:,1:IJUMPYR) = oOGPNGIMP( :,1:IJUMPYR) OGPRCEXP(1:IJUMPYR) = oOGPRCEXP(1:IJUMPYR) OGPRDADOF(:,1:IJUMPYR) = oOGPRDADOF(:,1:IJUMPYR) OGPRDADON(:,1:IJUMPYR) = oOGPRDADON(:,1:IJUMPYR) OGPRDNG(:,1:IJUMPYR) = oOGPRDNG(:,1:IJUMPYR) OGPRDN GOF(:,1:IJUMPYR) = oOGPRDNGOF(:,1:IJUMPYR) OGPRDNGON(:,1:IJUMPYR) = oOGPRDNGON(:,1:IJUMPYR) OGPRRCAN(:,1:IJUMPYR) = oOGPRRCAN(:,1:IJUMPYR) ! OGPRRNG89 = oOGPRRNG89 OGPRRNGOF(:,1:IJUMPYR) = oOGPRRNGOF(:,1:IJUMPYR) OGPRRNGON(:,1:IJUMPYR) = oOGPRRNGON(:,1:IJUMPYR) OGPRSUP(1:IJUMPYR) = oOGPRSUP(1:IJUMPYR) OGSUPGAS(:,:,1:IJUMPYR) = oOGSUPGAS(:,:,1:IJUMPYR) OGNGRSV(:,1:IJUMP YR) = oOGNGRSV(:,1:IJUMPYR) OGQNGREP(:,1:IJUMPYR) = oOGQNGREP(:,1:IJUMPYR) EXSPEND(:,1:IJUMPYR) = oEXSPEND(:,1:IJUMPYR) ! OGPR_BNG = oOGPR_BNG ! OGPR_CAR(

- 1:IJUMPYR) = oOGPR_CAR(

- 1:IJUMPYR) ! OGPR_CNG = oOGPR_CNG! OGPR_HNG = oOGPR_HNG

! OGPR_RNG = oOGPR_RNG OGPRCOAK(:,1:IJUMPYR) = oOGPRCOAK(:,1:IJUMPYR) OGQANGTS(1:IJUMPYR) = oOGQANGTS(1:IJUMPYR) OGQNGE XP(:,1:IJUMPYR) = oOGQNGEXP(:,1:IJUMPYR) OGQNGIMP(:,1:IJUMPYR) = oOGQNGIMP(:,1:IJUMPYR) OGRESCAN(:,1:IJUMPYR) = oOGRESCAN(:,1:IJUMPYR) OGRESNGOF(:,1:IJUMPYR) = oOGRESNGOF(:,1:IJUMPYR) OGRESNGON(:,1:IJUMPYR) = oOGRESNGON(:,1:IJUMPYR) OGTAXPREM(:,1:IJUMPYR) = oOGTAXPREM(:,1:IJUMPYR) ! OGWPNG89 = oOGWPNG89 OGHHPRNG(1:IJUMPYR) = oOGHHPRNG(1:IJUMPYR) OGWPRNG(:,1:IJUMPYR) = oO GWPRNG(:,1:IJUMPYR) XOGWPRNG = oXOGWPRNG OGWPTDM(:,1:IJUMPYR) = oOGWPTDM(:,1:IJUMPYR) PBAJA(1:IJUMPYR) = oPBAJA(1:IJUMPYR) QBAJA(1:IJUMPYR) = oQBAJA(1:IJUMPYR) PGCELGR(:,1:IJUMPYR) = oPGCELGR(:,1:IJUMPYR) PGFCM(:,1:IJUMPYR) = oPGFCM(:,1:IJUMPYR) PGFEL(:,1:IJUMPYR) = oPGFEL(:,1:IJUMPYR) PGFELGR(:,1:IJUMPYR) = oPGFELGR(:,1:IJUMPYR) PGFIN(:,1:IJUMPYR) = oPGFIN(:,1:IJUMPYR) PGFRS(:,1:IJUMPYR) = oPGFRS(:,1:IJUMPYR) PGFTR(:,1:IJUMPYR) = oPGFTR(:,1:IJUMPYR) PGFTRFV(:,1:IJUMPYR) = oPGFTRFV(:,1:IJUMPYR) PGFTRPV(:,1:IJUMPYR) = oPGFTRPV(:,1:IJUMPYR) PGICM(:,1:IJUMPYR) = oPGICM(:,1:IJUMPYR) PGIEL(:,1:IJUMPYR) = oPGIEL(:,1:IJUMPYR) PGIELGR(:,1:IJUMPYR) = oPGIELGR(:,1:IJUMPYR) PGIIN(:,1:IJUMPYR) = oPGIIN(:,1:IJUMPYR) PGIRS(:,1:IJUMPYR) = oPGIRS(:,1:IJUMPYR) PGITR (:,1:IJUMPYR) = oPGITR(:,1:IJUMPYR) PMGTR(:,1:IJUMPYR) = oPMGTR(:,1:IJUMPYR) PNGCM(:,1:IJUMPYR) = oPNGCM(:,1:IJUMPYR) PNGEL(:,1:IJUMPYR) = oPNGEL(:,1:IJUMPYR) PNGIN(:,1:IJUMPYR) = oPNGIN(:,1:I JUMPYR) PNGRS(:,1:IJUMPYR) = oPNGRS(:,1:IJUMPYR) PNGTR(:,1:IJUMPYR) = oPNGTR(:,1:IJUMPYR) PRNG_PADD(:,1:IJUMPYR) = oPRNG_PADD(:,1:IJUMPYR) QGCELGR(:,1:IJUMPYR) = oQGCELGR(:,1:IJUMPYR) QGFCM(:,1:IJUMPY R) = oQGFCM(:,1:IJUMPYR) QGFEL(:,1:IJUMPYR) = oQGFEL(:,1:IJUMPYR) QGFELGR(:,1:IJUMPYR) = oQGFELGR(:,1:IJUMPYR) QGFIN(:,1:IJUMPYR) = oQGFIN(:,1:IJUMPYR) QGFHM(:,1:IJUMPYR) = oQGFHM(:,1:IJUMPYR) QGFRS(:,1:IJUMPYR) = oQGFRS(:,1:IJUMPYR) QGFTR(:,1:IJUMPYR) = oQGFTR(:,1:IJUMPYR) QGFTRFV(:,1:IJUMPYR) = oQGFTRFV(:,1:IJUMPYR) QGFTRPV(:,1:IJUMPYR) = oQGFTRPV(:,1:IJUMPYR) QGICM(:,1:IJUMPYR) = oQGICM(:,1:IJUMPYR) QGIEL(:,1:IJUMPYR) = oQGIEL(:,1:IJUMPYR) QGIELGR(:,1:IJUMPYR) = oQGIELGR(:,1:IJUMPYR) QGIIN(:,1:IJUMPYR) = oQGIIN(:,1:IJUMPYR) QGIHM(:,1:IJUMPYR) = oQGIHM(:,1:IJUMPYR)QGIRS(:,1:IJUMPYR) = oQGIRS(:,1:IJUMPYR) QGITR(:,1:IJUMPYR) = oQGITR(:,1:IJUMPYR) QGPTR(:,1:IJUMPYR) = oQGPTR(:,1:IJUMPYR) QLPIN(:,1:IJUMPYR) = o QLPIN(:,1:IJUMPYR) QNGAS(:,1:IJUMPYR) = oQNGAS(:,1:IJUMPYR) QNGEL(:,1:IJUMPYR) = oQNGEL(:,1:IJUMPYR) UCAPOSU(:,1:IJUMPYR) = oUCAPOSU(:,1:IJUMPYR) UCAPOSN(:,1:IJUMPYR) = oUCAPOSN(:,1:IJUMPYR) UCAPOSC (:,1:IJUMPYR) = oUCAPOSC(:,1:IJUMPYR) PRSEL(:,1:IJUMPYR) = oPRSEL(:,1:IJUMPYR) PDSIN(:,1:IJUMPYR) = oPDSIN(:,1:IJUMPYR) PRSTR(:,1:IJUMPYR) = oPRSTR(:,1:IJUMPYR) PELIN(:,1:IJUMPYR) = oPELIN(:,1:I JUMPYR) RFQTDCRD(:,1:IJUMPYR) = oRFQTDCRD(:,1:IJUMPYR) SPGFELGR(:,1:IJUMPYR,:) = oSPGFELGR(:,1:IJUMPYR,:) SPGIELGR(:,1:IJUMPYR,:) = oSPGIELGR(:,1:IJUMPYR,:) SQGFELGR(:,1:IJUMPYR,:) = oSQGFELGR(:,1:IJUMPYR,:) SQGI ELGR(:,1:IJUMPYR,:) = oSQGIELGR(:,1:IJUMPYR,:) GMD_ALB(1:IJUMPYR) = oGMD_ALB(1:IJUMPYR) GAK_ALB(1:IJUMPYR) = oGAK_ALB(1:IJUMPYR) NGSCRV_MIN(1:IJUMPYR) = oNGSCRV_MIN(1:IJUMPYR) NGSCRV_MAX(1:IJUMPYR) = oNG SCRV_MAX(1:IJUMPYR) NGSCRV_Q(1:IJUMPYR) = oNGSCRV_Q(1:IJUMPYR) NGSCRV_P(1:IJUMPYR) = oNGSCRV_P(1:IJUMPYR) NGSCRV_Q0(1:IJUMPYR) = oNGSCRV_Q0(1:IJUMPYR) NGSCRV_P0(1:IJUMPYR) = oNGSCRV_P0(1:IJUMPYR) NGSCRV_ELAS = oNGSCRV_ELAS NGSCRV_PER = oNGSCRV_PER OGCAPIMP(:,1:IJUMPYR) = oOGCAPIMP(:,1:IJUMPYR) CNLNGIMP(1:IJUMPYR) = oCNLNGIMP(1:IJUMPYR) MKTPRC_ADD(1:IJUMPYR) = oMKTPRC_ADD( 1:IJUMPYR) OGSHALENG(1:IJUMPYR) = oOGSHALENG(1:IJUMPYR) OGPRDUGR(:,:,1:IJUMPYR) = oOGPRDUGR(:,:,1:IJUMPYR) NGBAL(1:IJUMPYR) = oNGBAL(1:IJUMPYR) EL_MRKUP_BETA = oEL_MRKUP_BETA QNG_NONELEC(:,1:IJU MPYR,:) = oQNG_NONELEC(:,1:IJUMPYR,:) CPSB(:,1:IJUMPYR) = oCPSB(:,1:IJUMPYR) CPSBT(:,1:IJUMPYR) = oCPSBT(:,1:IJUMPYR) ACGPR_RESCOM(:,1:IJUMPYR) = oACGPR_RESCOM(:,1:IJUMPYR) ARESCOM(:,1:IJUMPYR) = oARESCOM(:,1 :IJUMPYR) UDTAR(:,1:IJUMPYR) = oUDTAR(:,1:IJUMPYR) EWSPRCN(:,1:IJUMPYR) = oEWSPRCN(:,1:IJUMPYR) CGOGSGEN(:,1:IJUMPYR,:,:) = oCGOGSGEN(:,1:IJUMPYR,:,:) TRCTLOVR(:) = oTRCTLOVR(:) TRCTLFCF(:) = oTRCTLFCF(:) QCLGAS(:,1:IJUMPYR) = oQCLGAS(:,1:IJUMPYR) QCLGHP(:,1:IJUMPYR) = oQCLGHP(:,1:IJUMPYR) PCLGAS(:,1:IJUMPYR) = oPCLGAS(:,1:IJUMPYR) XPCLGAS(:,1:MNXYR) = oXPCLGAS(:,1:MNXYR) PCLEL(:,1:IJUMPYR) = oPCLEL(:,1:IJUMPYR) CFNGCL(1:IJUMPYR) = oCFNGCL(1:IJUMPYR) JCLIN(1:IJUMPYR) = oJCLIN(1:IJUMPYR) EXTRARISK(BASEYR:IJUMPCALYR) = oEXTRARISK(BASEYR:IJUMPCALYR) EMETAX(:,1:IJUMPYR) = oEMETAX(:,1:IJUMPYR)EMLIM(:,1:IJUMPYR) = oEMLIM(:,1:IJUMPYR) CNGAVAIL(:,1:IJUMPYR) = oCNGAVAIL(:,1:IJUMPYR)

DO J=1,MNUMCR

- 2 DO I=oRECSYEAR,IJUMPCALYR RSGASCUST(I,J) = oRSGASCUST(I,J) ENDDO ENDDO

RETURN END