$NOFLOATCALLS C*********************************************************************** C SUBROUTINE DDDD C C*********************************************************************** C C -- THE ENERGY DEMAND MODULE -- C C THIS SUBROUTINE COMPUTES THE DEMAND FOR PRIMARY AND SECONDARY ENERGY C BY REGION AND SECTOR. C C C INTEGER INPUTS: M, NF, NFF, NI, NJ, NKKL, NKL, NKKMAX, NKMAX, NL, NM, C NU C C REAL INPUTS: BSJKLM, BSKL, ESIL, GIJ, GJ, GJK, GUI, C PJL, PJKL, PKL, RPJ, RPJK, RPK, RPKK, RYJ, RYJK, C RYKLT, RYKK, SCIL, SUIL, TESIL, YLM, ZLM C C REAL OUTPUTS: EDIKL, EDIL, EDRIKL, EFJKL, ESIL, FJKL, FJL, SJKL, SKL C C SUBROUTINES CALLED: NONE C C WRITTEN BY: C JAE EDMONDS LATEST REVISION: C 1 JANUARY 1982 1 SEPT 88 TO INCLUDE COMMON C C*********************************************************************** C C MAKE ALL REAL VARIABLES DOUBLE PRECISION C IMPLICIT REAL*8 (A-H,O-Z), INTEGER (I-N) C C COMMON BLOCKS $INCLUDE:'COMMON.FOR' C C LOCAL VARIABLES C REAL*8 E,FK(3),RATIO,RYK,RYKT(2),SHARE,SUM,T,TES,TT,X, & TECH INTEGER NK,NT C C +-----------------------------------------+ C ! INTERPOLATE INCOME ELASTICITY VALUES ! C +-----------------------------------------+ C NT=(M-1)*NJUMP T=NT TT=NJUMP DO 45 IT=1,2 FK(1)=RYKL(IT) IF(IT.EQ.1) FK(2)=RYKL(IT)*0.800D0 IF(IT.EQ.2) FK(2)=RYKL(IT)*0.714D0 FK(3)=100.D0 RYKT(IT)=XNTERP(FK(1),FK(2),FK(3),T)-1.D0 45 CONTINUE C C DO 150 L=1,NL NK=NKL(L) X=YLM(L,M)/(ZLM(L,M)/ZLM(L,1)) C C +------------------------------------------------------------+ C | CALCULATE FK, THE DEMAND FOR ENERGY SERVICES BY SECTOR K | C +------------------------------------------------------------+ DO 30 K=1,NK IF (NK-1) 10,10,20 10 CONTINUE IF(L .EQ. 4) RYK=RYKT(1) IF(L .NE. 4) RYK=RYKT(2) FK(K) = BSKL(K,L)*PKLM(K,L,M)**RPKL(K,L)*X**RYK*YLM(L,M) GO TO 30 20 FK(K)=BSKL(K,L)*PKLM(K,L,M)**RPKL(K,L)*X**RYKK(K) FK(K)=FK(K)*ZLM(K,M)/ZLM(L,1) IF(K.EQ.2) FK(K)=BSKL(K,L)*PKLM(K,L,M)**RPKL(K,L) IF(K.EQ.2) FK(K)=FK(K)*YLM(L,M)**RYKK(K) 30 CONTINUE C C COMPUTE NUMERATOR AND DENOMINATOR OF SJKL. C USE SJKL AS TEMPORARY NUMERATOR. C 39 DO 90 K=1,NK SUM=0.D0 DO 70 J=1,NJ IF(NK-1) 40,40,50 40 SJKL(J,K,L)=BSJKLM(J,K,L,M)*PJKLM(J,K,L,M)**RPJ(J)*X**RYJ(J) GO TO 60 50 SJKL(J,K,L)=BSJKLM(J,K,L,M)*PJKLM(J,K,L,M)**RPJK(J,K) & *X**RYJK(J,K) 60 SUM=SUM+SJKL(J,K,L) 70 CONTINUE DO 80 J=1,NJ SJKL(J,K,L)=SJKL(J,K,L)/SUM 80 CONTINUE 90 CONTINUE C C COMPUTE TOTAL FUEL DEMANDS C DO 140 J=1,NJ FJL(J,L)=0.D0 DO 130 K=1,NK TECH=(1.D0+TKL(K,L))**T FJKL(J,K,L)=SJKL(J,K,L)*FK(K)/TECH IF(NK-1) 100,100,110 100 FJKL(J,K,L)=FJKL(J,K,L)*GJ(J) GO TO 120 110 FJKL(J,K,L)=FJKL(J,K,L)*GJK(J,K) 120 FJL(J,L)=FJL(J,L)+FJKL(J,K,L) 130 CONTINUE 140 CONTINUE C 150 CONTINUE C DO 230 L=1,NL NK=NKL(L) NKK=NKKL(L) IF (NUB .EQ. 1) GO TO 151 C C C +----------------------------------------------------------+ C | REALIGN ELECTRIC UTILITY SHARES TO CONFORM TO SUPPLY | C | ASSUMPTIONS AND FINAL DEMAND LEVELS | C +----------------------------------------------------------+ IF (ESIL(NI,L) .GT. FJL(NJ,L)) ESIL(NI,L)=FJL(NJ,L) C=(1.D0-ESIL(NI,L)/FJL(NJ,L))/(1.D0-SUIL(NI,L)) DO 156 I=1,NU SUIL(I,L)=SUIL(I,L)*C 156 CONTINUE SUIL(NI,L)=ESIL(NI,L)/FJL(NJ,L) C C COMPUTE ELECTRIC UTILITY DEMANDS FOR FOSSIL FUELS C DO 160 I=1,NI ESUILM(I,L,M)=SUIL(I,L)*FJL(NJ,L) 160 CONTINUE SHARE=0.D0 E=0.D0 EFJKL(NJ,1,L)=0.D0 DO 170 I=1,NF EFJKL(I,1,L)=FJL(NJ,L)*SUIL(I,L)*GUI(I) EDRIKL(I,1,L)=EFJKL(I,1,L)*GIJ(I) EDRIL(I,L)=EDRIKL(I,1,L) E=E+EDRIKL(I,1,L) SHARE=SHARE+SUIL(I,L) 170 CONTINUE C +---------------------------------------+ C | COMPUTE PRIMARY EQUIVALENCE RATIO | C | FOR FOSSIL FUELS IN ELECTCITY | C +---------------------------------------+ IF (ESIL(NI,L)-FJL(NJ,L)) 175, 176, 176 175 RATIO=E/(SHARE*FJL(NJ,L)) GO TO 177 176 RATIO=1.D0 177 CONTINUE C C COMPUTE PRIMARY EQUIVALENCE FOR RENEWABLES C NN=NF+1 DO 180 I=NN,NI ESRILM(I,L,M)=FJL(NJ,L)*SUIL(I,L)*RATIO ESIL(I,L)=ESRILM(I,L,M) EDRIKL(I,1,L)=ESRILM(I,L,M) EDRIL(I,L)=EDRIKL(I,1,L) EDIKL(I,1,L)=EDRIKL(I,1,L) EDIL(I,L)=EDRIL(I,L) 180 CONTINUE C C C +------------------------------------------------------------------+ C | COMPUTE REFINABLE ENERGY DEMAND REQUIREMENTS FOR END-USE SECTORS | C +------------------------------------------------------------------+ C DO 220 K=1,NK KK=K+1 DO 200 I=1,NF J=I EFJKL(J,KK,L)=FJKL(J,K,L) EDRIKL(I,KK,L)=EFJKL(I,KK,L)*GIJ(I) EDRIL(I,L)=EDRIL(I,L)+EDRIKL(I,KK,L) 200 CONTINUE C C ASSIGN ELECTRICITY C EFJKL(NJ,KK,L)=FJKL(NJ,K,L) C C ALLOCATE ZERO PRIMARY ELECTRICITY TO DIRECT END USE C DO 210 I=NN,NI EDIKL(I,KK,L)=0.D0 EDRIKL(I,KK,L)=0.D0 210 CONTINUE 220 CONTINUE C GO TO 230 C C +-----------------------------------+ C | CONSERVATION AND NON-ELECTRIC | C | SOLAR CALCULATIONS | C +-----------------------------------+ C 151 CONTINUE C C COMPUTE FUEL TYPE SHARES BASED ON PERIOD ONE PRICES C FOR CONSERVATION AND NON-ELECTRIC SOLAR CALCULATIONS C SUIL(NI,L)=HYDRO(5,L) SUM=0.D0 DO 153 I=1,NU SUIL(I,L)=BSUILM(I,L,M)*PUILM(I,L,1)**RUI(I) SUM=SUM+SUIL(I,L) 153 CONTINUE C IF (TESIL(L) .GT. FJL(NJ,L)) TESIL(L)=FJL(NJ,L) C DO 154 I=1,NU SUIL(I,L)=(1.D0-(TESIL(L)/FJL(NJ,L)))*SUIL(I,L)/SUM 154 CONTINUE SUIL(NI,L)=TESIL(L)/FJL(NJ,L) C C COMPUTE DEMAND FOR SECONDARY FUELS C EFJKL(NJ,1,L)=0.D0 DO 163 I=1,NF EFJKL(I,1,L)=FJL(NJ,L)*SUIL(I,L)*GUI(I) 163 CONTINUE DO 164 K=1,NK KK=1+K DO 165 J=1,NF EFJKL(J,KK,L)=FJKL(J,K,L) 165 CONTINUE EFJKL(NJ,KK,L)=FJKL(NJ,K,L) 164 CONTINUE C 230 CONTINUE C RETURN END