!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)

!

! 01/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

 INTEGER*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 RUNTIME PARAMETER VALUE

 INTEGER*4 FIXAKMD ! RUNTIME PARAMETER FOR FIXING MACKEN & 

ANGTS FLOWS

 INTEGER*4 JENDYR ! LAST YEAR VALUE CORRESPONDS TO IENDYR
 EXTERNAL 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_MEX
 IF (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. SRC.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 ! WRITE 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.)

 FNAME='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='NGOBAL '

 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 INPUT, 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

 ENDIF

 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 METHOD

 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 

SINGLE 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 NGADJ_PINEU ! ADJUST HIST PR FOR IN & EU SEC
 CALL 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 DTAR_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

 ENDIF
 CALL NGTDM_POST ! POST PROCESS RESULTS INTO NEMS 

VAR

 IF (NGDBGITR(1,2)) CALL NGREPOUT

 CALL NGGLB_OUTTRANS

 RETURN

 END

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

!

! READ DATA TO DEVELOP MAPPING 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

 CHARACTER*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 NEXTDATA(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)=NVSUP

!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 ARC
 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. '#') ! 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 ARCS

 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

 ENDDO
 CALL 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) = I
 ARC_LOOP(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 TO ANGTS
 CALL 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 CROSSING 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

 25 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 SUBREGIONS
 CALL 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 FORMAT(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 NEXTDATA(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_USRDATA

 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 ALGORITHM 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_DELTA
 READ(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

 oNGSCRV_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

!

! CALLED 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 COLUMN

 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 DUM9

 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(NGDTAR)

 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,DNODES)

 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(NGDTAR)

 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,LHISYR)

 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 FORMAT(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_YEAR)

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

 READ(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),CYR=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

 STOGWPRNG(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)/oMC_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 UNITNUM ! UNIT NUMBER

 CHARACTER*1 CH ! BEGINNING OF DATA FLAG

! -------------

! READ UNTIL @ IN 1ST COLUMN
 CH = '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 'ngcdmdinc'

 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 CONSTANT 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,JENDYR
 ARC_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,NARCS
 PKUTZ(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 (MODYR.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

! NOTE: 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,DEST) = 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), &

 (INTRA_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,NETWORK
 PTNETFLOW(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,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)

 ENDDO

 ENDIF

 ! SET REVENUE 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,TNODES)

 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 PTM
 IF (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,STNODES

 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 VARIABLES:

! 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 FIRM

!

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

 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 

ANGTS
 REAL*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 JAPAN

 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 AKGTL_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.

 ENDIF
 IF (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.943884 * 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

! ESTABLISH 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)*(MODYR1969-1)) ) ) )

!!!!! AK_WPRC(1) = (0.652076*(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

! SET 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,MODYR1)*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,MODYR1)*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,MODYR1)*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,MODYR-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.23222)))/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 + QALK_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,CURIYR) = 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

 oOGWPRNG(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)

 AKPR_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 SEASONAL 

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.0
 ENDDO

 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(CURIYR)

 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) / oCFNGC(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) = BASQTY_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

 ENDIF
 ENDDO

! 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)

 ENDDO

 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 SECTORS 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.GT.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_UI(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 NGTDM--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_PKSHR_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(NGUNIT,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)

 ENDIF

 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)

 BASUQTY_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

 INTEGER*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 FIRST 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(NGOBAL,*) '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) THEN
 NGDBGITR(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 YEAR (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'

 include 'ngdtminc'

! ---------------

 CALL NGDTM_FORECAST_DTARF ! EXCLUDES TRANS. ! DTMEQU

 CALL NGDTM_FORECAST_TRNF ! TRANS DTAR_F

 CALL NGDTM_DTARI ! SET I DIST. TARIFF
 RETURN

 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)

 DTAR_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_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

 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,NREG,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,NSEC,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)

 BASQTY_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,EHISYR 
 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)

 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 NONE

 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 ! COUNTER
 INTEGER*4 NREG ! REGION COUNTER

 INTEGER*4 NSEC ! SECTOR COUNTER

 REAL*4 ATAR(NETWORK,DNODES) ! AVERAGE 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,MODYR) - 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 SUBREGIONS 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)

 ENDDO
 ENDDO

 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 COUNTER

 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

 RETURN
 END

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

!

! 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'

 include '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 PLANTS (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(NETWORK) ! IND CONS (F+I) IN CURRENT YEAR, 

BY PK & OP

 REAL*4 QLAG(NETWORK) ! IND CONS (F+I) LAST YEAR, ANNUAL
 REAL*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

 REAL*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 LAST 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),PINREG4(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,NETWORK), 

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,NETWORK), &

 

PRSREG18(DNODES),PRSREGPK18(DNODES,NETWORK),PRSREG19(DNODES),PRSREGPK19(D

NODES,NETWORK)

 REAL*4 PELREG1(NNGEM-1),PELREG2(NNGEM-1),PELREG3(NNGEM1),PELREG4(NNGEM-1),PELREG5(NNGEM-1), &

 PELREG6(NNGEM-1),PELREG20(NNGEM-1),PELREG21(NNGEM1),PELREG22(NNGEM-1),PELREG23(NNGEM-1), &

 PELREG24(NNGEM-1),PELREG25(NNGEM-1),PELREG26(NNGEM1),PELREG27(NNGEM-1),PELREG28(NNGEM-1), &

 PELREG29(NNGEM-1),PELREG30(NNGEM-1),PELREG31(NNGEM1),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.525536,-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.15202,-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.695292,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.874365,-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.2819,-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,DNODES),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.2517,-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.899262,-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.28980,-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,DNODES),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.8081,-

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.51090,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.86142,-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,DNODES),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.8689,-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,NETWORK)/-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.534268,-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.303088,-

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 change

 -.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 PELREG27/-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 Version 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 

15

! 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 

15 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.278062,&

 -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(CURIYR1)**HW_BETA1) * (HDYWHTLAG**HW_RHO) * &

! EXP(-HW_RHO*HW_BETA0) * (oMC_WPI055(CURIYR2)**(-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(CURIYR1)/100.)+0.25)*HDYWHT*oMC_PCWGDP(7)/oMC_PCWGDP(CURIYR-1)) + &

 0.3 * (oMC_ECIWSP(CURIYR1)*oMC_PCWGDP(7)/oMC_PCWGDP(CURIYR-1))

 HDYWHTLAG = HDYWHT

 IF (MODYR.GE.oRECSYEAR) 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(CURIYR)**HW_BETA1) * 

(HDYWHTLAG**HW_RHO) * &

! EXP(-HW_RHO*HW_BETA0) * (oMC_WPI055(CURIYR1)**(-HW_RHO*HW_BETA1))

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

(HDYWHTLAG**HW_RHO) * &

 EXP(-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(CURIYR))

!-------------

 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,NSEC,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,NREG) + 

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 (OPTIND.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(NREG) + 

IN_PKALP(NREG,NET) + &

 (IN_DIST * oPDSIN(NG_CENMAP(NREG),CURIYR2)) +(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) THEN
 TAR = -0.033226 + PINREG10(NREG) + PINREGPK10(NREG,NET) 

&

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

- 0.400115* (-.033226 + PINREG10(NREG) + 

PINREGPK10(NREG,NET) &

 - 0.000313404*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(NREG) + 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) + PINREGPK13(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) + PINREGPK15(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,NREG) = 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.EQ.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))**CM_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_PCWGDP(-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_SFPREV(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,NSEC,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_SFPREV(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*(PCMREG13(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(PCMREG13(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_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)) * &

 (COSTLAG**(-RS_RHO*RS_COST)) * oMC_PCWGDP(-

2)/oMC_PCWGDP(7)

 ELSEIF (OPTRES.EQ.6) THEN
 DTAR_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_SFPREV(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(NREG,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

 ! ENDIF
 DTAR_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_SFPREV(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)

NUMRSPKLAG = NUMRS(NREG,MODYR-1)

 ELSE

 NUMRSPK = 0.0

NUMRSPKLAG = 0.0
 ENDIF

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)+PRSREGPK4(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_SFPREV(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.913484))

 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)
 NUMRSPKLAG = 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(MODYR)-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.00383180*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,NSEC,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(PRSREG17(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(NET,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,NSEC,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(NREG)+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 Judgement

! 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)

 IF (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(NGT)) + &

 (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.311220 * 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.263437*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(NET,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)+BASUQTY_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 + PELREG4(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(NET,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.198411 * &

 ((-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) + PELREG21(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.00000131132*(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*UDTAR_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.190692) + 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))) )

 ENDDO
 ELSEIF (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(NET,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,NNGEM-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.734297*(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,NNGEM-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.00000103747*(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_SFPREV(NET,NREG)+BASUQTY_SIPREV(NET,NREG))*1000)

! ENDDO

! ELSEIF (OPTELO.EQ.32.AND.NET.EQ.2) THEN ! 2010 Version 1 OffPeak, 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_SIPREV(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 OffPeak, + 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)+BASUQTY_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 OffPeak

! 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 OffPeak

 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,NNGEM-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,CURIYR1)+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,CURIYR1))+(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,CURIYR1))+(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)

 WRITE(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)

 WRITE(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

!

 ENDIF
 15 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 VEHICLES 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 VEHICLES
 DO 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 CONTINUE
 DO 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$. Outputs 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 MMBTU
REAL 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 BUILD_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 

that 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 = AVAIL(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_DEMAND(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 2000, 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 may 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_PRC .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 'ngparinc'

 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 IMPORT/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)

 RETURN

 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 SUBREGIONS

 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(CURIYR)

 oSPGIELGR(NNGEM,CURIYR,NET) = AKPR_I(SEC) / oCFNGU(CURIYR)

 ENDDO
 RETURN

 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,MNUMCR-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(MODYR) * (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(SEC,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 TOTALS 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) = ALLQ(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) oPNGTR(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 CENSUS 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,CURIYR)

 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 ogsmCflg ! 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

 oQLPIN(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 PRODUC

 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) 

! endif
 IF (S.EQ.12) THEN

 oQLPIN(I,CURIYR) = oQLPIN(I,CURIYR) + &

 oCFNGC(CURIYR) * (LPQTY + (PCTLP(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)))

 LPQTY = 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 + (PCTLP(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,CURIYR1),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 HISTORICALLY

! 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_PADD(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 ! ONSHORE 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 ! OGSM REGION 7-9

 IF (oOGPRDNG(P,CURIYR) .GT. 0.) THEN

 oOGWPRNG(P,CURIYR) = TOTPQ(P) / oOGPRDNG(P,CURIYR)

 ELSE

! oOGWPRNG(P,CURIYR) = DEFPR_SUP
 oOGWPRNG(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

 oOGWPRNG(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 TO 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-LNGNODES-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_OGIMPEXP
 IMPLICIT 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 PLACEHOLDER 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(OGCAN,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 INTO 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) + & ! flowthru 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(OGCAN) = 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)

 ENDDO

 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

 TOTQ(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,MODYR)= 0.0
 ENDIF

 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

 ENDDO

! -------

! 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(MNUMBX3,CURIYR)

 ELSE

 IF (CURIYR .GT. 1) THEN
 oOGPNGIMP(MNUMBX-3,CURIYR) = oOGPNGIMP(MNUMBX-3,CURIYR-1)

 ELSE

 oOGPNGIMP(MNUMBX-3,CURIYR) = 1.5 ! ??????????

 ENDIF

 ENDIF

 oOGQNGIMP(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(MNUMBX2,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(LNG_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(CURIYR) .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 applies 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,CURIYR)

 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(MNUMBX1,CURIYR)

 ELSE

 IF (CURIYR .GT. 1) THEN
 oOGPNGIMP(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,CURIYR) + &

! oOGQNGIMP(14,CURIYR) ! include PL 

imp fr Bahamas (FL)

 oOGQNGIMP(18,CURIYR) ! include PL 

imp fr Bahamas (FL)

 oOGQNGEXP(MNUMBX,CURIYR) = oOGQNGEXP(MNUMBX,CURIYR) + 

oOGQNGEXP(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 Bahamas (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 ! INDICES
 oNGBAL(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.0
 DO 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

 ENDDO
 DO 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

 ENDDO
 RETURN

 END

!******************************************************************C

! CALCULATES PHYSICAL CAPACITY, UTILIZATION, AND ADDITIONS

! ENTERING AND EXITING THE TWELEVE NGTDM REGIONS AND

! THE NINE CENSUS DIVISIONS FOR REPORTING IN FTAB.

! - CAP_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 NGTDM 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.0
 ENDDO

 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

 oNGARCMP(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(DEST,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) = oCAP_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)

 oCAP_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)

 oCAP_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_NEN(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,MODYR)

 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) + &

 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) + &

SACTPCAP(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,DNODES)

 WRITE(NGUNIT,*) 'END-USE DMD (BCF) '

 DO YR=IBASYR,JENDYR

 WRITE(NGUNIT,220) YR,(NGENDDMD(N,YR-IBASYR+1),N=1,DNODES+3)

 ENDDO
 WRITE(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)

 WRITE(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 FORMAT(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 '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

 REAL*4 DEL_SCALE ! DELTA BETWN STEO & LHISYR 

SCALING FACTOR

 REAL*4 LPLT_SCALE ! SCALE FACTOR FOR L&P
 REAL*4 TOTLP

! -----------

! SET SCALE_LP IF BENCHMARKING L&P TO STEO

 IF (MODYR .LE. BMYEAR) THEN

 IF (STINPUT_SCAL .EQ. 0) THEN

 TOTLP = (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)

 ENDIF

 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'

 WRITE(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

 ENDIF

 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 

! BCF
 PFUEL_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 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_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

 include '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 SCALE 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(IBASEYR+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_YR
 ELSE

 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) = PSUP(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

 SCALE_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 DO 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 PR
 REAL*4 TRESQ ! PLACEHOLDER FOR TOTAL 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

! -----------

! SET 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) + &

NGQTY_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(OPNET,J)

 ENDDO

 TOTEUPR = TOTEUPR / TEUQ ! qty-wt avg
 SCALE_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)) THEN
 WRITE(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 SCALE 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,1998
 YR1 = 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,1998

 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

 ! PHASE 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

 ENDIF
 WRITE(NGOBENCH,*) ' NATIONAL DISCRPANCY SCALING FACTORS'

 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)

 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 'ngparinc'

 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 ADJ DEALING W/NEW 

AER NUMBER ALIGNMENT
 LOGICAL 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)

 ENDDO
 ENDDO

 

 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

 ENDDO

 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 FORMAT(2X,"NET NODE ")

 60 FORMAT(1X,'<DISCR (4CAST)>',<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

 WRITE(NGOBENCH,*) ' NATIONAL DISCRPANCY SCALING FACTORS'

 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 SUPPLEMENTAL 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 = STPHAS_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=IBASYR,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 OUTPUTS

!

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

 SUBROUTINE NGREPIN

 IMPLICIT NONE

 include 'parametr'

 include 'ncntrl'

 include 'ngparinc'

 include 'ngtdminc'

 include 'ngakinc'

 include 'ogglobal'

!

 INTEGER*4 IO,I,IY
 INTEGER*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,IY),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,*) ' INPUTS 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,140) (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 INDEX, 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,*) ' OUTPUTS 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) (oPNGTR(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(MNUMCR,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)'

 WRITE(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 AFM 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),oOGQNGEXP(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(NETWORK)

 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 WEST

 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 

MEXICO 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=13
 IF (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',QSUP(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(MODYR))) ! 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.0
 IF (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(NET) = 

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. EHISYR) 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

 ENDIF
 ENDDO

 

 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) P0 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 PKSHR_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 CORRESPONDS 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(3X,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(3X,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,DNODES
 SUM=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 CANADA

 SUM = 0.0
 TOTYR2 = 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,LHISYR ! 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) = SUM1 / 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_SUPLM = 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="<HPKSHR_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,LHISYR
 SUM = 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=FHISYR,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_SUPLM
 ELSEIF (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-04
 DO 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, (YR,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,DSEC
 WRITE(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(NGOBENCH,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'

 include '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 ARC 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) = NGSTR_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)

 ENDDO
 10 FORMAT(1X,'STRTAR: ','YEAR ITR SID NEWVAR OLDVAR FIX 

FLOW')

 20 FORMAT(1X,'STRTAR: ',I4,I4,I4,3F8.4,F8.1)

 RETURN

 END

!*******************************************************************

! C A N A D A

!******************************************************************

 SUBROUTINE NGCANADA

 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 variables

 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

 INTEGER*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, CH1
 INTEGER*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(SHGAS,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

 REPADDCAN(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 econometric functions estimated by Ernie Zampelli.

!*********************************************************************

 SUBROUTINE NGOUT_CAN(IYR)

 IMPLICIT NONE
 include'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 ! LAGGED 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 regression 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-HIGH

 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 

 EXSPEND00LG2 = 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 

 URRCAN = (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= ",CUMRCAN," 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,IYR1)/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) = URRCAN**(-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) THEN
 CX(1) = EXP(3.27462 + .457621*(CN_PRC00*ROY_ADJ))

 CX(2) = EXP(.0000124107*URRCAN + .000650684*oOGCNQPRD(SHGAS,IYR1))

 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) THEN

CST_PRXYLAG = 2572767

ELSEIF (YEAR.EQ.2025) THEN

CST_PRXYLAG = 2563646

ELSEIF (YEAR.EQ.2026) THEN
CST_PRXYLAG = 2557042

ELSEIF (YEAR.EQ.2027) THEN

CST_PRXYLAG = 2528627

ELSEIF (YEAR.EQ.2028) THEN

CST_PRXYLAG = 2501563

ELSEIF (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.200))

 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)

 ELSEIF (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*SUCWELL*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(FRLAG)) &
 + (-.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 * CURPRRCAN ! 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) = oOGCNQPRD(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.122492*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)))

 PRRATCAN = (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

 PRRATCAN = 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(FRCAN)) 

 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)))) * ((PRRATCAN/(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*ALOG(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) + 

.118366*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) + .038994*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'

 include'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) 

Revise 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 

TECHNOLOGY

 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 UNCONVENTIONAL 

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 DEFINED
 INTEGER*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('OGTECH ',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(MODYR2008))))**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 ogsmc

 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 CN

 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 ! shallow, 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 

BCF
 ENDIF

 ENDDO

 CN_FIXSUP(2,MODYR) = 

CN_FIXSUP(3,MODYR)+CN_FIXSUP(4,MODYR)+CN_FIXSUP(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)*(AB_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 per mil cubic 

meters
 REAL*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(AB) ! 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.0
 DO 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

 cOGCNXPRD(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(NGUNIT,*) ' 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,cOGCNPPRD(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+1989,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(NGUNIT,*) 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(NGUNIT,*) ' 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

 write(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(MNUMBX3,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

!cn 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 cOGCNQPRD(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,IJUMPYR

!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 CNLNGIMP(CURIYR)

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

 SUBROUTINE NGCAN_LNGVS

 IMPLICIT NONE

 include 'parametr'

 include 'ncntrl'

 include 'ngparinc'

 include 'ngitminc'

 include 'ngtdminc'

 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.CAN
 oCNLNGIMP(CURIYR) = oCNLNGIMP(CURIYR) + FLOW(NET,A)

 ENDDO

 

 RETURN

 END

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

! ROUTINE TO OVERWRITE CANADIAN IMPORT CAPACITY IN SIDE CASE RUNS

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

 SUBROUTINE NGCANCAP(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 CONS (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 

FACTOR

 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 CAN 

IMPORT ARC

 REAL*4 CN_GRW ! GROWTH FACTOR ON ALLOWED 

PIPE EXP
 REAL*4 CUMAKCAP ! IMPORT CAP TARGETED FOR 

ANGTS, AFTER DECISION, BEFORE FLOW

 REAL*4 TOTBRD ! CURRENT TOTAL 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 

BORDER

 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 RTOVALUE

 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 

NGCANOVR 
 5180.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 

NGCANOVR 

 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, 1852.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 

NGCANOVR 
 5496.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 = RTOVALUE('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) THEN

 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

 UCANCAP(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)/oQNGAS(11,CURIYR+1))-1.))

! UCANCAP(I,MODYR) = AMAX1(UCANCAP(I,MODYR),(UCANCAP(I,MODYR1)*CN_GRW))

 UCANCAP(I,MODYR) = AMAX1(UCANCAP(I,MODYR),CN_GRW)

 PLANPCAP(ARC2,MODYR) = UCANCAP(I,MODYR) - UCANCAP(I,MODYR1)

 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.0
 DO 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),CAN_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 = .FALSE.

 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) = UORGCAP(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)

! ENDDO
 ENDIF

 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_XMAPUS(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 IMPORTS 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,IYR)

 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

 ! FILL 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

 

! --FACTORS 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) = MEXEXP_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 IMPORTS 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'ogsmimp'

 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)

 REAL*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(IYR)

 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

 

 ! SPLIT 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_NR
 MEXPRD(NR,IYR) = IEA_PRD(IYR) * &

 (PEMEX_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 ! FORECAST 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 ADJUSTMENTS

 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.03125-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,IYR))

 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 MEX

 
 IF (IYR.GE.YR2PEMEX+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 ARRAY

! (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 EXPORTS 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 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 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,MODYR+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_FLOW(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 NGMEX_INGM(year,EMEXPRD)

 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'

 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=SPPrc/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) * (SPPrcBPPrc)) 

 AFMASP(s,r,t) = FMASP(1,s,r,t) + (DMasp(1,s,r,t) * (SPPrcBPPrc))

 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) -

SFClag(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)

 enddo
 PrdA(r)=PrdA(r)+PrdE(r,t)

 enddo

 enddo

 do r=1,4

 EMEXPRD(r)=PrdA(r+NCREG)

 write(*,*) 'debug mex prd',emexprd(r),r,year

 enddo

 

 return

 end

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

=====

 Subroutine NGCAN_INGM

 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'

 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) * (SPPrcBPPrc)) 

 AFMASP(s,r,t) = FMASP(1,s,r,t) + (DMasp(1,s,r,t) * (SPPrcBPPrc))

 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)=reserves(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,CURIYR1)*(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) THEN
 AKPIP1 = 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 ALBERTA

! 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 TERMS 
 REAL*4 AVGFUT ! AVERAGE EXPECTED FUTURE PRICE (NEXT 3 

YEARS)

 REAL*4 FE_FUELADJ ! ADJUSTMENT IN PIPELINE FLOW TO ALBERTA 

WITH FE PIPELINE FUEL IMPROVEMENT SCENARIO

 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. ONCE2) 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) .AND. 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(MODYRLHISYR+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 (AKPIP1.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) NERVFAC = 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,CURIYR1)*(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,CURIYR2).GE.AKCOMPPRC )) THEN

! .AND. oOGWPRNG(MNUMOR,CURIYR2).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 ENDIF

 ENDIF

 ENDIF

 

 WRITE (NGUNIT,1010) MODYR,MINPRC,oOGWPRNG(MNUMOR,CURIYR1),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)

 RETURN

 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 EXP 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./

!--------------------------------------------

 JENDYR = 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. + ((REAL(MODYRLHISYR+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 value 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(MNUMOR,CURIYR-I) ! a04

 ENDDO

 MINPRC = MINPRC / FR_PPLNYR(2) ! a04

! IF ((oOGWPRNG(MNUMOR,CURIYR1)*(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 = NERVFAC - (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

 ENDIF
 IF (MDPIP1.EQ.0) THEN

! a04 IF ( (MINPRC.GE.MDCOMPPRC .AND. oOGWPRNG(MNUMOR,CURIYR1).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 PLANT 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 RTOVALUE
 REAL*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)

 SNGCOAL(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-2
 oQCLGAS(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

 oQCLGHP(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*(10**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 VARIABLE
 INTEGER*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 CORRESPONDS 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 NELSON 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 COST 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 battery 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 ! Benefits & 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-digit

 READ(NGMISC,*) CTG_INCBLD !notused ! USE CTG_PUCAP BELOW

 READ(NGMISC,*) CTG_DCLCAPCST ! decline rate on cap cost
 READ(NGMISC,*) CTG_DCLOPRCST !notused ! decline rate on 

operating cost

 READ(NGMISC,*) CTG_BASHHV ! 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 scfd)

 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)

 READ(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

 CTG_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 MMcf
 DO 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$ / cd 
 oMC_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

 FEDST_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_PRJLIFE ! 

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(REG) = 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 INVESTMENT 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,CURIYR)/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 

 IMPLICIT 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 BUILD
 REAL*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 ! NATIONAL 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) 

 ENDDO

 
 CUT=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 ! UPPER 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_BUILD*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 investment 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)**(MODYRCTG_BASYR)

 ! 

CTG_CSTADD expected = 0 for LP,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 mkt 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 CORRESPONDS 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,DNODES),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) = EWSPRCNCD(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 YR4 = LHISYR,JENDYR

 YR2 = YR4-IBASYR+1

 DO RG=1,DNODES

 PCLGASNG(RG,YR4)=oPCLGAS(NG_CENMAP(RG),YR2)

 ENDDO

 ENDDO
 RETURN

 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 JENDYR ! 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 = RTOVALUE('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)

 WRITE(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,(NORMPROF(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,<DNODES>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 ROUNDNUM
 

 REAL*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 

 END

 

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

! 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'

 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'

 include 'commrep'

 INTEGER*4 I,J
 oAKGTL_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:IJUMPYR) = 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:IJUMPYR) = 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_WPI055(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:IJUMPYR) = 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) = OGQANGTS(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)

 oOGRESNGON(:,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) = PGCELGR(:,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)

 oQGFCM(:,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:IJUMPYR) = 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)

 oRFQTDCRD(:,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:IJUMPYR) = 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) = oEQGCELGR(:,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:IJUMPYR) = 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:IJUMPYR) = 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)

 OGPRDNGOF(:,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:IJUMPYR) = 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)

 OGQNGEXP(:,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) = oOGWPRNG(:,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:IJUMPYR)

 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:IJUMPYR) = 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) = oQLPIN(:,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:IJUMPYR)

 RFQTDCRD(:,1:IJUMPYR) = oRFQTDCRD(:,1:IJUMPYR)

 SPGFELGR(:,1:IJUMPYR,:) = oSPGFELGR(:,1:IJUMPYR,:)

 SPGIELGR(:,1:IJUMPYR,:) = oSPGIELGR(:,1:IJUMPYR,:)

 SQGFELGR(:,1:IJUMPYR,:) = oSQGFELGR(:,1:IJUMPYR,:)

 SQGIELGR(:,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) = oNGSCRV_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:IJUMPYR,:) = 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