C DR. Chris Elbers from Holland had given me some instruction on how to compute this model C while I was a MA Development Study Student at the Institute of Social Studies, Hague, Netherlands, 1989. c file 1 PROGRAM BASYEAR c IMPLICIT REAL (A-Z) C LOGICAL EQVEC,CLUSCV(4),RALLWD,EQUAL REAL CURPR(7),OLDPR(7),RHLP(7),OLDPX(4),XHLP(4),POW(8),CONS(8), 1 CURPX(4),OLDPT(12),OOLDPT(12),OLDPW,ODTR(12,10),GPX(11) INTEGER ITEL,ICLUS,I,IFIN,J,NOCONV,IFORC,K,IWAG C C include 'urbblk.for' c COMMON /URBBLK/ CALFUR(4),DLAURB(4),CAURB(4),EKURB(4),SWAGE(5), c 1 IOCO(18,4),UFOODX(11,7),UFOODR(7,7),UXLAB(7),UX17OS(7), c 2 UXDEP(7),DELTA(4),UVDEPR(4),PUPRIN(4),CUPRIN(18,4),UPRINV(4) C C include 'genblk.for' c COMMON /GENBLK/GRQR(7,7),SLOC(5,7),DIMSE(3,7),DCHEM(7),FDR(4,7), c 1 DMANR(7),AREA(7),PT(12),PR(7,9),PX(18,10),YREM(8),YX17PR, c 2 Y811PR,YTRANS(8),NOFHH(8),DX(18,10,10),DR(7,10,10),CBET(25), c 3 SR(7,10,10),SAVE(8),RINV(18,7),CINV(18,7),SX(12),CODEM(22,8), c 4 THETA(8),S1(8),S2(7),MUINV(7),PWAURB,YRDTRA,PVTBUD,CLOSS(5), c 5 DBUD(8),RINVPR(7),DTR(12,10),ST(12),DCONSD(21,8),CVFLAG(8) c 6 ,RALLWD(7,10,10),RESERV(100) C C include 'gblk.for' c COMMON /GBLK/GINV(18),HINV(18),GSNV(18),IINV(18),TINV(18), c 1 CONV(18),GOIRUR(7),GOIOTH(7),GOISOC,GOIIND,GOICON,GOITRA, c 2 GCSER(18),TAU(7),AVINTA(18),AVROTA(18),AVLOTA(18),PSI(3,7), c 3 PCH(7),GOIUR1(18),GOIUR2(18),GOVDEM(18),DTPTLO,DTPTFO,GLABCO, c 4 TRSUBS,TROPSS,TRILHH,FORAST,YGOVTO,GAMGOV(8),GOCON(18) C include 'trblk.for' c COMMON /TRBLK/ CATR(12),CALFTR(12),EKTR(12),DRDTR(12),XTR include 'glblk.for' c COMMON /GLBLK/ GVIRUR,GVISOC,GVIIND,GVITRA,GVICON,GVITOT, c 1 GVCOMM,AGINPT,AVTAX,GOSER,GVBUD,GVSER,IMDUIN,IMDURO, c 2 SAVSPL,PGSVC,LTAX,GOVEMP C C include 'blnblk.for' c COMMON XPRCN,SLAURB,IPRSVC,IPRTRA,SHRSR(7,10,10),SHRDR(7,10,10), c 1 SHRDX(18,10,10) C C XPRCN IS USED IN THE FUNCTIONS EQUAL, GRTR, LESS C REAL BLKURB(328),BLKGEN(5269),BLKG(321),BLKGL(18),BLKTR(49), 1 BLKBLN(4) C EQUIVALENCE (CATR(1),BLKTR(1)),(GRQR(1,1),BLKGEN(1)), 1 (GINV(1),BLKG(1)),(GVIRUR,BLKGL(1)),(CALFUR(1),BLKURB(1)), 2 (XPRCN,BLKBLN(1)) C DATA OOLDPT/12*0./,OLDPT/12*0./ C write(*,*) ' old price wt ?' read(*,*) owt c IFIN = 0 IWAG = 0 IFORC= 0 NOCONV = 0 C DO 4963 I = 1,8 POW(I) = 0.9 CONS(I) = 8. 4963 CONTINUE C CONS(1) = 3. CONS(3) = 3. CONS(8) = 5. C C CALL UNFRW(3,0) C C READ(81,*) XPRCN C WRITE(*,*) ' XPRCN IS ',XPRCN C C C INITIALIZING SHRDR,SHRSR,SRHDX C C C DO 1 K = 1,10 DO 1 J = 1,10 C DO 11 I = 1,7 SHRDR(I,J,K) = 0. SHRSR(I,J,K) = 0. 11 CONTINUE C DO 12 I = 1,18 12 SHRDX(I,J,K) = 0. C 1 CONTINUE C DO 2 I=1,7 SHRDR(I,3,1) = 1. SHRDR(I,5,2) = 1. SHRDR(I,7,4) = 1. C SHRSR(I,1,3) = 1. SHRSR(I,2,5) = 1. SHRSR(I,4,7) = 1. 2 CONTINUE C DO 25 I = 1,7 SHRDR(I,9,5) = 1. SHRDR(I,6,3) = 1. SHRDR(I,9,6) = 1. SHRDR(I,9,7) = 1. SHRDR(I,7,8) = 1. ZHLP = DR(I,9,5) + DR(I,6,5) IF (ZHLP .GT. 0.) THEN SHRDR(I,9,5) = DR(I,9,5) / ZHLP SHRDR(I,6,5) = DR(I,6,5) / ZHLP ENDIF ZHLP = DR(I,6,3) + DR(I,8,3) IF (ZHLP .GT. 0.) THEN SHRDR(I,6,3) = DR(I,6,3) / ZHLP SHRDR(I,8,3) = DR(I,8,3) / ZHLP ENDIF ZHLP = DR(I,3,8) + DR(I,7,8) IF (ZHLP .GT. 0.) THEN SHRDR(I,3,8) = DR(I,3,8) / ZHLP SHRDR(I,7,8) = DR(I,7,8) / ZHLP ENDIF ZHLP = DR(I,3,6) + DR(I,9,6) IF (ZHLP .GT. 0.) THEN SHRDR(I,3,6) = DR(I,3,6) / ZHLP SHRDR(I,9,6) = DR(I,9,6) / ZHLP ENDIF ZHLP = DR(I,8,7) + DR(I,9,7) IF (ZHLP .GT. 0.) THEN SHRDR(I,8,7) = DR(I,8,7) / ZHLP SHRDR(I,9,7) = DR(I,9,7) / ZHLP ENDIF 25 CONTINUE C DO 26 I = 1,7 SHRSR(I,5,9) = 1. SHRSR(I,3,6) = 1. SHRSR(I,6,9) = 1. SHRSR(I,7,9) = 1. SHRSR(I,8,7) = 1. ZHLP = SR(I,5,9) + SR(I,5,6) IF (ZHLP .GT. 0.) THEN SHRSR(I,5,9) = SR(I,5,9) / ZHLP SHRSR(I,5,6) = SR(I,5,6) / ZHLP ENDIF ZHLP = SR(I,3,6) + SR(I,3,8) IF (ZHLP .GT. 0.) THEN SHRSR(I,3,6) = SR(I,3,6) / ZHLP SHRSR(I,3,8) = SR(I,3,8) / ZHLP ENDIF ZHLP = SR(I,8,3) + SR(I,8,7) IF (ZHLP .GT. 0.) THEN SHRSR(I,8,3) = SR(I,8,3) / ZHLP SHRSR(I,8,7) = SR(I,8,7) / ZHLP ENDIF ZHLP = SR(I,6,3) + SR(I,6,9) IF (ZHLP .GT. 0.) THEN SHRSR(I,6,3) = SR(I,6,3) / ZHLP SHRSR(I,6,9) = SR(I,6,9) / ZHLP ENDIF ZHLP = SR(I,7,8) + SR(I,7,9) IF (ZHLP .GT. 0.) THEN SHRSR(I,7,8) = SR(I,7,8) / ZHLP SHRSR(I,7,9) = SR(I,7,9) / ZHLP ENDIF 26 CONTINUE C DO 3 I=13,17,2 SHRDX(I,3,1) = 1. SHRDX(I,5,2) = 1. SHRDX(I,7,4) = 1. SHRDX(I,9,5) = 1. SHRDX(I,9,6) = 1. SHRDX(I,9,7) = 1. SHRDX(I,6,3) = 1. SHRDX(I,7,8) = 1. ZHLP = DX(I,6,3) + DX(I,8,3) IF (ZHLP .GT. 0.) THEN SHRDX(I,6,3) = DX(I,6,3) / ZHLP SHRDX(I,8,3) = DX(I,8,3) / ZHLP ENDIF ZHLP = DX(I,3,8) + DX(I,7,8) IF (ZHLP .GT. 0.) THEN SHRDX(I,3,8) = DX(I,3,8) / ZHLP SHRDX(I,7,8) = DX(I,7,8) / ZHLP ENDIF 3 CONTINUE C DO 4 I=1,12 SHRDX(I,3,1) = 1. SHRDX(I,5,2) = 1. SHRDX(I,7,4) = 1. SHRDX(I,6,5) = 1. SHRDX(I,3,6) = 1. SHRDX(I,8,7) = 1. SHRDX(I,8,3) = 1. C C ZHLP = DX(I,6,3) + DX(I,8,3) IF (ZHLP .GT. 0.) THEN SHRDX(I,6,3) = DX(I,6,3) / ZHLP SHRDX(I,8,3) = DX(I,8,3) / ZHLP ENDIF ZHLP = DX(I,3,6) IF (ZHLP .GT. 0.) THEN SHRDX(I,3,6) = DX(I,3,6) / ZHLP ENDIF ZHLP = DX(I,8,7) IF (ZHLP .GT. 0.) THEN SHRDX(I,8,7) = DX(I,8,7) / ZHLP ENDIF 4 CONTINUE C C DO 5 I=14,18,2 SHRDX(I,3,1) = 1. SHRDX(I,5,2) = 1. SHRDX(I,7,4) = 1. SHRDX(I,6,5) = 1. SHRDX(I,3,6) = 1. SHRDX(I,8,7) = 1. SHRDX(I,8,3) = 1. C C ZHLP = DX(I,6,3) + DX(I,8,3) IF (ZHLP .GT. 0.) THEN SHRDX(I,6,3) = DX(I,6,3) / ZHLP SHRDX(I,8,3) = DX(I,8,3) / ZHLP ENDIF ZHLP = DX(I,3,6) IF (ZHLP .GT. 0.) THEN SHRDX(I,3,6) = DX(I,3,6) / ZHLP ENDIF ZHLP = DX(I,8,7) IF (ZHLP .GT. 0.) THEN SHRDX(I,8,7) = DX(I,8,7) / ZHLP ENDIF 5 CONTINUE C RESERV(5) = MIN( (CATR(3)**1.)*EKTR(3),(CATR(7)**1.)*EKTR(7) ) RESERV(6) = MIN( (CATR(6)**1.)*EKTR(6),(CATR(8)**1.)*EKTR(8) ) RESERV(7) = MIN( (CATR(11)**1.)*EKTR(11),(CATR(8)**1.)*EKTR(8) ) RESERV(8) = MIN( (CATR(10)**1.)*EKTR(10),(CATR(7)**1.)*EKTR(7), 1 (CATR(3)**1.)*EKTR(3) ) C C DO 1112 I=1,10 DO 1112 J=1,12 1112 ODTR(J,I) = DTR(J,I) C ITEL = 0 C DO 990 I=1,11 990 GPX(I) = PX(I,8) C C 99 CALL PXLOC C C ITEL = ITEL + 1 IF (MOD(ITEL,10).EQ.0) WRITE(*,*) ' MAIN ITERATION NUMBER ',ITEL C C FIRST CLUSTER IS 3-1 C c 777 continue c WRITE(*,*) ' CLUSTER 3-1 [',ITEL,']' C C 91 CONTINUE ICLUS = 0 CALL SHADJS(3) CALL CVECTK(7,9,PR,3,1,7,OLDPR) C CALL REGIO(POW(3),CONS(3),3) c 911 CALL CVECTK(7,9,PR,3,1,7,CURPR) CALL REGIO(POW(1),CONS(1),1) C CALL REGIO(POW(3),CONS(3),3) C C C CALL CVECTK(7,9,PR,3,1,7,RHLP) ICLUS = ICLUS + 1 IF ( .NOT. EQVEC(7,CURPR,RHLP).AND.(ICLUS .LT.10)) GOTO 911 C CLUSCV(1) = EQVEC(7,CURPR,OLDPR) CALL CHANGE(PR,OLDPR,3,owt) C C C WRITE(*,*) ' CLUSCV(1) IS ',CLUSCV(1) C C C C C C SECOND CLUSTER IS 7-4 C C 92 CONTINUE ICLUS = 0 CALL SHADJS(7) CALL CVECTK(7,9,PR,7,1,7,OLDPR) C CALL REGIO(POW(7),CONS(7),7) 921 CALL CVECTK(7,9,PR,7,1,7,CURPR) CALL REGIO(POW(4),CONS(4),4) CALL REGIO(POW(7),CONS(7),7) CALL CVECTK(7,9,PR,7,1,7,RHLP) ICLUS = ICLUS + 1 IF ( .NOT. EQVEC(7,CURPR,RHLP).AND.(ICLUS .LT.10)) GOTO 921 C CLUSCV(2) = EQVEC(7,CURPR,OLDPR) CALL CHANGE(PR,OLDPR,7,owt) C IF (MOD(ITEL,10).EQ.0) THEN WRITE(*,*) ' CLUSCV(2) IS ',CLUSCV(2) C ENDIF C C C C C THIRD CLUSTER IS 6-5-2 C C WRITE(*,*) ' STARTING CLUSTER 6-5-2' 93 CONTINUE ICLUS = 0 CALL SHADJS(6) CALL CVECTK(7,9,PR,6,1,7,OLDPR) C CALL REGIO(POW(6),CONS(6),6) 931 CALL CVECTK(7,9,PR,6,1,7,CURPR) CALL REGIO(POW(5),CONS(5),5) CALL REGIO(POW(2),CONS(2),2) CALL REGIO(POW(5),CONS(5),5) CALL REGIO(POW(6),CONS(6),6) CALL CVECTK(7,9,PR,6,1,7,RHLP) ICLUS = ICLUS + 1 IF ( .NOT. EQVEC(7,CURPR,RHLP).AND.(ICLUS .LT.10)) GOTO 931 C CLUSCV(3) = EQVEC(7,CURPR,OLDPR) CALL CHANGE(PR,OLDPR,6,owt) C WRITE(*,*) ' CLUSCV(3) IS ',CLUSCV(3) C C C C FOURTH CLUSTER IS URBAN REGION C C WRITE(*,*) ' STARTING CLUSTER 8' C OLPRCN = XPRCN C ICLUS = 0 CALL CVECTK(7,9,PR,8,1,7,OLDPR) CALL CVECTK(18,10,PX,8,8,11,OLDPX) 94 CONTINUE CALL SHADJS(8) CALL CVECTK(18,10,PX,8,8,11,CURPX) C OLDPW=PWAURB C C CALL DEPRCN CALL URBPRO CALL URBBUD CALL URBREG(POW(8),CONS(8)) CALL CHANGE(PR,OLDPR,8,owt) CALL CVECTK(18,10,PX,8,8,11,XHLP) ICLUS = ICLUS + 1 IF ( .NOT. EQVEC(4,XHLP,CURPX) 1 .AND. ( ICLUS.LT.20) ) GOTO 94 C CLUSCV(4) = EQVEC(4,CURPX,OLDPX) XPRCN = OLPRCN C C C C WRITE(*,*) ' CLUSCV(4) IS ',CLUSCV(4) C ENDIF C DLAURT = GOVEMP DO 521 I=1,4 DLAURT = DLAURT + DLAURB(I) 521 CONTINUE C ZHLP = GOVEMP DO 522 I=1,4 ZHLP = ZHLP + DLAURB(I) * (1./(1-CALFUR(I))) 522 CONTINUE ZHLP = ZHLP / DLAURT C C THE FOLLOWING LINES ARE NOT VALID FOR BASE YEAR RUN C C WTILDA = PWAURB * ((DLAURT/SLAURB)**(1/ZHLP)) C PWAURB = PWAURB + 0.05 * ( WTILDA - PWAURB ) C C C THE FOLLOWING LINE MUST BE REMOVED FOR A SIMULATION RUN C AND THE THREE LINES ABOVE MUST BE 'ON' C SLAURB = DLAURT C C C WRITE(*,'(11F6.3)') (DRDTR(I)/ST(I),I=1,11) WRITE(*,'(7F9.3)') (PR(I,8),I=1,7) C IF ( .NOT.(CLUSCV(1) .AND. 1 CLUSCV(2) .AND. CLUSCV(3) .AND. CLUSCV(4))) THEN IFIN = 0 C NOCONV = NOCONV + 1 C ELSE NOCONV = 0 IFIN = IFIN + 1 ENDIF IF (MOD(ITEL,20) .EQ. 0) CALL UNFRW(4,1) IF ((IFIN .LT.2 ) .OR. (ITEL .LT. 15)) THEN IF(ITEL.LT.500) GOTO 99 ENDIF C WRITE(*,*) ' IFIN > 1 ************* ' IFIN = 0 C C ADJUST TRANSPORTATION PRICES C OLPRCN = XPRCN XPRCN = 0.95 DO 47 J=1,11 OOLDPT(J) = PT(J) OLDPT(J) = PT(J) 47 CONTINUE c c c road nr. 6 erased 21/08/89 drdtr(6) = st(6) c IF (.NOT. EQVEC(11,DRDTR,ST) .AND.(ITEL .LT. 500) ) THEN DO 537 I=1,11 if (i .ne. 6) then PTILDA = (DRDTR(I)/ST(I)) * PT(I) IF (.NOT. EQUAL(PTILDA,PT(I)) ) 1 PT(I) = PT(I) + 0.20 * ( PTILDA - PT(I) ) endif 537 CONTINUE C CALL RFORC PT(5) = MAX(PT(5),ABS(PT(9)-PT(10))) C c road number 6 erased 21/08/89 c c drdtr(6) = 1. st(6) = 1. c C do 731 i=1,11 if (st(i) .eq. 0.) st(i) = 999. 731 continue c WRITE(*,'(11F7.3)') (DRDTR(I)/ST(I),I=1,11),(OLDPT(I),I=1,11), 1 (PT(I),I=1,11) C CALL PXLOC XPRCN = OLPRCN GOTO 99 ENDIF C CALL TRANCO C WRITE(11,'(7G11.5)') ((PR(I,J),I=1,7),J=1,8) WRITE(11,'(7G11.5)') (PX(I,8),I=1,11) CLOSE(11) C CALL UNFRW(4,1) C DO 5080 I=1,7 WRITE(*,*) ' REGION NR ',I WRITE(*,'(7F10.3)') (PR(J,I),J=1,7) 5080 CONTINUE C WRITE(*,*) ' REGION NR ',8 WRITE(*,'(7F10.3)') (PR(J,8),J=1,7) WRITE(*,'(4F10.3)') (PX(J,8),J=8,11) WRITE(*,'(1X,A11,F10.5,/)')' WAGES: ',PWAURB WRITE(*,'(1X,A11,F14.5,/)')' LABOUR: ',SLAURB WRITE(*,*) ' TRANSPORTATION PRICES' WRITE(*,'(6F10.5)') (PT(I),I=1,11) WRITE(*,*) ' TRANSPORTATION SUPPLY' WRITE(*,'(5F12.3,f14.1)') (ST(I),I=1,12) C CALL BNDCHK(2*(1.-XPRCN)) C WRITE(21,*) ' PX PRICES WERE ' WRITE(21,'(7F10.3)') (GPX(I),I=1,11) WRITE(21,*) ' PX PRICES NOW ' WRITE(21,'(7F10.3)') (PX(I,8),I=1,11) C STOP ' END OF BASEYEAR' END C C SUBROUTINE CHANGE(PNEW,POLD,IDIS,owt) C C C REAL PNEW(7,9),POLD(7) C IF (IDIS .GT. 8) STOP ' FAULT IN CHANGE CALL' DO 1 I=1,7 1 PNEW(I,IDIS) = owt * POLD(I) + (1.-owt) * PNEW(I,IDIS) C RETURN END c c c c cweg:=Arg "c writ" psearch ldelete up c cweg:alt+q c deol:=arg ldelete down c deol:ctrl+enter  c file 2 COMMON XPRCN,SLAURB,IPRSVC,IPRTRA,SHRSR(7,10,10),SHRDR(7,10,10), 1 SHRDX(18,10,10) c file 3 subroutine bndchk(tol) implicit real (a-z) c include 'genblk.for' include 'gblk.for' c integer i,j,k real s(12) character vok,hok*2,vnok,hnok*2,lp,rp character*2 ok7, ok12, ok5, ok4 character ok1, ok2, ok3, ok6, ok8, ok9, ok10, ok11 c c vok = '|' hok = '--' vnok = 'x' hnok = 'xx' lp = '(' rp = ')' c c R-goods c c c do 1010 j=1,7 write(*,*) 'R-good, nr. ', j write(*,*) s(1) = dr(j,1,3)+dr(j,3,1)+sr(j,1,3)+sr(j,3,1) s(2) = dr(j,2,5)+dr(j,5,2)+sr(j,2,5)+sr(j,5,2) s(3) = dr(j,6,3)+dr(j,3,6)+sr(j,6,3)+sr(j,3,6) s(4) = dr(j,4,7)+dr(j,7,4)+sr(j,4,7)+sr(j,7,4) s(5) = dr(j,5,6)+dr(j,6,5)+sr(j,5,6)+sr(j,6,5) s(6) = 1. s(7) = dr(j,3,8)+dr(j,8,3)+sr(j,3,8)+sr(j,8,3) s(8) = dr(j,7,8)+dr(j,8,7)+sr(j,7,8)+sr(j,8,7) s(9) = dr(j,9,5)+sr(j,5,9) s(10)= dr(j,9,6)+sr(j,6,9) s(11)= dr(j,9,7)+sr(j,7,9) s(12)= dr(j,8,10) c call isok(pr(j,1),pr(j,3),pt(1)*cbet(j),ok1,hok,1,tol) call isok(pr(j,2),pr(j,5),pt(2)*cbet(j),ok2,hok,1,tol) call isok(pr(j,3),pr(j,6),pt(3)*cbet(j),ok3,hok,1,tol) call isok(pr(j,4),pr(j,7),pt(4)*cbet(j),vok,ok4,0,tol) call isok(pr(j,5),pr(j,6),pt(5)*cbet(j),vok,ok5,0,tol) call isok(pr(j,8),pr(j,3),pt(7)*cbet(j),vok,ok7,0,tol) call isok(pr(j,8),pr(j,7),pt(8)*cbet(j),ok8,hok,1,tol) call isok(pr(j,5),pr(j,9),pt(9)*cbet(j),ok9,hok,1,tol) call isok(pr(j,6),pr(j,9),pt(10)*cbet(j),ok10,hok,1,tol) call isok(pr(j,7),pr(j,9),pt(11)*cbet(j),ok11,hok,1,tol) call isok(pr(j,8),pr(j,10),pt(12)*cbet(j),vok,ok12,0,tol) c write(*,1) pr(j,1) write(*,29) ok1 write(*,1) pt(1)*cbet(j) write(*,6) lp,s(1),rp write(*,29) ok1 c write(*,10) pr(j,2),pr(j,3),ok7,pt(7)*cbet(j),ok7, 1 pr(j,8),ok12,pt(12)*cbet(j),ok12,pr(j,10) c write(*,11) ok2,ok3,lp,s(7),rp,ok8,lp,s(12),rp write(*,1218) ok2,ok3,ok8 write(*,14) pt(2)*cbet(j),pt(3)*cbet(j),pt(8)*cbet(j) write(*,15) lp,s(2),rp,lp,s(3),rp,lp,s(8),rp write(*,1218) ok2,ok3,ok8 c write(*,19) pr(j,5),ok5,pt(5)*cbet(j),ok5,pr(j,6),pr(j,7),ok4, 1 pt(4)*cbet(j),ok4,pr(j,4) write(*,20) ok9,lp,s(5),rp,ok10,ok11,lp,s(4),rp write(*,1218) ok9,ok10,ok11 write(*,14) pt(9)*cbet(j),pt(10)*cbet(j),pt(11)*cbet(j) write(*,15) lp,s(9),rp,lp,s(10),rp,lp,s(11),rp write(*,1218) ok9,ok10,ok11 c write(*,28) pr(j,9),pr(j,9),pr(j,9) write(*,*) write(*,*) 1010 continue c c c X-goods c c c do 1111 j=1,18 if (.not. ((j .eq. 12) .or. (j.eq. 6) .or. (j.eq.7))) then c write(*,*) 'X-good, nr. ', j write(*,*) s(1) = dx(j,1,3)+dx(j,3,1) s(2) = dx(j,2,5)+dx(j,5,2) s(3) = dx(j,6,3)+dx(j,3,6) s(4) = dx(j,4,7)+dx(j,7,4) s(5) = dx(j,5,6)+dx(j,6,5) s(6) = 1. s(7) = dx(j,3,8)+dx(j,8,3) s(8) = dx(j,7,8)+dx(j,8,7) s(9) = dx(j,9,5) s(10)= dx(j,9,6) s(11)= dx(j,9,7) s(12)= dx(j,8,10) c call isok(px(j,1),px(j,3),pt(1)*cbet(j+7),ok1,hok,1,tol) call isok(px(j,2),px(j,5),pt(2)*cbet(j+7),ok2,hok,1,tol) call isok(px(j,3),px(j,6),pt(3)*cbet(j+7),ok3,hok,1,tol) call isok(px(j,4),px(j,7),pt(4)*cbet(j+7),vok,ok4,0,tol) call isok(px(j,5),px(j,6),pt(5)*cbet(j+7),vok,ok5,0,tol) call isok(px(j,8),px(j,3),pt(7)*cbet(j+7),vok,ok7,0,tol) call isok(px(j,8),px(j,7),pt(8)*cbet(j+7),ok8,hok,1,tol) c c note that avinta(j) and avrota(j) are supposed te equal 0. for c irrelevant values of j c call isok(px(j,5),px(j,9)*(1.+avinta(j)),pt(9)*cbet(j+7), 1 ok9,hok,1,tol) call isok(px(j,6),px(j,9)*(1.+avinta(j)),pt(10)*cbet(j+7), 1 ok10,hok,1,tol) call isok(px(j,7),px(j,9)*(1.+avinta(j)),pt(11)*cbet(j+7), 1 ok11,hok,1,tol) call isok(px(j,8),px(j,10)*(1.+avrota(j)),pt(12)*cbet(j+7), 1 vok,ok12,0,tol) c write(*,1) px(j,1) write(*,29) ok1 write(*,1) pt(1)*cbet(j) write(*,6) lp,s(1),rp write(*,29) ok1 c write(*,10) px(j,2),px(j,3),ok7,pt(7)*cbet(j),ok7, 1 px(j,8),ok12,pt(12)*cbet(j),ok12,px(j,10) c write(*,11) ok2,ok3,lp,s(7),rp,ok8,lp,s(12),rp write(*,1218) ok2,ok3,ok8 write(*,14) pt(2)*cbet(j),pt(3)*cbet(j),pt(8)*cbet(j) write(*,15) lp,s(2),rp,lp,s(3),rp,lp,s(8),rp write(*,1218) ok2,ok3,ok8 c write(*,19) px(j,5),ok5,pt(5)*cbet(j),ok5,px(j,6),px(j,7),ok4, 1 pt(4)*cbet(j),ok4,px(j,4) if ((j.eq.13) .or. (j.eq.15) .or. (j.eq.17)) then c write(*,20) ok9,lp,s(5),rp,ok10,ok11,lp,s(4),rp write(*,1218) ok9,ok10,ok11 write(*,14) pt(9)*cbet(j),pt(10)*cbet(j),pt(11)*cbet(j) write(*,15) lp,s(9),rp,lp,s(10),rp,lp,s(11),rp write(*,1218) ok9,ok10,ok11 c write(*,28) px(j,9),px(j,9),px(j,9) endif write(*,*) write(*,*) endif 1111 continue c c c c c c c 1 format(22x,f7.2) 29 format(25x,a1) c c5 = format 1 c 6 format(21x,a1,f7.2,a1) 10 format(4x,f7.2,11x,2(f7.2,a2,f7.2,a2),f7.2) 11 format(7x,a1,17x,a1,3x,1x,a1,f7.2,a1,1x,3x,a1,3x,1x,a1,f7.2,a1) 1218 format(7x,3(a1,17x)) c 14 format(4x,3(f7.2,11x)) c 15 format(3x,3(a1,f7.2,a1,9x)) c 19 format(4x,f7.2,a2,f7.2,a2,f7.2,11x,f7.2,a2,f7.2,a2,f7.2) 20 format(7x,a1,3x,1x,a1,f7.2,a1,1x,3x,a1,3x,14x,a1,4x,a1,f7.2,a1) c c2127 = format 1218 c24 = format 14 c25 = format 15 28 format(4x,3(f7.2,11x)) c c return end c c subroutine isok(p1,p2,pt,vok,hok,n,tol) character vok,hok*2 if (n .eq.1) then if ( abs(p1-p2) .gt. (pt+tol) ) then vok = 'x' else vok = '|' endif else if ( abs(p1-p2) .gt. (pt+tol) ) then hok = 'xx' else hok = '--' endif endif return end c file 4 COMMON /GBLK/GINV(18),HINV(18),GSNV(18),IINV(18),TINV(18), 1 CONV(18),GOIRUR(7),GOIOTH(7),GOISOC,GOIIND,GOICON,GOITRA, 2 GCSER(18),TAU(7),AVINTA(18),AVROTA(18),AVLOTA(18),PSI(3,7), 3 PCH(7),GOIUR1(18),GOIUR2(18),GOVDEM(18),DTPTLO,DTPTFO,GLABCO, 4 TRSUBS,TROPSS,TRILHH,FORAST,YGOVTO,GAMGOV(8),GOCON(18) c file 5 COMMON /GENBLK/GRQR(7,7),SLOC(5,7),DIMSE(3,7),DCHEM(7),FDR(4,7), 1 DMANR(7),AREA(7),PT(12),PR(7,9),PX(18,10),YREM(8),YX17PR, 2 Y811PR,YTRANS(8),NOFHH(8),DX(18,10,10),DR(7,10,10),CBET(25), 3 SR(7,10,10),SAVE(8),RINV(18,7),CINV(18,7),SX(12),CODEM(22,8), 4 THETA(8),S1(8),S2(7),MUINV(7),PWAURB,YRDTRA,PVTBUD,CLOSS(5), 5 DBUD(8),RINVPR(7),DTR(12,10),ST(12),DCONSD(21,8),CVFLAG(8) 6 ,RALLWD(7,10,10),RESERV(100) C file 6 COMMON /GLBLK/ GVIRUR,GVISOC,GVIIND,GVITRA,GVICON,GVITOT, 1 GVCOMM,AGINPT,AVTAX,GOSER,GVBUD,GVSER,IMDUIN,IMDURO, 2 SAVSPL,PGSVC,LTAX,GOVEMP C file 7 PROGRAM SAM C IMPLICIT REAL (A-Z) C LOGICAL EQVEC,CLUSCV(4),RALLWD REAL CURPR(7),OLDPR(7),RHLP(7),OLDPX(4),XHLP(4),POW(8),CONS(8), 1 CURPX(4),SMX(40,40),V1(18),V2(18),V3(18),CSUM(40),RSUM(40) INTEGER I,J,K,I1,J1,K1,IGD C CHARACTER KAR C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' include 'blnblk.for' include 'glblk.for' c REAL BLKURB(328),BLKGEN(5169),BLKG(321),BLKGL(18),BLKTR(49), 1 BLKBLN(4) C EQUIVALENCE (CATR(1),BLKTR(1)),(GRQR(1,1),BLKGEN(1)), 1 (GINV(1),BLKG(1)),(GVIRUR,BLKGL(1)),(CALFUR(1),BLKURB(1)), 2 (IPRCON,BLKBLN(1)) C CALL UNFRW(3,0) DO 1 I=1,40 DO 1 J=1,40 SMX(J,I) = 0. 1 CONTINUE C C DO 1000 IGD = 1,7 CALL RVECTK(7,10,PR,IGD,1,9,V1) IF (IGD .LE. 5) THEN CALL RVECTK(5,7,SLOC,IGD,1,7,V2) CALL VECVEC(7,V1,V2,SMX(IGD,IGD)) ENDIF V1(10) = PR(IGD,8)+CBET(IGD)*PT(12) C DO 101 I = 1,7 IF (IGD .LE. 5) THEN SMX(I+25,IGD) = PR(IGD,I)*(GRQR(IGD,I) - SLOC(IGD,I)) ELSE SMX(I+25,IGD) = PR(IGD,I)*GRQR(IGD,I) ENDIF C 101 CONTINUE C DO 102 J=1,8 DO 103 K=1,10 C C V1 BEVAT DE PRIJZEN PR(IGD,I) C SMX(34,IGD) = SMX(34,IGD)+(V1(J)-V1(K))* 1 (DR(IGD,K,J)+SR(IGD,K,J)) C 103 CONTINUE 102 CONTINUE C DO 104 J = 5,7 SMX(37,IGD)=SMX(37,IGD)+V1(9)*(DR(IGD,9,J)+SR(IGD,9,J)) 104 CONTINUE C C NOW RECEIPTS C IF (IGD .LE. 4) THEN CALL RVECTK(4,7,FDR,IGD,1,7,V2) CALL VECVEC(7,V1,V2,SMX(IGD,7)) ENDIF C DO 105 J=1,7 SMX(IGD,7+J)=PR(IGD,8)*UFOODR(IGD,J)*SX(J) 105 CONTINUE C DO 106 J=8,11 SMX(IGD,7+J)=PR(IGD,8)*IOCO(IGD,J-7)*SX(J) 106 CONTINUE C DO 107 J=1,8 SMX(IGD,25+J) = V1(J)*DCONSD(IGD,J) 107 CONTINUE C A = 0. DO 108 J = 5,7 A = A + V1(J)*(DR(IGD,J,9)+SR(IGD,J,9)) 108 CONTINUE C SMX(IGD,39) = A C SMX(IGD,40) = V1(8)*(DR(IGD,8,10)+SR(IGD,8,10)) C 1000 CONTINUE C DO 2 I=1,7 DO 2 J=1,4 SMX(25+I,7) = SMX(25+I,7)-PR(J,I)*FDR(J,I) 2 CONTINUE C TMANR = 0. DO 3009 I=1,7 SMX(15,25+I) = DMANR(I)*PX(8,I) TMANR = TMANR + DMANR(I)*PX(8,I) 3009 CONTINUE C SMX(17,34)=PX(10,8)*XTR C DO 3000 IGD = 1,14 DO 300 J=1,8 SMX(IGD+7,J+25) = SMX(IGD+7,J+25)+PX(IGD,J)*DCONSD(IGD+7,J) 300 CONTINUE 3000 CONTINUE C DO 3001 IGD=8,18 DO 301 J=1,7 SMX(IGD+7,J+7) = PX(IGD,8)*UFOODX(IGD-7,J)*SX(J) 301 CONTINUE C DO 302 J=8,11 SMX(IGD+7,J+7) = PX(IGD,8)*IOCO(IGD,J-7)*SX(J) 302 CONTINUE C 3001 CONTINUE C DO 3002 IGD=1,18 SMX(IGD+7,35) = PX(IGD,8)*GOCON(IGD) C A = PX(IGD,8)*GOIUR1(IGD) DO 303 J=1,7 A = A + PX(IGD,J)*GOIRUR(J)*GINV(IGD) 303 CONTINUE SMX(IGD+7,36) = A C A = PX(IGD,8)*GOIUR2(IGD) DO 304 J=1,7 A = A + PX(IGD,J)*GOIOTH(J)*HINV(IGD) 304 CONTINUE SMX(IGD+7,37) = A C A = 0. DO 305 J=1,7 A = A + PX(IGD,J)*RINV(IGD,J) 305 CONTINUE DO 306 K = 1,4 A = A + PX(IGD,8)*CUPRIN(IGD,K)*UPRINV(K) 306 CONTINUE SMX(IGD+7,38) = A C A = 0. DO 307 J=5,7 A = A + PX(IGD,J)*DX(IGD,J,9) 307 CONTINUE SMX(IGD+7,39) = A C SMX(IGD+7,40) = PX(IGD,8)*DX(IGD,8,10) C 3002 CONTINUE C NOW RECEIPTS C DO 3004 IGD=1,18 A = 0. DO 309 J=1,8 DO 309 K=1,10 A = A+(PX(IGD,J)-PX(IGD,K))*DX(IGD,K,J) 309 CONTINUE SMX(34,IGD+7)=A 3004 CONTINUE C DO 3003 IGD=1,12 A = PX(IGD,8)*SX(IGD) SMX(35,IGD+7) = AVLOTA(IGD)*A DO 308 J=1,40 A = A - SMX(J,IGD+7) 308 CONTINUE SMX(33,IGD+7) = A + SMX(34,IGD+7) 3003 CONTINUE C DO 400 IGD=13,17,2 A = 0. DO 401 J=5,7 A = A + PX(IGD,9)*DX(IGD,9,J) 401 CONTINUE SMX(37,IGD+7) = A SMX(35,IGD+7) = AVINTA(IGD)*A SMX(34,IGD+7) = SMX(34,IGD+7) - SMX(35,IGD+7) 400 CONTINUE C DO 402 IGD=14,18,2 SMX(38,IGD+7) = PX(IGD,10)*DX(IGD,10,8) SMX(35,IGD+7) = AVROTA(IGD)*SMX(38,IGD+7) SMX(34,IGD+7) = SMX(34,IGD+7) - SMX(35,IGD+7) 402 CONTINUE C C TRANSFERS BETWEEN AGENTS C C DO 500 J=1,8 SMX(25+J,33) = THETA(J)*(YX17PR+Y811PR+YRDTRA) SMX(25+J,35) = GAMGOV(J)*YGOVTO+YTRANS(J) SMX(25+J,40) = YREM(J) SMX(36,25+J) = SAVE(J) 500 CONTINUE SMX(33,34) = YRDTRA C SMX(33,35) = SMX(33,35) + DTPTLO + TROPSS C A = 0. DO 502 I=1,7 A = A + CBET(I)*( PT( 9)*(DR(I,5,9)+SR(I,5,9)) 1 +PT(10)*(DR(I,6,9)+SR(I,6,9)) 2 +PT(11)*(DR(I,7,9)+SR(I,7,9)) ) 502 CONTINUE DO 503 I=1,18 A = A + CBET(I+7)*( PT( 9)*DX(I,5,9) 1 +PT(10)*DX(I,6,9) 2 +PT(11)*DX(I,7,9) ) 503 CONTINUE SMX(34,39) = A C A = 0 DO 504 I=1,7 A = A + CBET(I)*PT(12)*(DR(I,8,10)+SR(I,8,10)) 504 CONTINUE DO 505 I=1,18 A = A + CBET(I+7)*PT(12)*DX(I,8,10) 505 CONTINUE C SMX(34,40) = A C TOTSMS = 0. TOTSMC = 0. C DO 506 I=1,7 A = 0. DO 507 J=1,3 A = A + PSI(J,I)*DIMSE(J,I) TOTSMS = TOTSMS + PSI(J,I)*DIMSE(J,I) 507 CONTINUE A = A + PCH(I)*DCHEM(I) + TAU(I)*AREA(I) TOTSMC = TOTSMC + PCH(I) * DCHEM(I) C SMX(35,25+I) = A 506 CONTINUE C SMX(35,40) = FORAST C SMX(38,35) = DTPTFO C WRITE(*,*) WRITE(*,'(3A10)') 'GOOD','COLUMN','ROW' DO 2000 IGD = 1,40 RSUM(IGD) = 0. CSUM(IGD) = 0. DO 2001 J=1,40 RSUM(IGD)=RSUM(IGD)+SMX(IGD,J) CSUM(IGD)=CSUM(IGD)+SMX(J,IGD) 2001 CONTINUE C WRITE(*,'(I4,2F10.3)') IGD,CSUM(IGD),RSUM(IGD) 2000 CONTINUE C C OPEN(10,FILE=' ',STATUS='OLD') C REWIND(10) DO 2002 I=1,40 WRITE(15,'(10F10.3)') (SMX(I,J),J=1,20) 2002 CONTINUE C DO 2003 I=1,40 WRITE(15,'(10F10.3)') (SMX(I,J),J=21,40) 2003 CONTINUE C C WRITE(15,*) WRITE(15,*) TOTSMS WRITE(15,*) TOTSMC WRITE(15,*) RESERV(20) WRITE(15,*) TMANR WRITE(15,*) GOVEMP*SWAGE(5)*PWAURB CLOSE(15) C call lotfor(smx,totsms,totsmc,reserv(20),tmanr, 1 govemp*swage(5)*pwaurb) END c subroutine LOTFOR(m,dc84,dc85,dc86,dc87,dc88) REAL M(40,40),R(22,20),V(40,20),HLP21(6),HLP22(7),XTOT,YTOT, 1 ZTOT,VTOT,WTOT,AATOT,HLP71(2),HLP72(2),HLP74(4),HLP75(4), 2 HLP711(4),HLP91,HLP121(2),HLP122(2),HLP132(2),HLP141(5), 3 HLP142,h(10),h1(3),CASHINV C DATA R/440*0./ DATA HLP21/6*0./, h/10*0./, h1/3*0./ DATA HLP22/7*0./ DATA HLP71/2*0./ DATA HLP72/2*0./ DATA HLP75/4*0./ DATA HLP74/4*0./ DATA HLP711/4*0./ DATA HLP121/2*0./ DATA HLP122/2*0./ DATA HLP132/2*0./ DATA HLP141/5*0./ c HLP91=0. HLP142=0. XTOT=0. C WRITE (*,'(F10.3)') XTOT YTOT=0. C WRITE (*,'(F10.3)') YTOT VTOT=0. WTOT=0. ZTOT=0. AATOT=0. HLP3=0. CASHINV=227. C c c c DO 3 I=1,40 c READ(8,*)(V(I,J),J=1,20) c c DO 333 J=1,20 c M(I,J)=V(I,J) c 333 CONTINUE c C WRITE(*,*)(M(I,J),J=1,20) c c 3 CONTINUE c c DO 4 I=1,40 c READ(8,*)(V(I,J),J=1,20) c c DO 444 J=1,20 c M(I,J+20)=V(I,J) c 444 CONTINUE c c 4 CONTINUE c M(33,33)=0. c c READ(8,*) DC84 c READ(8,*) DC85 c READ(8,*) DC86 c READ(8,*) DC87 c READ(8,*) DC88 c M(35,33)=DC86 C DO 900 I=1,40 YTOT=YTOT+M(I,23) C WRITE (*,'(F10.3)') YTOT XTOT=XTOT+M(I,22) C WRITE (*,'(F10.3)') XTOT VTOT=VTOT+M(I,20) WTOT=WTOT+M(I,21) ZTOT=ZTOT+M(I,24) AATOT=AATOT+M(I,25) 900 CONTINUE c C computation of first row of R C DO 5 I=1,4 DO 6 J=1,4 R(1,1)=M(I,J)+R(1,1) 6 CONTINUE c DO 7 J=5,7 R(1,2)=M(I,J)+R(1,2) 7 CONTINUE c R(1,3)=M(I,15)+R(1,3) DO 8 J=8,11 R(1,4)=M(I,J)+R(1,4) 8 CONTINUE c DO 9 J=12,14 R(1,5)=M(I,J)+R(1,5) 9 CONTINUE c R(1,6)=M(I,16)+R(1,6) R(1,8)=M(I,18)+R(1,8) R(1,9)=M(I,35)+R(1,9) R(1,7)=M(I,17)+R(1,7) c DO 10 J=26,33 R(1,11)=M(I,J)+R(1,11) 10 CONTINUE c R(1,13)=M(I,38)+R(1,13) R(1,14)=M(I,36)+R(1,14) R(1,15)=M(I,37)+R(1,15) R(1,17)=M(I,39)+R(1,17) R(1,18)=M(I,40)+R(1,18) c 5 CONTINUE c r(1,17) = r(1,17) R(1,7)=R(1,7)+R(1,9) c DO 11 J=1,9 R(1,10)=R(1,10)+R(1,J) 11 CONTINUE C R(1,16)=R(1,17)+R(1,18) c DO 12 J=11,16 R(1,19)=R(1,19)+R(1,J) 12 CONTINUE c R(1,20)=R(1,10)+R(1,19) c C second row of R C DO 14 J=1,4 c DO 13 I=5,7 HLP21(1)=HLP21(1)+M(I,J) 13 CONTINUE c HLP21(3)=HLP21(3)+M(37,J) HLP21(4)=HLP21(4)+M(22,J) HLP21(5)=HLP21(5)+M(38,J) HLP21(6)=HLP21(6)+M(23,J) c 14 CONTINUE c HLP21(2)=875./(9802.-205.) HLP21(3)=R(1,20)-HLP21(3) HLP21(4)=HLP21(4)*M(37,22)/XTOT HLP21(6)=HLP21(6)*M(38,23)/YTOT C c R(2,1)=HLP21(1)+HLP21(2)*HLP21(3)-HLP21(4)-HLP21(5)-HLP21(6) c DO 15 J=5,7 c DO 16 I=5,7 HLP22(1)=HLP22(1)+M(I,J) 16 CONTINUE c HLP22(2)=HLP22(2)+M(37,J) HLP22(3)=HLP22(3)+M(22,J) HLP22(4)=HLP22(4)+M(38,J) HLP22(5)=HLP22(5)+M(23,J) c DO 17 I=26,32 HLP22(6)=HLP22(6)+M(I,J) 17 CONTINUE c HLP22(7)=HLP22(7)+M(35,J) c 15 CONTINUE c R(2,2)=HLP22(1)*1.024+0.024*(R(1,2)+HLP22(2)+HLP22(3)*M(37,22)/ 1 XTOT+HLP22(4)+HLP22(5)*M(38,23)/YTOT+HLP22(6)+HLP21(2)* 2 (HLP21(3)-HLP21(4)-HLP21(5)-HLP21(6))+227+HLP22(7)) c DO 18 I=5,7 c R(2,3)=R(2,3)+M(I,15) c DO 19 J=8,11 R(2,4)=R(2,4)+M(I,J) 19 CONTINUE c DO 20 J=12,14 R(2,5)=R(2,5)+M(I,J) 20 CONTINUE c R(2,6)=R(2,6)+M(I,16) R(2,7)=R(2,7)+M(I,17) R(2,8)=R(2,8)+M(I,18) R(2,9)=R(2,9)+M(I,35) c DO 21 J=26,33 R(2,11)=R(2,11)+M(I,J) 21 CONTINUE c R(2,13)=R(2,13)+M(I,38) R(2,14)=R(2,14)+M(I,36) R(2,15)=R(2,15)+M(I,37) R(2,17)=R(2,17)+M(I,39) R(2,18)=R(2,18)+M(I,40) c 18 CONTINUE c R(2,13)=R(2,13)+227 R(2,7)=R(2,7)+R(2,9) r(2,17) = r(2,17) c DO 22 J=1,9 R(2,10)=R(2,10)+R(2,J) 22 CONTINUE c R(2,16)=R(2,17)+R(2,18) c DO 23 J=11,16 R(2,19)=R(2,19)+R(2,J) 23 CONTINUE c R(2,20)=R(2,19)+R(2,10) c C BEREKENING VAN DE DERDE REGEL VAN R C R(3,1)=22.0/71.0*DC87 R(3,2)=49.0/71.0*DC87 R(3,3)=M(15,15) DO 24 J=8,11 R(3,4)=R(3,4)+M(15,J) 24 CONTINUE DO 25 J=12,14 R(3,5)=R(3,5)+M(15,J) 25 CONTINUE R(3,6)=M(15,16) R(3,7)=M(15,17) R(3,8)=M(15,18) R(3,9)=M(15,35) DO 26 J=1,9 R(3,10)=R(3,J)+R(3,10) 26 CONTINUE DO 27 J=26,33 HLP3=HLP3+M(15,J) 27 CONTINUE R(3,11)=HLP3-R(3,1)-R(3,2) R(3,12)=0 R(3,13)=M(15,38) R(3,14)=M(15,36) R(3,15)=M(15,37) R(3,17)=M(15,39) R(3,18)=M(15,40) R(3,16)=R(3,17)+R(3,18) DO 28 J=11,16 R(3,19)=R(3,19)+R(3,J) 28 CONTINUE R(3,20)=R(3,10)+R(3,19) C BEREKENING VAN DE VIERDE REGEL VAN R C DO 30 I=8,11 DO 31 J=1,4 R(4,1)=R(4,1)+M(I,J) 31 CONTINUE DO 32 J=5,7 R(4,2)=R(4,2)+M(I,J) 32 CONTINUE R(4,3)=R(4,3)+M(I,15) DO 33 J=8,11 R(4,4)=R(4,4)+M(I,J) 33 CONTINUE DO 34 J=12,14 R(4,5)=R(4,5)+M(I,J) 34 CONTINUE R(4,6)=R(4,6)+M(I,16) R(4,7)=R(4,7)+M(I,17) R(4,8)=R(4,8)+M(I,18) R(4,9)=R(4,9)+M(I,35) DO 35 J=26,33 R(4,11)=R(4,11)+M(I,J) 35 CONTINUE R(4,13)=R(4,13)+M(I,38) R(4,14)=R(4,14)+M(I,36) R(4,15)=R(4,15)+M(I,37) R(4,17)=R(4,17)+M(I,39) R(4,18)=R(4,18)+M(I,40) 30 CONTINUE R(4,16)=R(4,17)+R(4,18) DO 36 J=1,9 R(4,10)=R(4,J)+R(4,10) 36 CONTINUE DO 37 J=11,16 R(4,19)=R(4,19)+R(4,J) 37 CONTINUE R(4,20)=R(4,10)+R(4,19) C C BEREKENIG VAN DE VIJFDE REGEL VAN R C DO 38 I=12,14 DO 39 J=1,4 R(5,1)=R(5,1)+M(I,J) 39 CONTINUE DO 40 J=5,7 R(5,2)=R(5,2)+M(I,J) 40 CONTINUE R(5,3)=R(5,3)+M(I,15) DO 41 J=8,11 R(5,4)=R(5,4)+M(I,J) 41 CONTINUE DO 42 J=12,14 R(5,5)=R(5,5)+M(I,J) 42 CONTINUE R(5,6)=R(5,6)+M(I,16) R(5,7)=R(5,7)+M(I,17) R(5,8)=R(5,8)+M(I,18) R(5,9)=R(5,9)+M(I,35) DO 43 J=26,33 R(5,11)=R(5,11)+M(I,J) 43 CONTINUE R(5,13)=R(5,13)+M(I,38) R(5,14)=R(5,14)+M(I,36) R(5,15)=R(5,15)+M(I,37) R(5,17)=R(5,17)+M(I,39) R(5,18)=R(5,18)+M(I,40) 38 CONTINUE R(5,16)=R(5,17)+R(5,18) DO 44 J=1,9 R(5,10)=R(5,10)+R(5,J) 44 CONTINUE DO 45 J=11,16 R(5,19)=R(5,19)+R(5,J) 45 CONTINUE R(5,20)=R(5,19)+R(5,10) C C BEREKENING VAN DE ZESDE REGEL VAN R C DO 47 J=1,4 R(6,1)=R(6,1)+M(16,J) 47 CONTINUE DO 48 J=5,7 R(6,2)=R(6,2)+M(16,J) 48 CONTINUE R(6,3)=M(16,15) DO 49 J=8,11 R(6,4)=R(6,4)+M(16,J) 49 CONTINUE DO 500 J=12,14 R(6,5)=M(6,5)+M(16,J) 500 CONTINUE R(6,6)=M(16,16) R(6,7)=M(16,17) R(6,8)=M(16,18) R(6,9)=M(16,35) DO 510 J=26,33 R(6,11)=R(6,11)+M(16,J) 510 CONTINUE R(6,13)=M(16,38) R(6,14)=M(16,36) R(6,15)=M(16,37) R(6,17)=M(16,39) R(6,18)=M(16,40) R(6,16)=R(6,17)+R(6,18) DO 520 J=1,9 R(6,10)=R(6,10)+R(6,J) 520 CONTINUE DO 530 J=11,16 R(6,19)=R(6,19)+R(6,J) 530 CONTINUE R(6,20)=R(6,19)+R(6,10) C BEREKENING VAN DE ZEVENDE REGEL VAN R C DO 50 J=1,4 HLP71(1)=HLP71(1)+M(17,J) HLP71(2)=HLP71(2)+M(34,J) 50 CONTINUE R(7,1)=HLP71(1)+HLP71(2) DO 51 J=5,7 HLP72(1)=HLP72(1)+M(17,J) HLP72(2)=HLP72(2)+M(34,J) 51 CONTINUE R(7,2)=HLP72(1)+HLP72(2) R(7,3)=M(17,15)+M(34,15)+M(22,15)/XTOT*M(34,22)+M(23,15)/YTOT 1*M(34,23) DO 52 J=8,11 HLP74(1)=HLP74(1)+M(17,J) HLP74(2)=HLP74(2)+M(34,J) HLP74(3)=HLP74(3)+M(22,J) HLP74(4)=HLP74(4)+M(23,J) 52 CONTINUE R(7,4)=HLP74(1)+HLP74(2)+HLP74(3)/XTOT*M(34,22)+HLP74(4) 1/YTOT*M(34,23) DO 53 J=12,14 HLP75(1)=HLP75(1)+M(17,J) HLP75(2)=HLP75(2)+M(34,J) HLP75(3)=HLP75(3)+M(22,J) HLP75(4)=HLP75(4)+M(23,J) 53 CONTINUE R(7,5)=HLP75(1)+HLP75(2)+HLP75(3)/XTOT*M(34,22)+HLP75(4) 1/YTOT*M(34,23) R(7,6)=M(17,16)+M(34,16)+M(22,16)/XTOT*M(34,22)+M(23,16)/YTOT 1*M(34,23) R(7,7)=M(17,17)+M(34,17)+M(22,17)/XTOT*M(34,22)+M(23,17)/YTOT 1*M(34,23)+M(17,34) R(7,8)=M(17,18)+M(34,18)+M(22,18)/XTOT*M(34,22)+M(23,18)/YTOT 1*M(34,23) C WRITE (*,'(F10.3)') M(17,35) C WRITE (*,'(F10.3)') M(34,35) C WRITE (*,'(F10.3)') M(22,35) C WRITE (*,'(F10.3)') XTOT C WRITE (*,'(F10.3)') M(37,22) C WRITE (*,'(F10.3)') M(34,24) C WRITE (*,'(F10.3)') M(37,24) C WRITE (*,'(F10.3)') M(23,35) C WRITE (*,'(F10.3)') M(38,23) C WRITE (*,'(F10.3)') YTOT C WRITE (*,'(F10.3)') M(34,25) C WRITE (*,'(F10.3)') M(38,25) R(7,9)=M(17,35)+M(34,35)+M(22,35)/XTOT*M(37,22)*M(34,24) 1/M(37,24)+M(23,35)*M(38,23)/YTOT*M(34,25)/M(38,25) DO 54 J=1,9 R(7,10)=R(7,10)+R(7,J) 54 CONTINUE DO 55 J=26,33 HLP711(1)=HLP711(1)+M(17,J) HLP711(2)=HLP711(2)+M(34,J) HLP711(3)=HLP711(3)+M(20,J) HLP711(4)=HLP711(4)+M(21,J) 55 CONTINUE R(7,11)=HLP711(1)+HLP711(2)+HLP711(3)/VTOT*M(34,20)+HLP711(4) 1/WTOT*M(34,21) R(7,13)=M(17,38)+M(34,38)+(M(24,38)*M(37,24)/ZTOT+M(22,38)* 1M(37,22)/XTOT)*M(34,24)/M(37,24)+M(25,38)/AATOT*M(34,25) R(7,14)=M(17,36)+M(34,36)+(M(22,36)*M(34,22)/XTOT+M(23,36)* 1M(34,23)/YTOT)+M(24,36)*M(34,24)/ZTOT+M(25,36)*M(34,25)/AATOT R(7,15)=M(17,37)+M(34,37)+M(24,37)/ZTOT*M(34,24)+M(25,37)/AATOT 1*M(34,25) R(7,17)=M(17,39)+M(34,39) R(7,18)=M(17,40) R(7,16)=R(7,17)+R(7,18) DO 56 J=11,16 R(7,19)=R(7,19)+R(7,J) 56 CONTINUE R(7,20)=R(7,10)+R(7,19) C BEREKENING VAN DE ACHTSTE REGEL VAN R C DO 58 J=1,4 R(8,1)=R(8,1)+M(18,J) 58 CONTINUE DO 59 J=5,7 R(8,2)=R(8,2)+M(18,J) 59 CONTINUE R(8,3)=M(18,15) DO 60 J=8,11 R(8,4)=R(8,4)+M(18,J) 60 CONTINUE DO 61 J=12,14 R(8,5)=R(8,5)+M(18,J) 61 CONTINUE R(8,6)=M(18,16) R(8,7)=M(18,17) R(8,8)=M(18,18) R(8,9)=M(18,35) DO 62 J=1,9 R(8,10)=R(8,10)+R(8,J) 62 CONTINUE DO 63 J=26,33 R(8,11)=R(8,11)+M(18,J) 63 CONTINUE R(8,13)=M(18,38) R(8,14)=M(18,36) R(8,15)=M(18,37) R(8,17)=M(18,39) R(8,18)=M(18,40) R(8,16)=R(8,17)+R(8,18) DO 64 J=11,16 R(8,19)=R(8,19)+R(8,J) 64 CONTINUE R(8,20)=R(8,10)+R(8,19) C BEREKENING VAN DE NEGENDE REGEL VAN R C DO 65 I=1,18 HLP91=M(I,35)+HLP91 65 CONTINUE R(9,12)=HLP91+M(22,35)*M(37,22)/XTOT+M(23,35)*M(38,23)/YTOT 1+DC88+M(34,35)+M(22,35)*M(37,22)/XTOT*M(34,24)/M(37,24)+M(23,35)* 2M(38,23)/YTOT*M(34,25)/M(38,25)+M(35,35)+M(22,35)*M(37,22)/ 3XTOT*M(35,24)/M(37,24)+M(23,35)*M(38,23)/YTOT*M(35,25)/M(38,25) R(9,19)=R(9,12) R(9,20)=R(9,12) C BEREKENING VAN DE TIENDE REGEL VAN R C DO 66 I=1,9 R(10,1)=R(10,1)+R(I,1) R(10,2)=R(10,2)+R(I,2) R(10,3)=R(10,3)+R(I,3) R(10,4)=R(10,4)+R(I,4) R(10,5)=R(10,5)+R(I,5) R(10,6)=R(10,6)+R(I,6) R(10,7)=R(10,7)+R(I,7) R(10,8)=R(10,8)+R(I,8) R(10,9)=R(10,9)+R(I,9) 66 CONTINUE DO 67 J=1,9 R(10,10)=R(10,10)+R(10,J) 67 CONTINUE DO 68 I=1,9 R(10,11)=R(10,11)+R(I,11) R(10,12)=R(10,12)+R(I,12) R(10,13)=R(10,13)+R(I,13) R(10,14)=R(10,14)+R(I,14) R(10,15)=R(10,15)+R(I,15) R(10,16)=R(10,16)+R(I,16) R(10,17)=R(10,17)+R(I,17) R(10,18)=R(10,18)+R(I,18) 68 CONTINUE DO 69 J=11,16 R(10,19)=R(10,19)+R(10,J) 69 CONTINUE R(10,20)=R(10,19)+R(10,10) DO 70 J=1,4 HLP121(1)=HLP121(1)+M(37,J) HLP121(2)=HLP121(2)+M(22,J) 70 CONTINUE R121=HLP121(1)+HLP121(2)*M(37,22)/XTOT r(12,1) = 0. r(1,16) = r(1,16) - r121 r(1,17) = r(1,17) - r121 r(1,19) = r(1,19) - r121 r(1,20) = r(1,20) - r121 r(10,16) = r(10,16) - r121 r(10,17) = r(10,17) - r121 r(10,19) = r(10,19) - r121 r(10,20) = r(10,20) - r121 c DO 71 J=5,7 HLP122(1)=HLP122(1)+M(37,J) HLP122(2)=HLP122(2)+M(22,J) 71 CONTINUE R122=HLP122(1)+HLP122(2)*M(37,22)/XTOT r(12,2) = 0. r(2,16) = r(2,16) - r122 r(2,17) = r(2,17) - r122 r(2,19) = r(2,19) - r122 r(2,20) = r(2,20) - r122 r(10,16) = r(10,16) - r122 r(10,17) = r(10,17) - r122 r(10,19) = r(10,19) - r122 r(10,20) = r(10,20) - r122 c R(12,3)=M(22,15)*M(37,22)/XTOT DO 72 J=8,11 R(12,4)=R(12,4)+M(22,J) 72 CONTINUE R(12,4)=R(12,4)*M(37,22)/XTOT DO 73 J=12,14 R(12,5)=R(12,5)+M(22,J) 73 CONTINUE R(12,5)=R(12,5)*M(37,22)/XTOT R(12,6)=M(22,16)*M(37,22)/XTOT R(12,7)=M(22,17)*M(37,22)/XTOT R(12,8)=M(22,18)*M(37,22)/XTOT R(12,9)=M(22,35)*M(37,22)/XTOT DO 74 J=1,9 R(12,10)=R(12,10)+R(12,J) 74 CONTINUE DO 75 J=26,33 R(12,11)=R(12,11)+M(20,J) 75 CONTINUE R(12,11)=R(12,11)*M(37,20)/VTOT R(12,13)=M(24,38)*M(37,24)/ZTOT+M(22,38)*M(37,22)/XTOT R(12,14)=M(24,36)*M(37,24)/ZTOT+M(22,36)*M(37,22)/XTOT R(12,15)=M(24,37)*M(37,24)/ZTOT DO 76 J=11,16 R(12,19)=R(12,19)+R(12,J) 76 CONTINUE R(12,20)=R(12,19)+R(12,10) C C BEREKENING VAN DE DERTIENDE REGEL VAN R R(13,1)=DC84+DC85 DO 77 J=5,7 HLP132(1)=HLP132(1)+M(38,J) HLP132(2)=HLP132(2)+M(23,J) 77 CONTINUE R(13,2)=HLP132(1)+HLP132(2)*M(38,23)/YTOT R(13,3)=M(23,15)*M(38,23)/YTOT DO 78 J=8,11 R(13,4)=R(13,4)+M(23,J) 78 CONTINUE R(13,4)=R(13,4)*M(38,23)/YTOT DO 79 J=12,14 R(13,5)=R(13,5)*M(23,J) 79 CONTINUE R(13,5)=R(13,5)*M(38,23) /YTOT R(13,6)=M(23,16)*M(38,23)/YTOT R(13,7)=M(23,17)*M(38,23)/YTOT R(13,8)=M(23,18)*M(38,23)/YTOT R(13,9)=M(23,35)*M(38,23)/YTOT DO 80 J=1,9 R(13,10)=R(13,10)+R(13,J) 80 CONTINUE DO 81 J=26,33 R(13,11)=R(13,11)+M(21,J) 81 CONTINUE R(13,11)=R(13,11)*M(38,21)/WTOT R(13,12)=M(38,35)-DC84-DC85 R(13,13)=M(25,38)*M(38,25)/AATOT R(13,14)=M(25,36)*M(38,25)/AATOT+M(23,36)*M(38,23)/YTOT R(13,15)=M(25,37)*M(38,25)/AATOT DO 82 J=11,16 R(13,19)=R(13,19)+R(13,J) 82 CONTINUE R(13,20)=R(13,19)+R(13,10) C C BEREKENING VAN REGEL ELF VAN R R(11,1)=R(12,1)+R(13,1) R(11,2)=R(12,2)+R(13,2) R(11,3)=R(12,3)+R(13,3) R(11,4)=R(12,4)+R(13,4) R(11,5)=R(12,5)+R(13,5) R(11,6)=R(12,6)+R(13,6) R(11,7)=R(12,7)+R(13,7) R(11,8)=R(12,8)+R(13,8) R(11,9)=R(12,9)+R(13,9) DO 83 J=1,9 R(11,10)=R(11,10)+R(11,J) 83 CONTINUE R(11,11)=R(12,11)+R(13,11) R(11,12)=R(12,12)+R(13,12) R(11,13)=R(12,13)+R(13,13) R(11,14)=R(12,14)+R(13,14) R(11,15)=R(12,15)+R(13,15) R(11,16)=R(12,16)+R(13,16) R(11,17)=R(12,17)+R(13,17) R(11,18)=R(12,18)+R(13,18) DO 84 J=11,16 R(11,19)=R(11,19)+R(11,J) 84 CONTINUE R(11,20)=R(11,10)+R(11,19) C C BEREKENING VAN REGEL 14 VAN R DO 85 J=1,4 DO 86 I=26,32 HLP141(1)=HLP141(1)+M(I,J) 86 CONTINUE HLP141(2)=0. HLP141(3)=0. HLP141(4)=0. HLP141(5)=0. 85 CONTINUE R(14,1)=HLP141(1)-875./(9802.-205.)*(R(1,20)-(HLP141(2) 1+HLP141(3)*M(37,22)/XTOT+HLP141(4)+HLP141(5)*M(38,23)/YTOT)) 2-22./71.*DC87-DC84-DC85 DO 87 J=5,7 DO 88 I=26,32 HLP142=HLP142+M(I,J) 88 CONTINUE 87 CONTINUE R(14,2)=HLP142+875./(9802.-205.)*(R(1,20)-(HLP141(2) 1+HLP141(3)*M(37,22)/XTOT+HLP141(4)+HLP141(5)*M(38,23)/YTOT)) 2-49./71.*DC87+CASHINV C CASHINV IS CONSTANT OP 227 GESTELD R(14,3)=M(33,15) DO 89 J=8,11 R(14,4)=R(14,4)+M(33,J) 89 CONTINUE DO 90 J=12,14 R(14,5)=R(14,5)+M(33,J) 90 CONTINUE R(14,6)=M(33,16) R(14,7)=M(33,17)+M(33,34) R(14,8)=M(33,18) R(14,9)=DC88 DO 91 J=1,9 R(14,10)=R(14,10)+R(14,J) 91 CONTINUE DO 92 I=26,33 DO 93 J=26,33 R(14,11)=R(14,11)+M(I,J) 93 CONTINUE R(14,12)=R(14,12)+M(I,35) R(14,13)=R(14,13)+M(I,38) 92 CONTINUE R(14,12)=R(14,12)-DC88 DO 94 I=26,33 R(14,16)=R(14,16)+M(I,40) R(14,18)=R(14,18)+M(I,40) 94 CONTINUE DO 95 J=11,16 R(14,19)=R(14,19)+R(14,J) 95 CONTINUE R(14,20)=R(14,19)+R(14,10) C C BEREKENING VAN DE ZESTIENDE RIJ VAN R R(16,3)=M(35,15) DO 96 J=8,11 R(16,4)=R(16,4)+M(35,J) 96 CONTINUE DO 97 J=12,14 R(16,5)=R(16,5)+M(35,J) 97 CONTINUE R(16,6)=M(35,16) R(16,7)=M(35,17) R(16,8)=M(35,18) R(16,9)=M(35,35) DO 98 J=1,9 R(16,10)=R(16,10)+R(16,J) 98 CONTINUE DO 99 J=26,33 R(16,11)=R(16,11)+M(35,J) 99 CONTINUE R(16,11)=R(16,11)-DC84-DC85 R(16,13)=M(35,38) R(16,14)=M(35,36) R(16,15)=M(35,37) DO 100 J=11,16 R(16,19)=R(16,19)+R(16,J) 100 CONTINUE R(16,20)=R(16,19)+R(16,10) R(18,3)=M(22,15)/XTOT*M(35,22) DO 101 J=8,11 R(18,4)=R(18,4)+M(22,J) 101 CONTINUE R(18,4)=R(18,4)/XTOT*M(35,22) DO 102 J=12,14 R(18,5)=R(18,5)+M(22,J) 102 CONTINUE R(18,5)=R(18,5)/XTOT*M(35,22) R(18,6)=M(22,16)/XTOT*M(35,22) R(18,7)=M(22,17)/XTOT*M(35,22) R(18,8)=M(22,18)/XTOT*M(35,22) R(18,9)=M(22,35)*M(37,22)/XTOT*M(35,24)/M(37,24) DO 103 J=1,9 R(18,10)=R(18,10)+R(18,J) 103 CONTINUE DO 104 J=26,33 R(18,11)=R(18,11)+M(20,J) 104 CONTINUE R(18,11)=R(18,11)/VTOT*M(35,20) R(18,13)=(M(24,38)*M(37,24)/ZTOT+M(22,38)*M(37,22)/XTOT)* 1M(35,24)/M(37,24) R(18,15)=M(24,37)/ZTOT*M(35,24) R(18,14)=M(22,36)*M(35,22)/XTOT+M(24,36)*M(35,24)/ZTOT DO 105 J=11,16 R(18,19)=R(18,19)+R(18,J) 105 CONTINUE R(18,20)=R(18,10)+R(18,19) C C BEREKENING VAN DE NEGENTIENDE RIJ VAN R R(19,3)=M(23,15)/YTOT*M(35,23) DO 106 J=8,11 R(19,4)=R(19,4)+M(23,J) 106 CONTINUE R(19,4)=R(19,4)/YTOT*M(35,23) DO 107 J=12,14 R(19,5)=R(19,5)+M(23,J) 107 CONTINUE R(19,5)=R(19,5)/YTOT*M(35,23) R(19,6)=M(23,16)/YTOT*M(35,23) R(19,7)=M(23,17)/YTOT*M(35,23) R(19,8)=M(23,18)/YTOT*M(35,23) R(19,9)=M(23,35)*M(38,23)/YTOT*M(35,25)/M(38,25) DO 108 J=1,9 R(19,10)=R(19,10)+R(19,J) 108 CONTINUE DO 109 J=26,33 R(19,11)=R(19,11)+M(21,J) 109 CONTINUE R(19,11)=R(19,11)/WTOT*M(35,21) R(19,13)=M(25,38)/AATOT*M(35,25) R(19,14)=M(23,36)*M(35,23)/YTOT+M(25,36)*M(35,25)/AATOT R(19,15)=M(25,37)/AATOT*M(35,25) DO 110 J=11,16 R(19,19)=R(19,19)+R(19,J) 110 CONTINUE R(19,20)=R(19,19)+R(19,10) C C BEREKENING VAN DE ZEVENTIENDE RIJ R(17,1)=R(18,1)+R(19,1) R(17,2)=R(18,2)+R(19,2) R(17,3)=R(18,3)+R(19,3) R(17,4)=R(18,4)+R(19,4) R(17,5)=R(18,5)+R(19,5) R(17,6)=R(18,6)+R(19,6) R(17,7)=R(18,7)+R(19,7) R(17,8)=R(18,8)+R(19,8) R(17,9)=R(18,9)+R(19,9) DO 111 J=1,9 R(17,10)=R(17,10)+R(17,J) 111 CONTINUE R(17,11)=R(18,11)+R(19,11) R(17,12)=R(18,12)+R(19,12) R(17,13)=R(18,13)+R(19,13) R(17,14)=R(18,14)+R(19,14) R(17,15)=R(18,15)+R(19,15) R(17,16)=R(18,16)+R(19,16) R(17,17)=R(18,17)+R(19,17) R(17,18)=R(18,18)+R(19,18) DO 112 J=11,16 R(17,19)=R(17,19)+R(17,J) 112 CONTINUE R(17,20)=R(17,19)+R(17,10) C C BEREKENING VAN DE VIJFTIENDE RIJ VAN R R(15,1)=R(16,1)+R(17,1) R(15,2)=R(16,2)+R(17,2) R(15,3)=R(16,3)+R(17,3) R(15,4)=R(16,4)+R(17,4) R(15,5)=R(16,5)+R(17,5) R(15,6)=R(16,6)+R(17,6) R(15,7)=R(16,7)+R(17,7) R(15,8)=R(16,8)+R(17,8) R(15,9)=R(16,9)+R(17,9) DO 113 J=1,9 R(15,10)=R(15,10)+R(15,J) 113 CONTINUE R(15,11)=R(16,11)+R(17,11) R(15,12)=R(16,12)+R(17,12) R(15,13)=R(16,13)+R(17,13) R(15,14)=R(16,14)+R(17,14) R(15,15)=R(16,15)+R(17,15) R(15,16)=M(35,40) R(15,18)=M(35,40) DO 114 J=11,16 R(15,19)=R(15,19)+R(15,J) 114 CONTINUE R(15,20)=R(15,19)+R(15,10) C C BEREKENING VAN DE TWINTIGSTE RIJ VAN R R(20,1)=R(11,1)+R(14,1)+R(15,1) R(20,2)=R(11,2)+R(14,2)+R(15,2) R(20,3)=R(11,3)+R(14,3)+R(15,3) R(20,4)=R(11,4)+R(14,4)+R(15,4) R(20,5)=R(11,5)+R(14,5)+R(15,5) R(20,6)=R(11,6)+R(14,6)+R(15,6) R(20,7)=R(11,7)+R(14,7)+R(15,7) R(20,8)=R(11,8)+R(14,8)+R(15,8) R(20,9)=R(11,9)+R(14,9)+R(15,9) DO 115 J=1,9 R(20,10)=R(20,10)+R(20,J) 115 CONTINUE R(20,11)=R(11,11)+R(14,11)+R(15,11) R(20,12)=R(11,12)+R(14,12)+R(15,12) R(20,13)=R(11,13)+R(14,13)+R(15,13) R(20,14)=R(11,14)+R(14,14)+R(15,14) R(20,15)=R(11,15)+R(14,15)+R(15,15) R(20,16)=R(11,16)+R(14,16)+R(15,16) R(20,17)=R(11,17)+R(14,17)+R(15,17) R(20,18)=R(11,18)+R(14,18)+R(15,18) DO 116 J=11,16 R(20,19)=R(20,19)+R(20,J) 116 CONTINUE R(20,20)=R(20,19)+R(20,10) c DO 29 I=15,17,2 c WRITE(*,*)(R(I,J),J=1,20) C WRITE(*,*) R(10,J) c 29 CONTINUE c WRITE(*,*)(R(20,J),J=1,20) c c ************ c do 210 j=26,33 h(1) = h(1) + m(35,j) 210 continue c do 211 j=1,4 h(2) = h(2) + m(35,j) 211 continue c do 212 j=5,7 h(3) = h(3) + m(35,j) 212 continue c do 213 j=8,11 h(4) = h(4) + m(35,j) 213 continue c do 214 j=12,14 h(5) = h(5) + m(35,j) 214 continue c do 215 j=4,8 do 215 i=18,19 h(6) = h(5) + r(i,j) 215 continue c do 217 i = 26,33 h(7) = h(6) + m(i,35) 217 continue c do 218 i = 1,8 h(8) = h(7) + r(i,15) h(9) = h(8) + r(i,14) h(10) = h(9) + r(i,9) 218 continue c c r(21,12) = h(1)+r(18,11)+r(19,11)+m(35,38)+r(18,13)+r(19,13)+ c 1 m(35,36)+r(18,14)+r(19,14)+m(35,37)+r(18,15)+r(19,15)+m(35,40)+ c 2 h(2)+h(3)+m(35,15)+r(18,3)+r(19,3)+h(4)+h(5)+m(35,16)+m(35,17)+ c 3 m(35,18)+m(35,35)+r(12,9)*M(34,24)/m(37,24)+r(13,9)*m(35,25)/ c 4 m(38,25)+h(6)-m(38,35)-h(7)+r(14,9)-(m(24,37)*m(37,24)/ztot+ c 5 m(25,37)*m(38,25)/aatot+m(35,37)+r(18,15)+r(19,15)+h(8)) c r(21,12) = r(21,12) - c 1 (m(24,36)*m(37,24)/ztot+m(22,36)*m(37,22)/xtot+m(25,36)*m(38,25)/ c 2 aatot+m(23,36)*m(38,23)/ytot+m(37,36)+r(18,14)+r(19,14)+h(9))- c 3 (h(10)+m(22,35)*m(37,22)/xtot+m(23,35)*m(38,23)/ytot+r(14,9)+ c 4 m(35,35)+m(22,35)*m(37,22)/xtot*m(35,24)/m(37,24)+m(23,35)* c 5 m(38,23)*m(35,25)/m(38,25)) c c c c47 = m(35,35)+r(14,9)+ 1 m(22,35)*m(37,22)/xtot*(1+m(35,24)/m(37,24))+ 2 m(23,35)*m(38,23)/ytot*(1+m(35,25)/m(38,25)) c do 471 i=1,9 c47 = c47 + r(i,9) 471 continue c c49 = r(17,11)+r(17,13)+m(35,40)+m(35,38)+m(35,35)+ 1 r(12,9)*m(35,24)/m(37,24)+ 2 r(13,9)*m(35,25)/m(38,25) c do 491 i=1,18 491 c49=c49+m(35,i) c do 492 i=26,33 492 c49=c49+m(35,i) c do 494 i=3,8 494 c49=c49+r(17,i) c c q77=c49-c47-m(38,35)+r(14,9) 1 -m(22,36)*m(37,22)/xtot 2 -m(23,36)*m(38,23)/ytot 3 -(m(24,37)+m(24,36))*m(37,24)/ztot 4 -(m(25,37)+m(25,36))*m(38,25)/aatot c do 771 i=26,33 771 q77 = q77 - m(i,35) c do 772 j=14,15 do 772 i=1,9 772 q77 = q77 - r(i,j) c r(21,12) = q77 c do 220 j=26,33 r(21,11) = r(21,11) + m(36,j) 220 continue c r(21,11) = r(21,11) + cashinv c do 221 j=26,33 h1(1) = h1(1) + m(36,j) 221 continue c do 222 i=1,8 h1(2) = h1(2) + r(i,13) 222 continue c do 223 i=26,33 h1(3)=h1(3)+m(i,38) 223 continue c r(21,13)=h1(1)+cashinv-h1(2)-m(24,38)*m(37,24)/ztot-m(22,38)* 1 m(37,22)/xtot-m(25,38)*m(38,25)/aatot-h1(3)-m(35,38)-r(18,13)- 2 r(19,13) c do 225 j=11,16 r(21,19) = r(21,19) + r(22,j) 225 continue c r(21,20) = r(21,19) + r(21,10) c do 300 i=1,9 r(22,i) = r(10,i)+r(20,i)+r(21,i) 300 continue c do 226 j=1,9 r(22,10)=r(22,10)+r(22,j) 226 continue c do 301 i=11,18 r(22,i) = r(10,i)+r(20,i)+r(21,i) 301 continue c do 227 j=11,16 r(22,19) = r(22,19)+r(22,j) 227 continue c r(22,20)=r(22,19)+r(22,10) c call show(r) c end c subroutine show(r) c real r(22,20) c character*9 bln,head1(20),colm(22) c bln = ' ' head1(1)='food ' head1(2)='cash ' head1(3)='manufct. ' head1(4)='food mil ' head1(5)='cash mil ' head1(6)='constr. ' head1(7)='trade ' head1(8)='prv.svc. ' head1(9)='gov.svc. ' head1(10)='sub-tot ' head1(11)='prv.cons. ' head1(12)='gov.cons. ' head1(13)='prv.inv. ' head1(14)='gov.inv1. ' head1(15)='gov.inv2. ' head1(16)='foreign ' head1(17)='-india ' head1(18)='-row ' head1(19)='sub-tot ' head1(20)='TOTAL ' c colm(1)='food ' colm(2)='cash ' colm(3)='manufct. ' colm(4)='food mil ' colm(5)='cash mil ' colm(6)='constr. ' colm(7)='trade ' colm(8)='prv.svc. ' colm(9)='gov.svc. ' colm(10)='sub-tot ' colm(11)='imports ' colm(12)='-india ' colm(13)='-row ' colm(14)='prv.inc.. ' colm(15)='gov.rev. ' colm(16)='-domestic ' colm(17)='-imports ' colm(18)='--india ' colm(19)='--row ' colm(20)='sub-tot ' colm(21)='savings ' colm(22)='TOTAL ' c 1 format(1x,11a9) 2 format(1x,a9,10i9) c write(10,1) bln,(head1(i),i=1,10) write(10,*) write(10,2) (colm(i),(nint(r(i,j)),j=1,10),i=1,9) write(10,*) write(10,2) (colm(i),(nint(r(i,j)),j=1,10),i=10,19) write(10,*) write(10,2) colm(20),(nint(r(20,j)),j=1,10) write(10,*) write(10,2) colm(21),(nint(r(21,j)),j=1,10) write(10,*) write(10,2) colm(22),(nint(r(22,j)),j=1,10) write(10,*) write(10,*) write(10,1) bln,(head1(i),i=11,20) write(10,*) write(10,2) (colm(i),(nint(r(i,j)),j=11,20),i=1,9) write(10,*) write(10,2) (colm(i),(nint(r(i,j)),j=11,20),i=10,19) write(10,*) write(10,2) colm(20),(nint(r(20,j)),j=11,20) write(10,*) write(10,2) colm(21),(nint(r(21,j)),j=11,20) write(10,*) write(10,2) colm(22),(nint(r(22,j)),j=11,20) c end C file 8 program makt0prg C C INITIALIZES VARIABLES FOR BASEYEAR C C IMPLICIT REAL (A-Z) C $include:'urbblk.for' $include:'genblk.for' $include:'gblk.for' $include:'glblk.for' $include:'trblk.for' $include:'blnblk.for' C INTEGER I,J,I1,J1 REAL VFDR(7),TPV(7),PGNV(7),PHNV(7),GOIROL(7),GOIOOL(7), + VIOCO(18,4),VFOODX(11,7),VXLAB(7),VGCSER(18),VCPRIN(18,4), + VGSNV(18),VIINV(18),VTINV(18),VHINV(18),VCONV(18),VGLABC, + VGINV(18),QX(18),DIMSED(3,7),DIMSES(3,7),DCHEMD(7),DCHEMS(7), + YTRANL(8),AREAL(7),PADOIS(7),avintal(18),avrotal(18), + avlotal(18), + PCHL(7),PSIL(3,7),NOFHHL(8),YREML(8),OLNHH8,OLARE(7), + UPRINL(4),NTXRV,DIRTAX,GOISOL,GOIINL,GOICOL,GOITRL C REAL BLKURB(328),BLKGEN(5169),BLKG(321),BLKGL(18),BLKTR(49), + BLKBLN(4) C EQUIVALENCE (CATR(1),BLKTR(1)),(GRQR(1,1),BLKGEN(1)), + (GINV(1),BLKG(1)),(GVIRUR,BLKGL(1)),(CALFUR(1),BLKURB(1)), + (XPRCN,BLKBLN(1)) C EQUIVALENCE (NTXRV,RESERV(20)),(PADOIS,RESERV(30)) C C------------------------------------------- C data YREML/155.54,452.48,240.38,296.94,56.560,42.420,70.700, + 98.980/ data nofhhl/.22574E+6,.32166E+6,.26850E+6,.20905E+6,. + 34434E+6,.27034E+6,.17413E+6,.20853E+6/ c data YTRANL/15.775,6*31.550,1151.6/ data (avintal(i),i=13,17,2)/.68571E-1,.19428,.11565/ data (avrotal(i),i=14,18,2)/.42857,.72247E-1,.70224E-1/ data (avlotal(i),i=1,11)/7*.12041E-1,.70822E-1,.007,.14469E-1, + .92430E-2/ C do 9876 i=13,17,2 avrotal(i+1)= avrotal(i+1) * 252./187. 9876 avintal(i) = avintal(i) * 639./499. c avlotal(10) = 286./190. * avlotal(10) c pr(1,9) = 3. c pr(2,9) = 3. c pr(3,9) = 3. c pr(4,9) = 3.5 c pr(5,9) = 8. c pr(6,9) = 2. c pr(7,9) = 1000. c c Indian border prices increased 01-Sep-1989 c pr(1,9) = 3. * 90./66.*13.8/15.3 pr(2,9) = 3. * 90./66.*13.8/15.3 pr(3,9) = 3. * 90./66.*13.8/15.3 pr(4,9) = 3.5* 90./66.*13.8/15.3 pr(5,9) = 8. * 95. /87.*1.5 pr(6,9) = 2. * 95. /87.*1.5 c pr(7,9) = 1000.* 95. /87. pr(7,9) = 1500.*95./87. c c c c c read(1,*) ((pr(i,j),i=1,7),j=1,8) c do 13 i=1,18 avinta(i) = avintal(i) avrota(i) = avrotal(i) avlota(i) = avlotal(i) 13 continue c call inicoesr call exodatsr c read(1,*) (px(i,8),i=1,11) c px(12,8) = 1. do 261 i=0,4,2 PX(I+13,9) = 1. px(i+14,10) = 1. 261 continue c c call modmojc c c TROPSS=1151.6 TROPSS= 749.3 TRSUBS=0. DTPTLO=0. DTPTFO=2063.7 FORAST=5905.1 C NTXRV=1602.7 DIRTAX=768.7 C C C TRILHH = 0. DO 17 I = 1,8 17 TRILHH = TRILHH + YTRANL(I) C C DO 207 I= 1,8 YTRANS(I) = YTRANL(I) YREM(I) = YREML(I) NOFHH(I) = NOFHHL(I) 207 CONTINUE C SLAURB = NOFHH(8) C C TOTAR = 0. DO 533 I=1,7 TOTAR = TOTAR + AREA(I) 533 CONTINUE C DO 534 I=1,7 TAU(I) = DIRTAX / TOTAR 534 CONTINUE C DO 535 I=1,7 DTPTFO = DTPTFO + PCH(I)*DCHEM(I) DO 5351 J=1,5 DTPTFO = DTPTFO + PSI(J,I)*DIMSE(J,I) 5351 CONTINUE 535 CONTINUE C C RESERV(20) = NTXRV C C C C FDR IS KEPT UNCHANGED, LIKE LSU C WRITE(4)(BLKURB(I),I=1,256) WRITE(4)(BLKURB(I),I=257,328) C J=0 2 WRITE(4)(BLKGEN(I+J*256),I=1,256) J=J+1 IF (J.LE.19) GOTO 2 C WRITE(4)(BLKGEN(I+5120),I=1,149) C WRITE(4)(BLKG(I),I=1,256) WRITE(4)(BLKG(I),I=257,321) C WRITE(4) BLKGL WRITE(4) BLKTR WRITE(4) BLKBLN C CLOSE(4) C END C file 9 BLOCK DATA INICOEBD c c c version 28-Aug-1989 c IMPLICIT REAL (A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' C DATA CBET/1.,1.,1.,1.,1.,2.19,20.,1.,1.,1.,1.,1.,2.19,20., 1 .5,.5,0.2,0.,0.,.33,.33,.33,.33,.33,.33 / C DATA CINV/126*0.0/ C c c 0.2586 food c 0.2389 cash c 0.1539 man c 0.0432 mill c c 0.1500 trade c 0.0135 p.svc c c c 0.8581 c 0.1419 c 0.0516 india c 0.0902 row c c 1.0000 c c c DATA CODEM /.1048,.042,.056,.099,10*0.0,5*.95, 0.0, 0.0, 0.0 1 ,.1258,.021,.065,.090,10*0.0,5*.9, 0.0, 0.0, 0.0 2 ,.1258,.021,.065,.090,10*0.0,5*.9, 0.0, 0.0, 0.0 3 ,.1258,.021,.065,.090,10*0.0,5*.9, 0.0, 0.0, 0.0 4 ,.204,.0228,.026,.049,10*0.0,5*.9, 0.0, 0.0, 0.0 5 ,.204,.0228,.026,.049,10*0.0,5*.9, 0.0, 0.0, 0.0 6 ,.204,.0228,.026,.049,10*0.0,5*.9, 0.0, 0.0, 0.0 7 ,.175,.030,.0478,.049,10*0.0,5*.75, 0.0, 0.0, 0.0/ C c DATA CLOSS /.4, .1, .1, .1, 2./ c c no longer used? c c C C DATA UFOODR,UFOODX /49*0. , 77*0./ C DATA UXDEP /.007823,.007823,.007823,.007823,.011111,.0,.0/ C c DATA UX17OS/.270133,.270133,.270133,.270133,.348148,.0,.0/ data ux17os/5*0.15,2*0./ C C DATA CALFUR /0.3463,0.7273,0.6254,0.2140/ c DATA CAURB /108.67468,3.5694555,4.872394,231.79243/ data caurb /88.92, 3.52, 4.58, 226.9/ DATA DELTA /4*0.02/ C C DATA CATR /12*100000./ DATA CALFTR/12*0.33/ C END C C DK INIDAT C SUBROUTINE INICOESR c c c version 28-Aug-1989 c C IMPLICIT REAL (A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' C INTEGER I,J REAL DUM(20) C C DUM(5) = 0.0882 DUM(6) = 0.0 DUM(7) = 0.9118 c C dum(5) to dum(7) are applied to fraction of cash consumption c i.e. .2389 C DUM(8) = 0.15393 DUM(9) = 0.0 DUM(10) = 0.15 DUM(11) = 0.0135 DUM(12) = 0.0 DUM(13) = 0.0516 DUM(14) = 0.0902 C c dum(8) to dum(14) are straight from the i-o table 87 C CINV(8,1) = 1.0 MUINV(1) = 0.1 S1(1) = 0.05 * .1530/.1175 c S2(1) = 0.0852 S2(1) = 0.3 THETA(1) = 0.0274 GAMGOV(1) = 0.056 C DO 100 J=5,7 CODEM(J,1) = DUM(J)*0.2389 100 CONTINUE C DO 101 J=8,14 CODEM(J,1) = DUM(J) 101 CONTINUE C theta(2) = .0763 theta(3) = .034 theta(4) = .0251 c c DO 1 I=2,4 CINV(8,I) = 1.0 MUINV(I) = 0.1 S1(I) = 0.09 * .1530/.1175 c S2(I) = 0.0852 S2(I) = 0.3 GAMGOV(I) = 0.075 C DO 102 J=5,7 CODEM(J,I) = DUM(J)*0.2389 102 CONTINUE C DO 103 J=8,14 CODEM(J,I) = DUM(J) 103 CONTINUE C 1 CONTINUE C theta(5) = .033 theta(6) = .0463 theta(7) = .0386 c c DO 2 I=5,7 CINV(8,I)=0.8 CINV(15,I)=0.2 MUINV(I) = 0.36 S1(I) = 0.14 * .1530/.1175 c S2(I) = 0.067 S2(I) = 0.18 GAMGOV(I) = 0.094 C DO 105 J=5,7 CODEM(J,I) = DUM(J)*0.2389 105 CONTINUE C DO 106 J=8,14 CODEM(J,I) = DUM(J) 106 CONTINUE C 2 CONTINUE C S1(8) = 0.18 THETA(8) = 1. do 8888 j=1,7 8888 theta(8) = theta(8) - theta(j) c c GAMGOV(8)= 0.437 C DO 108 J=5,7 CODEM(J,8) = DUM(J)*0.2389 108 CONTINUE C DO 109 J=8,14 CODEM(J,8) = DUM(J) 109 CONTINUE C UFOODR(1,1) = 1.538461 UFOODR(2,2) = 1.1 UFOODR(3,3) = 1.3 UFOODR(4,4) = 1.1 UFOODR(5,5) = 3.33333 UFOODR(6,6) = 1. UFOODR(7,7) = 1. C C C RETURN END C C BLOCK DATA EXODATBD C DEBUG IMPLICIT REAL(A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' C DATA DR/700*.0/ DATA DX/1800*.0/ DATA DTR/120*.0/ DATA DCONSD/168*0./ DATA PWAURB/0.02/ DATA PX/180*1./ DATA SR/700*.0/ DATA SX/12*0./ DATA PVTBUD/0./ DATA ST/12*1.E+7/ DATA TAU/7*.0/ C DATA XTR/0./ c c Indian Prices elsewhere initialized C c DATA PT/1., 0.8, 0.375, 0.7, 0.7, 0.5, 0.2, 0.5, 0.1, c 1 0.1, 0.1 ,0.0/ DATA PT/.43,0.34, 0.16, 0.30, 0.30, 0.22, 0.086, 0.22, 0.043, 1 0.043, 0.043 ,0.0/ c c PT: non endogenous in baseyear. These are preliminary values. c c AREA: Old 85/86 data used, scaled to Country total 86/87 c DATA AREA/167607,598563,287952,239184,598035,574598,481061/ C DATA PCH/7*3.990/ c c PCH: price of urea and complex used in 50/50 proportion C DATA PSI/3.69,3.92,4.54,6.15,6.01,6.86,5.80,6.07,5.44, 1 4.71,5.52,8.14,4.61,4.51,5.14,4.34,4.54,4.08, 2 3.53,4.13,6.11/ c c PSI: No data available, used scenario 1 values instead. c C DATA DCHEM/3.067, 1.558, 12.939, 5.753, 12.891, 50.089, 17.602/ c c DCHEM based on 2.3 times nutrient tons in 86/87 (SPBN 1988,p60). c This distributed according to 1984/85 fractions. c Similar procedure for DIMSE (SPBN 88,61) C DATA DIMSE/3.2705e-3, 136.4306e-3, 3.021103e-3, 1 6.1345e-3, 105.8726e-3, 11.09162e-3, 2 15.100e-3, 65.21832e-3, 11.77601e-3, 3 13.739e-3, 427.0336e-3, 19.58784e-3, 4 43.625e-3, 874.8556e-3, 2.113762e-3, 5 17.180e-3, 372.0083e-3, 16.09831e-3, 6 41.948e-3, 216.5806e-3, 8.311337e-3/ c C DATA YGOVTO,YRDTRA,YX17PR,Y811PR/1262.,100.,50.,71./ c c These are arbitrary initial values c c GRQR; For Livestock Data from SPBN 1988 were taken, p.39. c Weigths for conversion to LSU from IDS worksheets,1987. C Belt totals were split according to region totals for Hill, c according to 81/82 values for Terai. c Values for other crops were 1985/86 values scaled to Country c totals in 1986/87 c DATA grqr/ 1 65.1434,55.2876,112.298,162.2247,11.7952,246.34,0.0617, 2 356.381,215.576,447.102,205.034,31.59,66.82, 0.1582262, 3 356.382,215.58,447.102,205.03,31.59,66.81, 0.158262, 4 236.645,120.43,236.630,89.3404,25.69,100.6, 0.072770, 5 882.954,275.883,133.69,28.158,211.28,947.48, 0.068873, 6 984.182,264.769,138.55,56.909,126.03,2175.8,0.054345, 7 807.451,92.336,41.606,43.330,19.748,2572.4, 0.050157/ c C DATA EKURB /4*1./ DATA EKTR /12*1./ C DATA PUPRIN /4*1./ DATA SWAGE / .80187,5.2766,1.20639,.21948,.83026/ C C END C C C C SUBROUTINE EXODATSR C IMPLICIT REAL (A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' C INTEGER I,J REAL VFDR(7),TPV(7) C DTR(12,10) = CBET(1)*DR(1,8,10)+CBET(5)*DR(5,8,10)+ 1 CBET(6)*DR(6,8,10)+CBET(8)*DX(1,8,10)+CBET(15)*DX(8,8,10)+ 2 CBET(17)*DX(10,8,10)+CBET(18)*DX(11,8,10) C DTR(10,9) = CBET(8)*DX(1,6,9)+CBET(10)*DX(3,6,9)+ 1 CBET(11)*DX(4,6,9)+CBET(15)*DX(8,6,9)+CBET(18)*DX(11,6,9) XTR = 0.0 C DO 100 I=1,7 c SLOC(1,I) = 0.15 * GRQR(1,I) c SLOC(2,I) = 0.18 * GRQR(2,I) c SLOC(3,I) = 0.1 * GRQR(3,I) c SLOC(4,I) = 0.1 * GRQR(4,I) c SLOC(5,I) = 0.1 * GRQR(5,I) c 04-Sep-1989 c SLOC(1,I) = 0.05 * GRQR(1,I) SLOC(2,I) = 0.05 * GRQR(2,I) SLOC(3,I) = 0.05 * GRQR(3,I) SLOC(4,I) = 0.05 * GRQR(4,I) SLOC(5,I) = 0.05 * GRQR(5,I) 100 CONTINUE C C RETURN END C SUBROUTINE MODMOJC C IMPLICIT REAL (A-Z) C C INCLUDE'INC.INC' include 'urbblk.for' c COMMON /URBBLK/ CALFUR(4),DLAURB(4),CAURB(4),EKURB(4),SWAGE(5), c 1 IOCO(18,4),UFOODX(11,7),UFOODR(7,7),UXLAB(7),UX17OS(7), c 2 UXDEP(7),DELTA(4),UVDEPR(4),PUPRIN(4),CUPRIN(18,4),UPRINV(4) C C include 'genblk.for' c COMMON /GENBLK/GRQR(7,7),SLOC(5,7),DIMSE(3,7),DCHEM(7),FDR(4,7), c 1 DMANR(7),AREA(7),PT(12),PR(7,9),PX(18,10),YREM(8),YX17PR, c 2 Y811PR,YTRANS(8),NOFHH(8),DX(18,10,10),DR(7,10,10),CBET(25), c 3 SR(7,10,10),SAVE(8),RINV(18,7),CINV(18,7),SX(12),CODEM(22,8), c 4 THETA(8),S1(8),S2(7),MUINV(7),PWAURB,YRDTRA,PVTBUD,CLOSS(5), c 5 DBUD(8),RINVPR(7),DTR(12,10),ST(12),DCONSD(21,8),CVFLAG(8), c 6 rallwd(7,10,10),reserv(100) C C include 'gblk.for' c COMMON /GBLK/GINV(18),HINV(18),GSNV(18),IINV(18),TINV(18), c 1 CONV(18),GOIRUR(7),GOIOTH(7),GOISOC,GOIIND,GOICON,GOITRA, c 2 GCSER(18),TAU(7),AVINTA(18),AVROTA(18),AVLOTA(18),PSI(3,7), c 3 PCH(7),GOIUR1(18),GOIUR2(18),GOVDEM(18),DTPTLO,DTPTFO,GLABCO, c 4 TRSUBS,TROPSS,TRILHH,FORAST,YGOVTO,GAMGOV(8),GOCON(18) C C include 'trblk.for' c COMMON /TRBLK/ CATR(12),CALFTR(12),EKTR(12),DRDTR(12),XTR include 'glblk.for' c COMMON /GLBLK/ GVIRUR,GVISOC,GVIIND,GVITRA,GVICON,GVITOT, c 1 GVCOMM,AGINPT,AVTAX,GOSER,GVBUD,GVSER,IMDUIN,IMDURO, c 2 SAVSPL,PGSVC,LTAX,GOVEMP C C INTEGER I,J REAL VFDR(7),TPV(7),PGNV(7),PHNV(7),GOIROL(7),GOIOOL(7), 1 vioco(18,4),vfoodx(11,7),vxlab(7),vgcser(18),vcprin(18,4), 2 vgsnv(18),viinv(18),vtinv(18),vhinv(18),vconv(18),vglabc, 3 vginv(18),qx(18) C c ----------------------------- C c data vioco/ c 1 7*0.,0.090353932,0.032099423,0.050407983,0.015217504,3*0., c 2 0.051239098,0.076955690,2*0., c 3 6*0.,0.010920369,0.035135101,0.013579242,0.024119772, c 4 0.000474799,3*0.,0.062109967,0.192512795,2*0., c 5 7*0.,0.005902807,0.025147577,0.231422397,0.152987832,3*0., c 6 0.056103865,0.039967798,2*0., c 7 7*0.,0.004660954,0.003015911,0.008499386,0.011515297,3*0., c 8 0.013815174,0.023783084,2*0./ c c coefficients for trade reduced 04-Sep-1989 (except for priv.serv.) c data vioco/ 1 7*0.,0.090353932,0.032099423,0.00,0.015217504,3*0., 2 0.051239098,0.076955690,2*0., 3 6*0.,0.010920369,0.035135101,0.00,0.024119772, 4 0.000474799,3*0.,0.062109967,0.192512795,2*0., 5 7*0.,0.005902807,0.025147577,0.15,0.152987832,3*0., 6 0.056103865,0.039967798,2*0., 7 7*0.,0.004660954,0.003015911,0.008499386,0.011515297,3*0., 8 0.013815174,0.023783084,2*0./ c data vfoodx /77*0./ c c data vginv /7*0.,0.014379572,0.700118419,0.010315780,0.010315780, c 1 5*0.,0.097945011,0.166925440/ data vginv /7*0.,0.014379572,0.700118419,0.0,0.010315780, 2 5*0.,0.097945011,0.166925440/ c data vhinv /7*0.,.0096,.6762,.0115,.0096,5*0., 3 .1437,.1494/ c c c data vcprin / c 1 7*0.,0.099976140,0.411891159,0.019758130,0.021997385,5*0., c 2 0.174292362,0.272084823, c 3 7*0.,0.075016835,0.570333468,0.010276279,0.016544809,5*0., c 4 0.036747288,0.291081322, c 5 7*0.,0.106101175,0.307233179,0.014677536,0.023384550,5*0., c 6 0.125421141,0.423182420, c 7 7*0.,0.066773678,0.890986127,0.009251775,0.014682164,5*0., c 8 0.006973810,0.011332446/ data vcprin / 1 7*0.,0.099976140,0.411891159,0.0,0.021997385,5*0., 2 0.174292362,0.272084823, 3 7*0.,0.075016835,0.570333468,0.0,0.016544809,5*0., 4 0.036747288,0.291081322, 5 7*0.,0.106101175,0.307233179,0.0,0.023384550,5*0., 6 0.125421141,0.423182420, 7 7*0.,0.066773678,0.890986127,0.0,0.014682164,5*0., 8 0.006973810,0.011332446/ c c data viinv / 7*0.,0.008955829,0.635936158,0.047769029,0.047769029, c 1 5*0.,0.097237744,0.162332212/ data viinv / 7*0.,0.008955829,0.635936158,0.0,0.047769029, 2 5*0.,0.097237744,0.162332212/ data vconv / 7*0.,0.000000000,0.645525114,0.000000000,0.107587519, 3 5*0.,0.135751921,0.111135446/ c data vtinv / 7*0.,0.010031444,0.708291435,0.012038159,0.010031444, c 4 5*0.,0.096050593,0.163556924/ data vtinv / 7*0.,0.010031444,0.708291435,0.0,0.010031444, 5 5*0.,0.096050593,0.163556924/ data vgsnv / 7*0.,0.021111243,0.833927045,0.000000000,0.000000000, 6 5*0.,0.078240458,0.066721254/ c c do 71 i=1,11 px(i,3) = px(i,8) + cbet(i+7) * pt(7) px(i,7) = px(i,8) + cbet(i+7) * pt(8) px(i,10) = px(i,8) + cbet(i+7) * pt(12) px(i,4) = px(i,7) + cbet(i+7) * pt(4) px(i,1) = px(i,3) + cbet(i+7) * pt(1) px(i,6) = px(i,3) + cbet(i+7) * pt(3) px(i,5) = px(i,6) + cbet(i+7) * pt(5) px(i,2) = px(i,5) + cbet(i+7) * pt(2) px(i,9) = px(i,6) + cbet(i+7) * pt(10) 71 continue c c vioco(1,1) = (35./113.)*529./(11098.-793.) vioco(2,1) = (63./113.)*529./(11098.-793.) vioco(3,1) = (15./113.)*529./(11098.-793.) vioco(4,1) = 0. vioco(5,1) = 0. vioco(6,1) = (53.3/718.5)*3082./(11098.-793.) vioco(7,1) = (665.2/718.5)*3082./(11098.-793.) c c xxx = ((2834.-23.)/(2834.-23.+752.-8.)) * (3866.-57.) do 1 j=1,4 vfoodx(1,j) = (14./18.)*21. / xxx vfoodx(2,j) = (5./6.)*7. / xxx vfoodx(3,j) = (7./9.)*10. / xxx vfoodx(8,j) = (19./25.)*42. / xxx vfoodx(9,j) = (19./25.)*15. / xxx vxlab(j) = (38./50.)*51. / xxx 1 continue c xxx = ( (752. - 8.)/(2834.-23.+752.-8.) ) * (3866.-57.) vxlab(5) = (12./50.)*51. / xxx vfoodx(1,5) = (4./18.)*21. / xxx vfoodx(2,5) = (1./6.)*7. / xxx vfoodx(3,5) = (2./9.)*10. / xxx vfoodx(8,5) = (6./25.)*42. / xxx vfoodx(9,5) = (6./25.)*15. / xxx c c vgcser(1) = (245./249.)*202. / (4915.-27.) vgcser(2) = 0. vgcser(3) = 0. vgcser(4) = 0. vgcser(5) = (4./249.)*202. / (4915.-27.) vgcser(6) = 0. vgcser(7) = 0. vgcser(8) = 220. / (4915.-27.) vgcser(9) = 37. / (4915.-27.) c vgcser(10) = 137. / (4915.-27.) vgcser(10) = 0. vgcser(11) = 75. / (4915.-27.) vgcser(12) = 0. vgcser(13) = 0. vgcser(14) = 0. vgcser(15) = 100. / (4915.-27.) vgcser(16) = 205. / (4915.-27.) vgcser(17) = 0. vgcser(18) = 0. c c vglabc = 3911. / (4915.-27.) c do 9 i=1,12 9 qx(i) = px(i,8) c qx(13) = px(13,9) qx(15) = px(15,9) qx(17) = px(17,9) qx(14) = px(14,10) qx(16) = px(16,10) qx(18) = px(18,10) c do 2 j=1,4 p = px(j+7,8)*(1.-avlota(j+7))/ 1 (1.+avinta(15)*vioco(15,j)+avrota(16)*vioco(16,j)) do 21 i = 1,7 ioco(i,j) = p * vioco(i,j)/pr(i,8) 21 continue c do 22 i = 8,18 22 ioco(i,j) = p * vioco(i,j) / qx(i) c c 2 continue c c do 3 j=1,5 p = px(j,8)*(1-avlota(j))/ 1 (1.+avinta(15)*vfoodx(8,j)+avrota(16)*vfoodx(9,j)) do 31 i = 1,11 31 ufoodx(i,j) = vfoodx(i,j) * p / qx(i+7) c uxlab(j) = vxlab(j) * p/(pwaurb*swage(1)) c 3 continue c do 4 i=1,18 gcser(i) = vgcser(i) / 1 ( (1+avinta(15)*vgcser(15)+avrota(16)*vgcser(16))*qx(i) ) ginv(i) = vginv(i) / 2 ( (1+avinta(17)*vginv(17)+avrota(18)*vginv(18)) * qx(i) ) gsnv(i) = vgsnv(i) / 3 ( (1+avinta(17)*vgsnv(17)+avrota(18)*vgsnv(18)) * qx(i) ) iinv(i) = viinv(i) / 4 ( (1+avinta(17)*viinv(17)+avrota(18)*viinv(18)) * qx(i) ) tinv(i) = vtinv(i) / 5 ( (1+avinta(17)*vtinv(17)+avrota(18)*vtinv(18)) * qx(i) ) conv(i) = vconv(i) / 6 ( (1+avinta(17)*vconv(17)+avrota(18)*vconv(18)) * qx(i) ) hinv(i) = vhinv(i) / 7 ( (1+avinta(17)*vhinv(17)+avrota(18)*vhinv(18)) * qx(i) ) c 4 continue c c do 5 j = 1,4 p = ( 1 + avinta(17)*vcprin(17,j)+avrota(18)*vcprin(18,j) ) do 51 i = 1,18 51 cuprin(i,j) = p * vcprin(i,j) / qx(i) 5 continue c c glabco = vglabc / 1 ( (1 + avinta(15)*vgcser(15)+avrota(16)*vgcser(16))* 2 pwaurb*swage(5) ) c c c ------------------------------------------- c c DO 1717 I = 1,7 GOIOOL(I) = 0. 1717 CONTINUE C GOIROL(1) = (2.81/490)*2759 GOIROL(2) = (40.72/490)*2759 GOIROL(3) = (68.80/490)*2759 GOIROL(4) = (4.21/490)*2759 GOIROL(5) = (162.86/490)*2759 GOIROL(6) = (103.90/490)*2759 GOIROL(7) = (106.70/490)*2759 C DR(1,8,10) = 0./PR(1,8) DR(2,8,10) = 0./PR(2,8) DR(3,8,10) = 0./PR(3,8) DR(4,8,10) = 0./PR(4,8) DR(5,8,10) = (2.41/189.63)*353/PR(5,8) DR(6,8,10) = (187.22/189.63)*353/PR(6,8) DR(7,8,10) = 0./PR(7,8) C DX(1,6,9) = (17.84671/378.36731)*314/PX(1,6) DX(2,6,9) = 0./PX(1,6) DX(3,6,9) = (248.4906/378.36731)*314/PX(3,6) DX(4,6,9) = (18.03/378.36731)*314/PX(4,6) DX(5,6,9) = (94./378.36731)*314/PX(5,6) DX(6,6,9) = 0./PX(6,6) DX(7,6,9) = 0./PX(7,6) C DX(1,8,10) = (106.93/107.93)*1315/PX(1,8) DX(5,8,10) = (1./107.93)*1315/PX(5,8) C DX( 8,6,9) = 2741./PX(8,6) DX(11,6,9) = 1759./PX(11,6) DX(10,6,9) = 974./PX(10,6) DX( 8,8,10) = 175/PX(8,8) DX(10,8,10) = 1405./PX(10,8) DX(11,8,10) = 2537./PX(11,8) C DTR(12,10) = CBET(1)*DR(1,8,10)+CBET(5)*DR(5,8,10)+ 1 CBET(6)*DR(6,8,10)+CBET(8)*DX(1,8,10)+CBET(15)*DX(8,8,10)+ 2 CBET(17)*DX(10,8,10)+CBET(18)*DX(11,8,10) C DTR(10,9) = CBET(8)*DX(1,6,9)+CBET(10)*DX(3,6,9)+ 1 CBET(11)*DX(4,6,9)+CBET(15)*DX(8,6,9)+CBET(18)*DX(11,6,9) XTR = 0.0 C DMANR(1) = (36/43.12)*5.256394 /PX(8,1) DMANR(2) = (36/43.12)*11.62070 /PX(8,2) DMANR(3) = (36/43.12)*7.492198 /PX(8,3) DMANR(4) = (36/43.12)*18.75339 /PX(8,4) DMANR(5) = (81/27.87)*9.023821 /PX(8,5) DMANR(6) = (81/27.87)*15.66232 /PX(8,6) DMANR(7) = (81/27.87)*3.191157 /PX(8,7) C C UPRINV(1) = 2220. / PUPRIN(1) UPRINV(2) = 1030./ PUPRIN(2) UPRINV(3) = 1561./ PUPRIN(3) UPRINV(4) = 6228. / PUPRIN(4) C poisoc = 0. poitra = 0. poicon = 0. poiind = 0. c do 135 i=1,7 poisoc = poisoc + pr(i,8) * gsnv(i) poitra = poitra + pr(i,8) * tinv(i) poicon = poicon + pr(i,8) * conv(i) poiind = poiind + pr(i,8) * iinv(i) 135 continue c do 136 i=8,18 poisoc = poisoc + px(i,8) * gsnv(i) poitra = poitra + px(i,8) * tinv(i) poicon = poicon + px(i,8) * conv(i) poiind = poiind + px(i,8) * iinv(i) 136 continue GOISOC = 955. / poiSOC GOITRA = 1778./ poiTRA GOICON = 67. / poiCON GOIIND = 1648./ poIIND C DO 201 I = 1,7 PGNV(I) = 0. PHNV(I) = 0. DO 202 J = 1,18 PGNV(I) = PGNV(I) + GINV(J)*PX(J,I) 202 CONTINUE GOIRUR(I) = GOIROL(I) / PGNV(I) 201 CONTINUE C c c Food to Cash deliveries distributed over regions according to LSU number c See i-o table 86/87. c Distribution within Food sectors according to gross production value. c tlsu = 0. do 91 i=1,7 tlsu = tlsu + grqr(7,i) 91 continue c do 200 i=1,7 vfdr(i) = ( grqr(7,i) / tlsu ) * 667. tpv(i) = pr(1,i) * grqr(1,i) + pr(2,i) * grqr(2,i) + 1 pr(3,i) * grqr(3,i) + pr(4,i) * grqr(4,i) do 2011 j=1,4 fdr(j,i) = grqr(j,i) * vfdr(i) / tpv(i) 2011 continue 200 continue c c Write (*,*) '* * * price per unit of investment * * *' Write (*,*) 'This come from Subroutine Modmojc , a Sam label 135' Write (*,*) ' PUPRIN(1),PUPRIN(2),PUPRIN(3),PUPRIN(4)' WRITE (*,*) PUPRIN(1),PUPRIN(2),PUPRIN(3),PUPRIN(4) WRITE (*,*) 'poiSOC,poiTRA,poiCON,poiIND' WRITE (*,*) poiSOC, poiTRA,poiCON,poiIND RETURN END C file 10 program makt0prgnew90 C C INITIALIZES VARIABLES FOR BASEYEAR C IMPLICIT REAL (A-Z) C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'glblk.for' include 'trblk.for' include 'blnblk.for' C INTEGER I,J,I1,J1 REAL VFDR(7),TPV(7),PGNV(7),PHNV(7),GOIROL(7),GOIOOL(7), 1 VIOCO(18,4),VFOODX(11,7),VXLAB(7),VGCSER(18),VCPRIN(18,4), 2 VGSNV(18),VIINV(18),VTINV(18),VHINV(18),VCONV(18),VGLABC, 3 VGINV(18),QX(18),DIMSED(3,7),DIMSES(3,7),DCHEMD(7),DCHEMS(7), 4 YTRANL(8),AREAL(7),PADOIS(7),avintal(18),avrotal(18), 5 avlotal(18), 6 PCHL(7),PSIL(3,7),NOFHHL(8),YREML(8),OLNHH8,OLARE(7), 7 UPRINL(4),NTXRV,DIRTAX,GOISOL,GOIINL,GOICOL,GOITRL C REAL BLKURB(328),BLKGEN(5169),BLKG(321),BLKGL(18),BLKTR(49), 1 BLKBLN(4) C EQUIVALENCE (CATR(1),BLKTR(1)),(GRQR(1,1),BLKGEN(1)), 1 (GINV(1),BLKG(1)),(GVIRUR,BLKGL(1)),(CALFUR(1),BLKURB(1)), 2 (XPRCN,BLKBLN(1)) C EQUIVALENCE (NTXRV,RESERV(20)),(PADOIS,RESERV(30)) C------------------------------------------- C data YREML/155.54,452.48,240.38,296.94,56.560,42.420,70.700, 1 98.980/ data nofhhl/.22574E+6,.32166E+6,.26850E+6,.20905E+6,. 1 34434E+6,.27034E+6,.17413E+6,.20853E+6/ c data YTRANL/15.775,6*31.550,1151.6/ data (avintal(i),i=13,17,2)/.68571E-1,.19428,.11565/ data (avrotal(i),i=14,18,2)/.42857,.72247E-1,.70224E-1/ data (avlotal(i),i=1,11)/7*.12041E-1,.70822E-1,.007,.14469E-1, 1 .92430E-2/ C do 9876 i=13,17,2 avrotal(i+1)= avrotal(i+1) * 252./187. 9876 avintal(i) = avintal(i) * 639./499. c avlotal(10) = 286./190. * avlotal(10) c pr(1,9) = 3. c pr(2,9) = 3. c pr(3,9) = 3. c pr(4,9) = 3.5 c pr(5,9) = 8. c pr(6,9) = 2. c pr(7,9) = 1000. c c Indian border prices increased 01-Sep-1989 c pr(1,9) = 2.838* 90./66.*13.8/15.3 pr(2,9) = 2.838* 90./66.*13.8/15.3 pr(3,9) = 2.838* 90./66.*13.8/15.3 pr(4,9) = 3.289* 90./66.*13.8/15.3 pr(5,9) = 7.48* 95. /87.*1.5 pr(6,9) = 1.87* 95. /87.*1.5 pr(7,9) = 1155.* 95. /87. c pr(7,9) = 1250.* 95. /87. c pr(7,9) = 1500.* 95. /87. c pr(7,9) = 1750.* 95. /87. c c c c c read(1,*) ((pr(i,j),i=1,7),j=1,8) c do 13 i=1,18 avinta(i) = avintal(i) avrota(i) = avrotal(i) avlota(i) = avlotal(i) 13 continue c CALL INICOESR CALL EXODATSR c read(1,*) (px(i,8),i=1,11) c px(12,8) = 1. do 261 i=0,4,2 PX(I+13,9) = 1. px(i+14,10) = 1. 261 continue c c CALL MODMOJC c c TROPSS=1151.6 TROPSS=749.3 TRSUBS=0. DTPTLO=0. DTPTFO=2063.7 C c original FORAST=5905.1 FORAST=8576 C first run value C C FORAST=4428.82 C C increase FORAST 33% C C FORAST=5905.1 c Increase in aid by 10 percent c c FORAST=6495.6 C Decrease in aid by 10 percent (SYM RUN 5) c c FORAST=5314.59 C NTXRV=1602.7 DIRTAX=768.7 C C C TRILHH = 0. DO 17 I = 1,8 17 TRILHH = TRILHH + YTRANL(I) C C DO 207 I= 1,8 YTRANS(I) = YTRANL(I) YREM(I) = YREML(I) NOFHH(I) = NOFHHL(I) 207 CONTINUE C SLAURB = NOFHH(8) C C TOTAR = 0. DO 533 I=1,7 TOTAR = TOTAR + AREA(I) 533 CONTINUE C DO 534 I=1,7 TAU(I) = DIRTAX / TOTAR 534 CONTINUE C DO 535 I=1,7 DTPTFO = DTPTFO + PCH(I)*DCHEM(I) DO 5351 J=1,5 DTPTFO = DTPTFO + PSI(J,I)*DIMSE(J,I) 5351 CONTINUE 535 CONTINUE C C RESERV(20) = NTXRV C C C C FDR IS KEPT UNCHANGED, LIKE LSU C WRITE(4)(BLKURB(I),I=1,256) WRITE(4)(BLKURB(I),I=257,328) C J=0 2 WRITE(4)(BLKGEN(I+J*256),I=1,256) J=J+1 IF (J.LE.19) GOTO 2 C WRITE(4)(BLKGEN(I+5120),I=1,149) C WRITE(4)(BLKG(I),I=1,256) WRITE(4)(BLKG(I),I=257,321) C WRITE(4) BLKGL WRITE(4) BLKTR WRITE(4) BLKBLN C CLOSE(4) C END C file 11 program makt0prg C C INITIALIZES VARIABLES FOR BASEYEAR C c IMPLICIT REAL (A-Z) C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'glblk.for' include 'trblk.for' include 'blnblk.for' C INTEGER I,J,I1,J1 REAL VFDR(7),TPV(7),PGNV(7),PHNV(7),GOIROL(7),GOIOOL(7), 1 VIOCO(18,4),VFOODX(11,7),VXLAB(7),VGCSER(18),VCPRIN(18,4), 2 VGSNV(18),VIINV(18),VTINV(18),VHINV(18),VCONV(18),VGLABC, 3 VGINV(18),QX(18),DIMSED(3,7),DIMSES(3,7),DCHEMD(7),DCHEMS(7), 4 YTRANL(8),AREAL(7),PADOIS(7),avintal(18),avrotal(18), 5 avlotal(18), 6 PCHL(7),PSIL(3,7),NOFHHL(8),YREML(8),OLNHH8,OLARE(7), 7 UPRINL(4),NTXRV,DIRTAX,GOISOL,GOIINL,GOICOL,GOITRL C REAL BLKURB(328),BLKGEN(5169),BLKG(321),BLKGL(18),BLKTR(49), 1 BLKBLN(4) C EQUIVALENCE (CATR(1),BLKTR(1)),(GRQR(1,1),BLKGEN(1)), 1 (GINV(1),BLKG(1)),(GVIRUR,BLKGL(1)),(CALFUR(1),BLKURB(1)), 2 (XPRCN,BLKBLN(1)) C EQUIVALENCE (NTXRV,RESERV(20)),(PADOIS,RESERV(30)) C------------------------------------------- C data YREML/155.54,452.48,240.38,296.94,56.560,42.420,70.700, 1 98.980/ data nofhhl/.22574E+6,.32166E+6,.26850E+6,.20905E+6,. 1 34434E+6,.27034E+6,.17413E+6,.20853E+6/ c data YTRANL/15.775,6*31.550,1151.6/ data (avintal(i),i=13,17,2)/.68571E-1,.19428,.11565/ data (avrotal(i),i=14,18,2)/.42857,.72247E-1,.70224E-1/ data (avlotal(i),i=1,11)/7*.12041E-1,.70822E-1,.007,.14469E-1, 1 .92430E-2/ C do 9876 i=13,17,2 avrotal(i+1)= avrotal(i+1) * 252./187. 9876 avintal(i) = avintal(i) * 639./499. c avlotal(10) = 286./190. * avlotal(10) c pr(1,9) = 3. c pr(2,9) = 3. c pr(3,9) = 3. c pr(4,9) = 3.5 c pr(5,9) = 8. c pr(6,9) = 2. c pr(7,9) = 1000. c c Indian border prices increased 01-Sep-1989 c pr(1,9) = 3.112 * 90./66.*13.8/15.3 pr(2,9) = 3.112 * 90./66.*13.8/15.3 pr(3,9) = 3.112 * 90./66.*13.8/15.3 pr(4,9) = 3.618* 90./66.*13.8/15.3 pr(5,9) = 8.228 * 95. /87.*1.5 pr(6,9) = 2.057 * 95. /87.*1.5 pr(7,9) = 1270.5* 95. /87. c pr(7,9) = 1250.* 95. /87. c pr(7,9) = 1500.* 95. /87. c pr(7,9) = 1750.* 95. /87. c c c c c read(1,*) ((pr(i,j),i=1,7),j=1,8) c do 13 i=1,18 avinta(i) = avintal(i) avrota(i) = avrotal(i) avlota(i) = avlotal(i) 13 continue c CALL INICOESR CALL EXODATSR c read(1,*) (px(i,8),i=1,11) c px(12,8) = 1. do 261 i=0,4,2 PX(I+13,9) = 1. px(i+14,10) = 1. 261 continue c c CALL MODMOJC c c TROPSS=1151.6 TROPSS=749.3 TRSUBS=0. DTPTLO=0. DTPTFO=2063.7 C c original FORAST=5905.1 FORAST=12566 C first run value C C FORAST=4428.82 C C increase FORAST 33% C C FORAST=5905.1 c Increase in aid by 10 percent c c FORAST=6495.6 C Decrease in aid by 10 percent (SYM RUN 5) c c FORAST=5314.59 C NTXRV=1602.7 DIRTAX=768.7 C C C TRILHH = 0. DO 17 I = 1,8 17 TRILHH = TRILHH + YTRANL(I) C C DO 207 I= 1,8 YTRANS(I) = YTRANL(I) YREM(I) = YREML(I) NOFHH(I) = NOFHHL(I) 207 CONTINUE C SLAURB = NOFHH(8) C C TOTAR = 0. DO 533 I=1,7 TOTAR = TOTAR + AREA(I) 533 CONTINUE C DO 534 I=1,7 TAU(I) = DIRTAX / TOTAR 534 CONTINUE C DO 535 I=1,7 DTPTFO = DTPTFO + PCH(I)*DCHEM(I) DO 5351 J=1,5 DTPTFO = DTPTFO + PSI(J,I)*DIMSE(J,I) 5351 CONTINUE 535 CONTINUE C C RESERV(20) = NTXRV C C C C FDR IS KEPT UNCHANGED, LIKE LSU C WRITE(4)(BLKURB(I),I=1,256) WRITE(4)(BLKURB(I),I=257,328) C J=0 2 WRITE(4)(BLKGEN(I+J*256),I=1,256) J=J+1 IF (J.LE.19) GOTO 2 C WRITE(4)(BLKGEN(I+5120),I=1,149) C WRITE(4)(BLKG(I),I=1,256) WRITE(4)(BLKG(I),I=257,321) C WRITE(4) BLKGL WRITE(4) BLKTR WRITE(4) BLKBLN C CLOSE(4) C END C file 12 program makt0prg C C INITIALIZES VARIABLES FOR BASEYEAR C c IMPLICIT REAL (A-Z) C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'glblk.for' include 'trblk.for' include 'blnblk.for' C INTEGER I,J,I1,J1 REAL VFDR(7),TPV(7),PGNV(7),PHNV(7),GOIROL(7),GOIOOL(7), 1 VIOCO(18,4),VFOODX(11,7),VXLAB(7),VGCSER(18),VCPRIN(18,4), 2 VGSNV(18),VIINV(18),VTINV(18),VHINV(18),VCONV(18),VGLABC, 3 VGINV(18),QX(18),DIMSED(3,7),DIMSES(3,7),DCHEMD(7),DCHEMS(7), 4 YTRANL(8),AREAL(7),PADOIS(7),avintal(18),avrotal(18), 5 avlotal(18), 6 PCHL(7),PSIL(3,7),NOFHHL(8),YREML(8),OLNHH8,OLARE(7), 7 UPRINL(4),NTXRV,DIRTAX,GOISOL,GOIINL,GOICOL,GOITRL C REAL BLKURB(328),BLKGEN(5169),BLKG(321),BLKGL(18),BLKTR(49), 1 BLKBLN(4) C EQUIVALENCE (CATR(1),BLKTR(1)),(GRQR(1,1),BLKGEN(1)), 1 (GINV(1),BLKG(1)),(GVIRUR,BLKGL(1)),(CALFUR(1),BLKURB(1)), 2 (XPRCN,BLKBLN(1)) C EQUIVALENCE (NTXRV,RESERV(20)),(PADOIS,RESERV(30)) C------------------------------------------- C data YREML/155.54,452.48,240.38,296.94,56.560,42.420,70.700, 1 98.980/ data nofhhl/.22574E+6,.32166E+6,.26850E+6,.20905E+6,. 1 34434E+6,.27034E+6,.17413E+6,.20853E+6/ c data YTRANL/15.775,6*31.550,1151.6/ data (avintal(i),i=13,17,2)/.68571E-1,.19428,.11565/ data (avrotal(i),i=14,18,2)/.42857,.72247E-1,.70224E-1/ data (avlotal(i),i=1,11)/7*.12041E-1,.70822E-1,.007,.14469E-1, 1 .92430E-2/ C do 9876 i=13,17,2 avrotal(i+1)= avrotal(i+1) * 252./187. 9876 avintal(i) = avintal(i) * 639./499. c avlotal(10) = 286./190. * avlotal(10) c pr(1,9) = 3. c pr(2,9) = 3. c pr(3,9) = 3. c pr(4,9) = 3.5 c pr(5,9) = 8. c pr(6,9) = 2. c pr(7,9) = 1000. c c Indian border prices increased 01-Sep-1989 c pr(1,9) = 3.112 * 90./66.*13.8/15.3 pr(2,9) = 3.112 * 90./66.*13.8/15.3 pr(3,9) = 3.112 * 90./66.*13.8/15.3 pr(4,9) = 3.618* 90./66.*13.8/15.3 pr(5,9) = 8.228 * 95. /87.*1.5 pr(6,9) = 2.057 * 95. /87.*1.5 pr(7,9) = 1270.5* 95. /87. c pr(7,9) = 1250.* 95. /87. c pr(7,9) = 1500.* 95. /87. c pr(7,9) = 1750.* 95. /87. c c c c c read(1,*) ((pr(i,j),i=1,7),j=1,8) c do 13 i=1,18 avinta(i) = avintal(i) avrota(i) = avrotal(i) avlota(i) = avlotal(i) 13 continue c CALL INICOESR CALL EXODATSR c read(1,*) (px(i,8),i=1,11) c px(12,8) = 1. do 261 i=0,4,2 PX(I+13,9) = 1. px(i+14,10) = 1. 261 continue c c CALL MODMOJC c c TROPSS=1151.6 TROPSS=749.3 TRSUBS=0. DTPTLO=0. DTPTFO=2063.7 C c original FORAST=5905.1 FORAST=12566 C first run value C C FORAST=4428.82 C C increase FORAST 33% C C FORAST=5905.1 c Increase in aid by 10 percent c c FORAST=6495.6 C Decrease in aid by 10 percent (SYM RUN 5) c c FORAST=5314.59 C NTXRV=1602.7 DIRTAX=768.7 C C C TRILHH = 0. DO 17 I = 1,8 17 TRILHH = TRILHH + YTRANL(I) C C DO 207 I= 1,8 YTRANS(I) = YTRANL(I) YREM(I) = YREML(I) NOFHH(I) = NOFHHL(I) 207 CONTINUE C SLAURB = NOFHH(8) C C TOTAR = 0. DO 533 I=1,7 TOTAR = TOTAR + AREA(I) 533 CONTINUE C DO 534 I=1,7 TAU(I) = DIRTAX / TOTAR 534 CONTINUE C DO 535 I=1,7 DTPTFO = DTPTFO + PCH(I)*DCHEM(I) DO 5351 J=1,5 DTPTFO = DTPTFO + PSI(J,I)*DIMSE(J,I) 5351 CONTINUE 535 CONTINUE C C RESERV(20) = NTXRV C C C C FDR IS KEPT UNCHANGED, LIKE LSU C WRITE(4)(BLKURB(I),I=1,256) WRITE(4)(BLKURB(I),I=257,328) C J=0 2 WRITE(4)(BLKGEN(I+J*256),I=1,256) J=J+1 IF (J.LE.19) GOTO 2 C WRITE(4)(BLKGEN(I+5120),I=1,149) C WRITE(4)(BLKG(I),I=1,256) WRITE(4)(BLKG(I),I=257,321) C WRITE(4) BLKGL WRITE(4) BLKTR WRITE(4) BLKBLN C CLOSE(4) C END C file 13 program makt0prg C C INITIALIZES VARIABLES FOR BASEYEAR C c IMPLICIT REAL (A-Z) C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'glblk.for' include 'trblk.for' include 'blnblk.for' C INTEGER I,J,I1,J1 REAL VFDR(7),TPV(7),PGNV(7),PHNV(7),GOIROL(7),GOIOOL(7), 1 VIOCO(18,4),VFOODX(11,7),VXLAB(7),VGCSER(18),VCPRIN(18,4), 2 VGSNV(18),VIINV(18),VTINV(18),VHINV(18),VCONV(18),VGLABC, 3 VGINV(18),QX(18),DIMSED(3,7),DIMSES(3,7),DCHEMD(7),DCHEMS(7), 4 YTRANL(8),AREAL(7),PADOIS(7),avintal(18),avrotal(18), 5 avlotal(18), 6 PCHL(7),PSIL(3,7),NOFHHL(8),YREML(8),OLNHH8,OLARE(7), 7 UPRINL(4),NTXRV,DIRTAX,GOISOL,GOIINL,GOICOL,GOITRL C REAL BLKURB(328),BLKGEN(5169),BLKG(321),BLKGL(18),BLKTR(49), 1 BLKBLN(4) C EQUIVALENCE (CATR(1),BLKTR(1)),(GRQR(1,1),BLKGEN(1)), 1 (GINV(1),BLKG(1)),(GVIRUR,BLKGL(1)),(CALFUR(1),BLKURB(1)), 2 (XPRCN,BLKBLN(1)) C EQUIVALENCE (NTXRV,RESERV(20)),(PADOIS,RESERV(30)) C------------------------------------------- C data YREML/155.54,452.48,240.38,296.94,56.560,42.420,70.700, 1 98.980/ data nofhhl/.22574E+6,.32166E+6,.26850E+6,.20905E+6,. 1 34434E+6,.27034E+6,.17413E+6,.20853E+6/ c data YTRANL/15.775,6*31.550,1151.6/ data (avintal(i),i=13,17,2)/.68571E-1,.19428,.11565/ data (avrotal(i),i=14,18,2)/.42857,.72247E-1,.70224E-1/ data (avlotal(i),i=1,11)/7*.12041E-1,.70822E-1,.007,.14469E-1, 1 .92430E-2/ C do 9876 i=13,17,2 avrotal(i+1)= avrotal(i+1) * 252./187. 9876 avintal(i) = avintal(i) * 639./499. c avlotal(10) = 286./190. * avlotal(10) c pr(1,9) = 3. c pr(2,9) = 3. c pr(3,9) = 3. c pr(4,9) = 3.5 c pr(5,9) = 8. c pr(6,9) = 2. c pr(7,9) = 1000. c c Indian border prices increased 01-Sep-1989 c pr(1,9) = 3.777 * 90./66.*13.8/15.3 pr(2,9) = 3.777 * 90./66.*13.8/15.3 pr(3,9) = 3.777 * 90./66.*13.8/15.3 pr(4,9) = 3.378* 90./66.*13.8/15.3 pr(5,9) = 9.956 * 95. /87.*1.5 pr(6,9) = 2.489 * 95. /87.*1.5 pr(7,9) = 1537.3* 95. /87. c pr(7,9) = 1250.* 95. /87. c pr(7,9) = 1500.* 95. /87. c pr(7,9) = 1750.* 95. /87. c c c c c read(1,*) ((pr(i,j),i=1,7),j=1,8) c do 13 i=1,18 avinta(i) = avintal(i) avrota(i) = avrotal(i) avlota(i) = avlotal(i) 13 continue c CALL INICOESR CALL EXODATSR c read(1,*) (px(i,8),i=1,11) c px(12,8) = 1. do 261 i=0,4,2 PX(I+13,9) = 1. px(i+14,10) = 1. 261 continue c c CALL MODMOJC c c TROPSS=1151.6 TROPSS=749.3 TRSUBS=0. DTPTLO=0. DTPTFO=2063.7 C c original FORAST=5905.1 FORAST=17860 C first run value C C FORAST=4428.82 C C increase FORAST 33% C C FORAST=5905.1 c Increase in aid by 10 percent c c FORAST=6495.6 C Decrease in aid by 10 percent (SYM RUN 5) c c FORAST=5314.59 C NTXRV=1602.7 DIRTAX=768.7 C C C TRILHH = 0. DO 17 I = 1,8 17 TRILHH = TRILHH + YTRANL(I) C C DO 207 I= 1,8 YTRANS(I) = YTRANL(I) YREM(I) = YREML(I) NOFHH(I) = NOFHHL(I) 207 CONTINUE C SLAURB = NOFHH(8) C C TOTAR = 0. DO 533 I=1,7 TOTAR = TOTAR + AREA(I) 533 CONTINUE C DO 534 I=1,7 TAU(I) = DIRTAX / TOTAR 534 CONTINUE C DO 535 I=1,7 DTPTFO = DTPTFO + PCH(I)*DCHEM(I) DO 5351 J=1,5 DTPTFO = DTPTFO + PSI(J,I)*DIMSE(J,I) 5351 CONTINUE 535 CONTINUE C C RESERV(20) = NTXRV C C C C FDR IS KEPT UNCHANGED, LIKE LSU C WRITE(4)(BLKURB(I),I=1,256) WRITE(4)(BLKURB(I),I=257,328) C J=0 2 WRITE(4)(BLKGEN(I+J*256),I=1,256) J=J+1 IF (J.LE.19) GOTO 2 C WRITE(4)(BLKGEN(I+5120),I=1,149) C WRITE(4)(BLKG(I),I=1,256) WRITE(4)(BLKG(I),I=257,321) C WRITE(4) BLKGL WRITE(4) BLKTR WRITE(4) BLKBLN C CLOSE(4) C END C file 14 program makt0prg C C INITIALIZES VARIABLES FOR BASEYEAR C c IMPLICIT REAL (A-Z) C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'glblk.for' include 'trblk.for' include 'blnblk.for' C INTEGER I,J,I1,J1 REAL VFDR(7),TPV(7),PGNV(7),PHNV(7),GOIROL(7),GOIOOL(7), 1 VIOCO(18,4),VFOODX(11,7),VXLAB(7),VGCSER(18),VCPRIN(18,4), 2 VGSNV(18),VIINV(18),VTINV(18),VHINV(18),VCONV(18),VGLABC, 3 VGINV(18),QX(18),DIMSED(3,7),DIMSES(3,7),DCHEMD(7),DCHEMS(7), 4 YTRANL(8),AREAL(7),PADOIS(7),avintal(18),avrotal(18), 5 avlotal(18), 6 PCHL(7),PSIL(3,7),NOFHHL(8),YREML(8),OLNHH8,OLARE(7), 7 UPRINL(4),NTXRV,DIRTAX,GOISOL,GOIINL,GOICOL,GOITRL C REAL BLKURB(328),BLKGEN(5169),BLKG(321),BLKGL(18),BLKTR(49), 1 BLKBLN(4) C EQUIVALENCE (CATR(1),BLKTR(1)),(GRQR(1,1),BLKGEN(1)), 1 (GINV(1),BLKG(1)),(GVIRUR,BLKGL(1)),(CALFUR(1),BLKURB(1)), 2 (XPRCN,BLKBLN(1)) C EQUIVALENCE (NTXRV,RESERV(20)),(PADOIS,RESERV(30)) C------------------------------------------- C data YREML/155.54,452.48,240.38,296.94,56.560,42.420,70.700, 1 98.980/ data nofhhl/.22574E+6,.32166E+6,.26850E+6,.20905E+6,. 1 34434E+6,.27034E+6,.17413E+6,.20853E+6/ c data YTRANL/15.775,6*31.550,1151.6/ data (avintal(i),i=13,17,2)/.68571E-1,.19428,.11565/ data (avrotal(i),i=14,18,2)/.42857,.72247E-1,.70224E-1/ data (avlotal(i),i=1,11)/7*.12041E-1,.70822E-1,.007,.14469E-1, 1 .92430E-2/ C do 9876 i=13,17,2 avrotal(i+1)= avrotal(i+1) * 252./187. 9876 avintal(i) = avintal(i) * 639./499. c avlotal(10) = 286./190. * avlotal(10) c pr(1,9) = 3. c pr(2,9) = 3. c pr(3,9) = 3. c pr(4,9) = 3.5 c pr(5,9) = 8. c pr(6,9) = 2. c pr(7,9) = 1000. c c Indian border prices increased 01-Sep-1989 c pr(1,9) = 4.155 * 90./66.*13.8/15.3 pr(2,9) = 4.155 * 90./66.*13.8/15.3 pr(3,9) = 4.155 * 90./66.*13.8/15.3 pr(4,9) = 4.815* 90./66.*13.8/15.3 pr(5,9) = 10.951 * 95. /87.*1.5 pr(6,9) = 2.738 * 95. /87.*1.5 pr(7,9) = 1691.* 95. /87. c pr(7,9) = 1250.* 95. /87. c pr(7,9) = 1500.* 95. /87. c pr(7,9) = 1750.* 95. /87. c c c c c read(1,*) ((pr(i,j),i=1,7),j=1,8) c do 13 i=1,18 avinta(i) = avintal(i) avrota(i) = avrotal(i) avlota(i) = avlotal(i) 13 continue c CALL INICOESR CALL EXODATSR c read(1,*) (px(i,8),i=1,11) c px(12,8) = 1. do 261 i=0,4,2 PX(I+13,9) = 1. px(i+14,10) = 1. 261 continue c c CALL MODMOJC c c TROPSS=1151.6 TROPSS=749.3 TRSUBS=0. DTPTLO=0. DTPTFO=2063.7 C c original FORAST=5905.1 FORAST=20914 C first run value C C FORAST=4428.82 C C increase FORAST 33% C C FORAST=5905.1 c Increase in aid by 10 percent c c FORAST=6495.6 C Decrease in aid by 10 percent (SYM RUN 5) c c FORAST=5314.59 C NTXRV=1602.7 DIRTAX=768.7 C C C TRILHH = 0. DO 17 I = 1,8 17 TRILHH = TRILHH + YTRANL(I) C C DO 207 I= 1,8 YTRANS(I) = YTRANL(I) YREM(I) = YREML(I) NOFHH(I) = NOFHHL(I) 207 CONTINUE C SLAURB = NOFHH(8) C C TOTAR = 0. DO 533 I=1,7 TOTAR = TOTAR + AREA(I) 533 CONTINUE C DO 534 I=1,7 TAU(I) = DIRTAX / TOTAR 534 CONTINUE C DO 535 I=1,7 DTPTFO = DTPTFO + PCH(I)*DCHEM(I) DO 5351 J=1,5 DTPTFO = DTPTFO + PSI(J,I)*DIMSE(J,I) 5351 CONTINUE 535 CONTINUE C C RESERV(20) = NTXRV C C C C FDR IS KEPT UNCHANGED, LIKE LSU C WRITE(4)(BLKURB(I),I=1,256) WRITE(4)(BLKURB(I),I=257,328) C J=0 2 WRITE(4)(BLKGEN(I+J*256),I=1,256) J=J+1 IF (J.LE.19) GOTO 2 C WRITE(4)(BLKGEN(I+5120),I=1,149) C WRITE(4)(BLKG(I),I=1,256) WRITE(4)(BLKG(I),I=257,321) C WRITE(4) BLKGL WRITE(4) BLKTR WRITE(4) BLKBLN C CLOSE(4) C END C file 15 program makt0prg C C INITIALIZES VARIABLES FOR BASEYEAR C c IMPLICIT REAL (A-Z) C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'glblk.for' include 'trblk.for' include 'blnblk.for' C INTEGER I,J,I1,J1 REAL VFDR(7),TPV(7),PGNV(7),PHNV(7),GOIROL(7),GOIOOL(7), 1 VIOCO(18,4),VFOODX(11,7),VXLAB(7),VGCSER(18),VCPRIN(18,4), 2 VGSNV(18),VIINV(18),VTINV(18),VHINV(18),VCONV(18),VGLABC, 3 VGINV(18),QX(18),DIMSED(3,7),DIMSES(3,7),DCHEMD(7),DCHEMS(7), 4 YTRANL(8),AREAL(7),PADOIS(7),avintal(18),avrotal(18), 5 avlotal(18), 6 PCHL(7),PSIL(3,7),NOFHHL(8),YREML(8),OLNHH8,OLARE(7), 7 UPRINL(4),NTXRV,DIRTAX,GOISOL,GOIINL,GOICOL,GOITRL C REAL BLKURB(328),BLKGEN(5169),BLKG(321),BLKGL(18),BLKTR(49), 1 BLKBLN(4) C EQUIVALENCE (CATR(1),BLKTR(1)),(GRQR(1,1),BLKGEN(1)), 1 (GINV(1),BLKG(1)),(GVIRUR,BLKGL(1)),(CALFUR(1),BLKURB(1)), 2 (XPRCN,BLKBLN(1)) C EQUIVALENCE (NTXRV,RESERV(20)),(PADOIS,RESERV(30)) C------------------------------------------- C data YREML/155.54,452.48,240.38,296.94,56.560,42.420,70.700, 1 98.980/ data nofhhl/.22574E+6,.32166E+6,.26850E+6,.20905E+6,. 1 34434E+6,.27034E+6,.17413E+6,.20853E+6/ c data YTRANL/15.775,6*31.550,1151.6/ data (avintal(i),i=13,17,2)/.68571E-1,.19428,.11565/ data (avrotal(i),i=14,18,2)/.42857,.72247E-1,.70224E-1/ data (avlotal(i),i=1,11)/7*.12041E-1,.70822E-1,.007,.14469E-1, 1 .92430E-2/ C do 9876 i=13,17,2 avrotal(i+1)= avrotal(i+1) * 252./187. 9876 avintal(i) = avintal(i) * 639./499. c avlotal(10) = 286./190. * avlotal(10) c pr(1,9) = 3. c pr(2,9) = 3. c pr(3,9) = 3. c pr(4,9) = 3.5 c pr(5,9) = 8. c pr(6,9) = 2. c pr(7,9) = 1000. c c Indian border prices increased 01-Sep-1989 c pr(1,9) = 2.60* 90./66.*13.8/15.3 pr(2,9) = 2.65* 90./66.*13.8/15.3 pr(3,9) = 3.* 90./66.*13.8/15.3 pr(4,9) = 2.99* 90./66.*13.8/15.3 pr(5,9) = 8.* 95. /87.*1.5 pr(6,9) = 2.* 95. /87.*1.5 pr(7,9) = 1025.* 95. /87. c pr(7,9) = 1250.* 95. /87. c pr(7,9) = 1500.* 95. /87. c pr(7,9) = 1750.* 95. /87. c c c c c read(1,*) ((pr(i,j),i=1,7),j=1,8) c do 13 i=1,18 avinta(i) = avintal(i) avrota(i) = avrotal(i) avlota(i) = avlotal(i) 13 continue c CALL INICOESR CALL EXODATSR c read(1,*) (px(i,8),i=1,11) c px(12,8) = 1. do 261 i=0,4,2 PX(I+13,9) = 1. px(i+14,10) = 1. 261 continue c c CALL MODMOJC c c TROPSS=1151.6 TROPSS=749.3 TRSUBS=0. DTPTLO=0. DTPTFO=2063.7 C c original FORAST=5905.1 FORAST=9730.1 C first run value C C FORAST=4428.82 C C increase FORAST 33% C C FORAST=5905.1 c Increase in aid by 10 percent c c FORAST=6495.6 C Decrease in aid by 10 percent (SYM RUN 5) c c FORAST=5314.59 C NTXRV=1602.7 DIRTAX=768.7 C C C TRILHH = 0. DO 17 I = 1,8 17 TRILHH = TRILHH + YTRANL(I) C C DO 207 I= 1,8 YTRANS(I) = YTRANL(I) YREM(I) = YREML(I) NOFHH(I) = NOFHHL(I) 207 CONTINUE C SLAURB = NOFHH(8) C C TOTAR = 0. DO 533 I=1,7 TOTAR = TOTAR + AREA(I) 533 CONTINUE C DO 534 I=1,7 TAU(I) = DIRTAX / TOTAR 534 CONTINUE C DO 535 I=1,7 DTPTFO = DTPTFO + PCH(I)*DCHEM(I) DO 5351 J=1,5 DTPTFO = DTPTFO + PSI(J,I)*DIMSE(J,I) 5351 CONTINUE 535 CONTINUE C C RESERV(20) = NTXRV C C C C FDR IS KEPT UNCHANGED, LIKE LSU C WRITE(4)(BLKURB(I),I=1,256) WRITE(4)(BLKURB(I),I=257,328) C J=0 2 WRITE(4)(BLKGEN(I+J*256),I=1,256) J=J+1 IF (J.LE.19) GOTO 2 C WRITE(4)(BLKGEN(I+5120),I=1,149) C WRITE(4)(BLKG(I),I=1,256) WRITE(4)(BLKG(I),I=257,321) C WRITE(4) BLKGL WRITE(4) BLKTR WRITE(4) BLKBLN C CLOSE(4) C END C file 16 4.3228 4.1909 3.4643 4.0778 13.650 2.5908 1631.7 3.9868 3.3068 3.3068 4.6163 13.400 2.4371 1630.3 3.8928 3.8074 3.8943 4.5078 13.220 3.5325 1640.3 4.0328 3.3727 3.4328 4.0478 12.846 2.5296 1632.8 3.6468 3.6468 3.6468 4.3478 13.060 3.1817 1637.1 3.7328 3.6469 3.7332 4.3478 13.060 3.1818 1637.1 3.7328 3.6727 3.7328 4.3478 13.146 3.1866 1638.8 3.9620 3.8933 3.9696 4.5805 13.350 3.6799 1642.8 7.4842 5.2584 6.3351 6.1866 55.188 3.7250 1662.8 2.3365 1.0868 1.3673 1.6478 C file 17 C C C SUBROUTINES For price bounds C C C SUBROUTINE PRICH(DIS0,PRH,IDRH) IMPLICIT REAL (A,Z) LOGICAL RALLWD REAL PRH(7),A INTEGER N,DIS(4),WEG(4),IDRH(7),I,J,K,DIS0 C include 'genblk.for' c c COMMON /GENBLK/GRQR(7,7),SLOC(5,7),DIMSE(3,7),DCHEM(7),FDR(4,7), c 1 DMANR(7),AREA(7),PT(12),PR(7,9),PX(18,10),YREM(8),YX17PR, c 2 Y811PR,YTRANS(8),NOFHH(8),DX(18,10,10),DR(7,10,10),CBET(25), c 3 SR(7,10,10),SAVE(8),RINV(18,7),CINV(18,7),SX(12),CODEM(22,8), c 4 THETA(8),S1(8),S2(7),MUINV(7),PWAURB,YRDTRA,PVTBUD,CLOSS(5), c 5 DBUD(8),RINVPR(7),DTR(12,10),ST(12),DCONSD(21,8),CVFLAG(8) c 6 RALLWD(7,10,10),reserv(100) C include 'blnblk.for' c C c common xprcn,slaurb,iprsvc,iprtra,shrsr(7,10,10),shrdr(7,10,10), c 1 shrdx(18,10,10) C if (dis0 .eq. 1) then c do 1 i=1,7 idrh(i) = 1 prh(i) = pr(i,3) + cbet(i) * pt(1) 1 continue c else if (dis0 .eq. 2) then c do 2 i=1,7 idrh(i) = 1 prh(i) = pr(i,5) + cbet(i) * pt(2) 2 continue c else if (dis0 .eq. 3) then c do 3 i = 1,7 idrh(i) = 0 prh(i) = shrdr(i,8,3)*(pr(i,8)+cbet(i)*pt(7)) + 1 shrdr(i,6,3)*(pr(i,6)+cbet(i)*pt(3)) 3 continue c else if (dis0 .eq. 4) then c do 4 i=1,7 idrh(i) = 1 prh(i) = pr(i,7) + cbet(i) * pt(4) 4 continue c else if (dis0 .eq. 5) then c do 5 if i=1,7 idrh(i) = 0 prh(i) = shrdr(i,9,5)*(pr(i,9)+cbet(i)*pt(9)) + 1 shrdr(i,6,5)*(pr(i,6)+cbet(i)*pt(5)) 5 continue c else if (dis0 .eq. 6) then c do 6 i=1,7 idrh(i) = 0 prh(i) = shrdr(i,9,6)*(pr(i,9)+cbet(I)*pt(10)) + 1 shrdr(i,3,6)*(pr(i,3)+cbet(I)*pt(3)) 6 continue c else if (dis0 .eq. 7) then c do 7 if i=1,7 idrh(i) = 0 prh(i) = shrdr(i,8,7)*(pr(i,8)+cbet(I)*pt(8)) + 1 shrdr(i,9,7)*(pr(i,9)+cbet(I)*pt(11)) + 2 shrdr(i,4,7)*(pr(i,4)+cbet(I)*pt(4)) 7 continue c else if (dis0 .eq. 8) then c do 8 i=1,7 idrh(i) = 0 prh(i) = shrdr(i,3,8)*(pr(i,3)+cbet(I)*pt(7)) + 1 shrdr(i,7,8)*(pr(i,7)+cbet(I)*pt(8)) 8 continue c endif c c c return end c SUBROUTINE PRICl(DIS0,PRl,IDRl) IMPLICIT REAL (A-Z) LOGICAL RALLWD REAL PRl(7) INTEGER N,DIS(4),WEG(4),IDRl(7),I,J,K,DIS0 C include 'genblk.for' c COMMON /GENBLK/GRQR(7,7),SLOC(5,7),DIMSE(3,7),DCHEM(7),FDR(4,7), c 1 DMANR(7),AREA(7),PT(12),PR(7,9),PX(18,10),YREM(8),YX17PR, c 2 Y811PR,YTRANS(8),NOFHH(8),DX(18,10,10),DR(7,10,10),CBET(25), c 3 SR(7,10,10),SAVE(8),RINV(18,7),CINV(18,7),SX(12),CODEM(22,8), c 4 THETA(8),S1(8),S2(7),MUINV(7),PWAURB,YRDTRA,PVTBUD,CLOSS(5), c 5 DBUD(8),RINVPR(7),DTR(12,10),ST(12),DCONSD(21,8),CVFLAG(8), c 6 RALLWD(7,10,10),reserv(100) C C include 'blnblk.for' c common xprcn,slaurb,iprsvc,iprtra,shrsr(7,10,10),shrdr(7,10,10), c 1 shrdx(18,10,10) C if (dis0 .eq. 1) then c do 1 i=1,7 idrl(i) = 1 prl(i) = pr(i,3) - cbet(i) * pt(1) 1 continue c else if (dis0 .eq. 2) then c do 2 i=1,7 idrl(i) = 1 prl(i) = pr(i,5) - cbet(i) * pt(2) 2 continue c else if (dis0 .eq. 3) then c do 3 i = 1,7 idrl(i) = 0 prl(i) = shrsr(i,3,8)*(pr(i,8)-cbet(i)*pt(7)) + 1 shrsr(i,3,6)*(pr(i,6)-cbet(i)*pt(3)) 3 continue c else if (dis0 .eq. 4) then c do 4 i=1,7 idrl(i) = 1 prl(i) = pr(i,7) - cbet(i) * pt(4) 4 continue c else if (dis0 .eq. 5) then c do 5 i=1,7 idrl(i) = 0 prl(i) = shrsr(i,5,6)*(pr(i,6)-cbet(i)*pt(5))+ 1 shrsr(i,5,9)*(pr(i,9)-cbet(i)*pt(9)) 5 continue c else if (dis0 .eq. 6) then c do 6 i=1,7 idrl(i) = 0 prl(i) = shrsr(i,6,9)*(pr(i,9)-cbet(I)*pt(10)) + 1 shrsr(i,6,3)*(pr(i,3)-cbet(I)*pt(3)) + 2 shrsr(i,6,5)*(pr(i,5)-cbet(I)*pt(5)) c write(*,'(3f9.6) ')shrsr(i,6,3),shrsr(i,6,7),shrsr(i,6,9) 6 continue c else if (dis0 .eq. 7) then c do 7 i=1,7 idrl(i) = 0 prl(i) = shrsr(i,7,8)*(pr(i,8)-cbet(I)*pt(8)) + 1 shrsr(i,7,9)*(pr(i,9)-cbet(I)*pt(11)) + 2 shrsr(i,7,4)*(pr(i,4)-cbet(I)*pt(4)) 7 continue c else if (dis0 .eq. 8) then c do 8 i=1,7 idrl(i) = 0 prl(i) = shrsr(i,8,3)*(pr(i,3)-cbet(I)*pt(7)) + 1 shrsr(i,8,7)*(pr(i,7)-cbet(I)*pt(8)) 8 continue c endif c do 9 i = 1,7 9 prl(i) = max(0.,prl(i)) c c return end C file 18 BLOCK DATA INICOEBD c c c version 28-Aug-1989 c IMPLICIT REAL (A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' C DATA CBET/1.,1.,1.,1.,1.,2.19,20.,1.,1.,1.,1.,1.,2.19,20., 1 .5,.5,0.2,0.,0.,.33,.33,.33,.33,.33,.33 / C DATA CINV/126*0.0/ C c c 0.2586 food c 0.2389 cash c 0.1539 man c 0.0432 mill c c 0.1500 trade c 0.0135 p.svc c c c 0.8581 c 0.1419 c 0.0516 india c 0.0902 row c c 1.0000 c c c DATA CODEM /.1048,.042,.056,.099,10*0.0,5*.95, 0.0, 0.0, 0.0 1 ,.1258,.021,.065,.090,10*0.0,5*.9, 0.0, 0.0, 0.0 2 ,.1258,.021,.065,.090,10*0.0,5*.9, 0.0, 0.0, 0.0 3 ,.1258,.021,.065,.090,10*0.0,5*.9, 0.0, 0.0, 0.0 4 ,.204,.0228,.026,.049,10*0.0,5*.9, 0.0, 0.0, 0.0 5 ,.204,.0228,.026,.049,10*0.0,5*.9, 0.0, 0.0, 0.0 6 ,.204,.0228,.026,.049,10*0.0,5*.9, 0.0, 0.0, 0.0 7 ,.175,.030,.0478,.049,10*0.0,5*.75, 0.0, 0.0, 0.0/ C c DATA CLOSS /.4, .1, .1, .1, 2./ c c no longer used? c c C C DATA UFOODR,UFOODX /49*0. , 77*0./ C DATA UXDEP /.007823,.007823,.007823,.007823,.011111,.0,.0/ C c DATA UX17OS/.270133,.270133,.270133,.270133,.348148,.0,.0/ data ux17os/5*0.15,2*0./ C C DATA CALFUR /0.3463,0.7273,0.6254,0.2140/ c DATA CAURB /108.67468,3.5694555,4.872394,231.79243/ data caurb /88.92, 3.52, 4.58, 226.9/ DATA DELTA /4*0.02/ C C DATA CATR /12*100000./ DATA CALFTR/12*0.33/ C END C C DK INIDAT C SUBROUTINE INICOESR c c c version 28-Aug-1989 c C IMPLICIT REAL (A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' C INTEGER I,J REAL DUM(20) C C DUM(5) = 0.0882 DUM(6) = 0.0 DUM(7) = 0.9118 c C dum(5) to dum(7) are applied to fraction of cash consumption c i.e. .2389 C DUM(8) = 0.15393 DUM(9) = 0.0 DUM(10) = 0.15 DUM(11) = 0.0135 DUM(12) = 0.0 DUM(13) = 0.0516 DUM(14) = 0.0902 C c dum(8) to dum(14) are straight from the i-o table 87 C CINV(8,1) = 1.0 MUINV(1) = 0.1 S1(1) = 0.05 * .1530/.1175 c S2(1) = 0.0852 S2(1) = 0.3 THETA(1) = 0.0274 GAMGOV(1) = 0.056 C DO 100 J=5,7 CODEM(J,1) = DUM(J)*0.2389 100 CONTINUE C DO 101 J=8,14 CODEM(J,1) = DUM(J) 101 CONTINUE C theta(2) = .0763 theta(3) = .034 theta(4) = .0251 c c DO 1 I=2,4 CINV(8,I) = 1.0 MUINV(I) = 0.1 S1(I) = 0.09 * .1530/.1175 c S2(I) = 0.0852 S2(I) = 0.3 GAMGOV(I) = 0.075 C DO 102 J=5,7 CODEM(J,I) = DUM(J)*0.2389 102 CONTINUE C DO 103 J=8,14 CODEM(J,I) = DUM(J) 103 CONTINUE C 1 CONTINUE C theta(5) = .033 theta(6) = .0463 theta(7) = .0386 c c DO 2 I=5,7 CINV(8,I)=0.8 CINV(15,I)=0.2 MUINV(I) = 0.36 S1(I) = 0.14 * .1530/.1175 c S2(I) = 0.067 S2(I) = 0.18 GAMGOV(I) = 0.094 C DO 105 J=5,7 CODEM(J,I) = DUM(J)*0.2389 105 CONTINUE C DO 106 J=8,14 CODEM(J,I) = DUM(J) 106 CONTINUE C 2 CONTINUE C S1(8) = 0.18 THETA(8) = 1. do 8888 j=1,7 8888 theta(8) = theta(8) - theta(j) c c GAMGOV(8)= 0.437 C DO 108 J=5,7 CODEM(J,8) = DUM(J)*0.2389 108 CONTINUE C DO 109 J=8,14 CODEM(J,8) = DUM(J) 109 CONTINUE C UFOODR(1,1) = 1.538461 UFOODR(2,2) = 1.1 UFOODR(3,3) = 1.3 UFOODR(4,4) = 1.1 UFOODR(5,5) = 3.33333 UFOODR(6,6) = 1. UFOODR(7,7) = 1. C C C RETURN END C C BLOCK DATA EXODATBD C DEBUG IMPLICIT REAL(A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' C DATA DR/700*.0/ DATA DX/1800*.0/ DATA DTR/120*.0/ DATA DCONSD/168*0./ DATA PWAURB/0.02/ DATA PX/180*1./ DATA SR/700*.0/ DATA SX/12*0./ DATA PVTBUD/0./ DATA ST/12*1.E+7/ DATA TAU/7*.0/ C DATA XTR/0./ c c Indian Prices elsewhere initialized C c DATA PT/1., 0.8, 0.375, 0.7, 0.7, 0.5, 0.2, 0.5, 0.1, c 1 0.1, 0.1 ,0.0/ DATA PT/.43,0.34, 0.16, 0.30, 0.30, 0.22, 0.086, 0.22, 0.043, 1 0.043, 0.043 ,0.0/ c c PT: non endogenous in baseyear. These are preliminary values. c c AREA: Old 85/86 data used, scaled to Country total 86/87 c DATA AREA/167607,598563,287952,239184,598035,574598,481061/ C DATA PCH/7*3.990/ c c PCH: price of urea and complex used in 50/50 proportion C DATA PSI/3.69,3.92,4.54,6.15,6.01,6.86,5.80,6.07,5.44, 1 4.71,5.52,8.14,4.61,4.51,5.14,4.34,4.54,4.08, 2 3.53,4.13,6.11/ c c PSI: No data available, used scenario 1 values instead. c C DATA DCHEM/3.067, 1.558, 12.939, 5.753, 12.891, 50.089, 17.602/ c c DCHEM based on 2.3 times nutrient tons in 86/87 (SPBN 1988,p60). c This distributed according to 1984/85 fractions. c Similar procedure for DIMSE (SPBN 88,61) C DATA DIMSE/3.2705e-3, 136.4306e-3, 3.021103e-3, 1 6.1345e-3, 105.8726e-3, 11.09162e-3, 2 15.100e-3, 65.21832e-3, 11.77601e-3, 3 13.739e-3, 427.0336e-3, 19.58784e-3, 4 43.625e-3, 874.8556e-3, 2.113762e-3, 5 17.180e-3, 372.0083e-3, 16.09831e-3, 6 41.948e-3, 216.5806e-3, 8.311337e-3/ c C DATA YGOVTO,YRDTRA,YX17PR,Y811PR/1262.,100.,50.,71./ c c These are arbitrary initial values c c GRQR; For Livestock Data from SPBN 1988 were taken, p.39. c Weigths for conversion to LSU from IDS worksheets,1987. C Belt totals were split according to region totals for Hill, c according to 81/82 values for Terai. c Values for other crops were 1985/86 values scaled to Country c totals in 1986/87 c DATA grqr/ 1 67.7500,57.4998,116.791,168.7158,12.2668,256.19,0.0642, 2 370.642,224.202,464.992,213.238,32.85,69.49, 0.164589, 3 246.115,125.25,246.099,92.915,26.72,104.66, 0.075679, 4 168.490,44.863,254.886,146.669,39.30,201.9606, 0.065702, 5 918.284,286.922,139.0449,29.245,219.73,985.36, 0.071627, 6 1023.56,275.363,144.089,59.186,131.07,2262.8,0.056517, 7 839.759,96.031,43.271,45.064,20.538,2675.2, 0.052162/ c C DATA EKURB /4*1./ DATA EKTR /12*1./ C DATA PUPRIN /4*1./ DATA SWAGE / .80187,5.2766,1.20639,.21948,.83026/ C C END C C C C SUBROUTINE EXODATSR C IMPLICIT REAL (A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' C INTEGER I,J REAL VFDR(7),TPV(7) C DTR(12,10) = CBET(1)*DR(1,8,10)+CBET(5)*DR(5,8,10)+ 1 CBET(6)*DR(6,8,10)+CBET(8)*DX(1,8,10)+CBET(15)*DX(8,8,10)+ 2 CBET(17)*DX(10,8,10)+CBET(18)*DX(11,8,10) C DTR(10,9) = CBET(8)*DX(1,6,9)+CBET(10)*DX(3,6,9)+ 1 CBET(11)*DX(4,6,9)+CBET(15)*DX(8,6,9)+CBET(18)*DX(11,6,9) XTR = 0.0 C DO 100 I=1,7 c SLOC(1,I) = 0.15 * GRQR(1,I) c SLOC(2,I) = 0.18 * GRQR(2,I) c SLOC(3,I) = 0.1 * GRQR(3,I) c SLOC(4,I) = 0.1 * GRQR(4,I) c SLOC(5,I) = 0.1 * GRQR(5,I) c 04-Sep-1989 c SLOC(1,I) = 0.05 * GRQR(1,I) SLOC(2,I) = 0.05 * GRQR(2,I) SLOC(3,I) = 0.05 * GRQR(3,I) SLOC(4,I) = 0.05 * GRQR(4,I) SLOC(5,I) = 0.05 * GRQR(5,I) 100 CONTINUE C C RETURN END C SUBROUTINE MODMOJC C IMPLICIT REAL (A-Z) C C INCLUDE'INC.INC' include 'urbblk.for' c COMMON /URBBLK/ CALFUR(4),DLAURB(4),CAURB(4),EKURB(4),SWAGE(5), c 1 IOCO(18,4),UFOODX(11,7),UFOODR(7,7),UXLAB(7),UX17OS(7), c 2 UXDEP(7),DELTA(4),UVDEPR(4),PUPRIN(4),CUPRIN(18,4),UPRINV(4) C C include 'genblk.for' c COMMON /GENBLK/GRQR(7,7),SLOC(5,7),DIMSE(3,7),DCHEM(7),FDR(4,7), c 1 DMANR(7),AREA(7),PT(12),PR(7,9),PX(18,10),YREM(8),YX17PR, c 2 Y811PR,YTRANS(8),NOFHH(8),DX(18,10,10),DR(7,10,10),CBET(25), c 3 SR(7,10,10),SAVE(8),RINV(18,7),CINV(18,7),SX(12),CODEM(22,8), c 4 THETA(8),S1(8),S2(7),MUINV(7),PWAURB,YRDTRA,PVTBUD,CLOSS(5), c 5 DBUD(8),RINVPR(7),DTR(12,10),ST(12),DCONSD(21,8),CVFLAG(8), c 6 rallwd(7,10,10),reserv(100) C C include 'gblk.for' c COMMON /GBLK/GINV(18),HINV(18),GSNV(18),IINV(18),TINV(18), c 1 CONV(18),GOIRUR(7),GOIOTH(7),GOISOC,GOIIND,GOICON,GOITRA, c 2 GCSER(18),TAU(7),AVINTA(18),AVROTA(18),AVLOTA(18),PSI(3,7), c 3 PCH(7),GOIUR1(18),GOIUR2(18),GOVDEM(18),DTPTLO,DTPTFO,GLABCO, c 4 TRSUBS,TROPSS,TRILHH,FORAST,YGOVTO,GAMGOV(8),GOCON(18) C C include 'trblk.for' c COMMON /TRBLK/ CATR(12),CALFTR(12),EKTR(12),DRDTR(12),XTR include 'glblk.for' c COMMON /GLBLK/ GVIRUR,GVISOC,GVIIND,GVITRA,GVICON,GVITOT, c 1 GVCOMM,AGINPT,AVTAX,GOSER,GVBUD,GVSER,IMDUIN,IMDURO, c 2 SAVSPL,PGSVC,LTAX,GOVEMP C C INTEGER I,J REAL VFDR(7),TPV(7),PGNV(7),PHNV(7),GOIROL(7),GOIOOL(7), 1 vioco(18,4),vfoodx(11,7),vxlab(7),vgcser(18),vcprin(18,4), 2 vgsnv(18),viinv(18),vtinv(18),vhinv(18),vconv(18),vglabc, 3 vginv(18),qx(18) C c ----------------------------- C c data vioco/ c 1 7*0.,0.090353932,0.032099423,0.050407983,0.015217504,3*0., c 2 0.051239098,0.076955690,2*0., c 3 6*0.,0.010920369,0.035135101,0.013579242,0.024119772, c 4 0.000474799,3*0.,0.062109967,0.192512795,2*0., c 5 7*0.,0.005902807,0.025147577,0.231422397,0.152987832,3*0., c 6 0.056103865,0.039967798,2*0., c 7 7*0.,0.004660954,0.003015911,0.008499386,0.011515297,3*0., c 8 0.013815174,0.023783084,2*0./ c c coefficients for trade reduced 04-Sep-1989 (except for priv.serv.) c data vioco/ 1 7*0.,0.090353932,0.032099423,0.00,0.015217504,3*0., 2 0.051239098,0.076955690,2*0., 3 6*0.,0.010920369,0.035135101,0.00,0.024119772, 4 0.000474799,3*0.,0.062109967,0.192512795,2*0., 5 7*0.,0.005902807,0.025147577,0.15,0.152987832,3*0., 6 0.056103865,0.039967798,2*0., 7 7*0.,0.004660954,0.003015911,0.008499386,0.011515297,3*0., 8 0.013815174,0.023783084,2*0./ c data vfoodx /77*0./ c c data vginv /7*0.,0.014379572,0.700118419,0.010315780,0.010315780, c 1 5*0.,0.097945011,0.166925440/ data vginv /7*0.,0.014379572,0.700118419,0.0,0.010315780, 2 5*0.,0.097945011,0.166925440/ c data vhinv /7*0.,.0096,.6762,.0115,.0096,5*0., 3 .1437,.1494/ c c c data vcprin / c 1 7*0.,0.099976140,0.411891159,0.019758130,0.021997385,5*0., c 2 0.174292362,0.272084823, c 3 7*0.,0.075016835,0.570333468,0.010276279,0.016544809,5*0., c 4 0.036747288,0.291081322, c 5 7*0.,0.106101175,0.307233179,0.014677536,0.023384550,5*0., c 6 0.125421141,0.423182420, c 7 7*0.,0.066773678,0.890986127,0.009251775,0.014682164,5*0., c 8 0.006973810,0.011332446/ data vcprin / 1 7*0.,0.099976140,0.411891159,0.0,0.021997385,5*0., 2 0.174292362,0.272084823, 3 7*0.,0.075016835,0.570333468,0.0,0.016544809,5*0., 4 0.036747288,0.291081322, 5 7*0.,0.106101175,0.307233179,0.0,0.023384550,5*0., 6 0.125421141,0.423182420, 7 7*0.,0.066773678,0.890986127,0.0,0.014682164,5*0., 8 0.006973810,0.011332446/ c c data viinv / 7*0.,0.008955829,0.635936158,0.047769029,0.047769029, c 1 5*0.,0.097237744,0.162332212/ data viinv / 7*0.,0.008955829,0.635936158,0.0,0.047769029, 2 5*0.,0.097237744,0.162332212/ data vconv / 7*0.,0.000000000,0.645525114,0.000000000,0.107587519, 3 5*0.,0.135751921,0.111135446/ c data vtinv / 7*0.,0.010031444,0.708291435,0.012038159,0.010031444, c 4 5*0.,0.096050593,0.163556924/ data vtinv / 7*0.,0.010031444,0.708291435,0.0,0.010031444, 5 5*0.,0.096050593,0.163556924/ data vgsnv / 7*0.,0.021111243,0.833927045,0.000000000,0.000000000, 6 5*0.,0.078240458,0.066721254/ c c do 71 i=1,11 px(i,3) = px(i,8) + cbet(i+7) * pt(7) px(i,7) = px(i,8) + cbet(i+7) * pt(8) px(i,10) = px(i,8) + cbet(i+7) * pt(12) px(i,4) = px(i,7) + cbet(i+7) * pt(4) px(i,1) = px(i,3) + cbet(i+7) * pt(1) px(i,6) = px(i,3) + cbet(i+7) * pt(3) px(i,5) = px(i,6) + cbet(i+7) * pt(5) px(i,2) = px(i,5) + cbet(i+7) * pt(2) px(i,9) = px(i,6) + cbet(i+7) * pt(10) 71 continue c c vioco(1,1) = (35./113.)*529./(11098.-793.) vioco(2,1) = (63./113.)*529./(11098.-793.) vioco(3,1) = (15./113.)*529./(11098.-793.) vioco(4,1) = 0. vioco(5,1) = 0. vioco(6,1) = (53.3/718.5)*3082./(11098.-793.) vioco(7,1) = (665.2/718.5)*3082./(11098.-793.) c c xxx = ((2834.-23.)/(2834.-23.+752.-8.)) * (3866.-57.) do 1 j=1,4 vfoodx(1,j) = (14./18.)*21. / xxx vfoodx(2,j) = (5./6.)*7. / xxx vfoodx(3,j) = (7./9.)*10. / xxx vfoodx(8,j) = (19./25.)*42. / xxx vfoodx(9,j) = (19./25.)*15. / xxx vxlab(j) = (38./50.)*51. / xxx 1 continue c xxx = ( (752. - 8.)/(2834.-23.+752.-8.) ) * (3866.-57.) vxlab(5) = (12./50.)*51. / xxx vfoodx(1,5) = (4./18.)*21. / xxx vfoodx(2,5) = (1./6.)*7. / xxx vfoodx(3,5) = (2./9.)*10. / xxx vfoodx(8,5) = (6./25.)*42. / xxx vfoodx(9,5) = (6./25.)*15. / xxx c c vgcser(1) = (245./249.)*202. / (4915.-27.) vgcser(2) = 0. vgcser(3) = 0. vgcser(4) = 0. vgcser(5) = (4./249.)*202. / (4915.-27.) vgcser(6) = 0. vgcser(7) = 0. vgcser(8) = 220. / (4915.-27.) vgcser(9) = 37. / (4915.-27.) c vgcser(10) = 137. / (4915.-27.) vgcser(10) = 0. vgcser(11) = 75. / (4915.-27.) vgcser(12) = 0. vgcser(13) = 0. vgcser(14) = 0. vgcser(15) = 100. / (4915.-27.) vgcser(16) = 205. / (4915.-27.) vgcser(17) = 0. vgcser(18) = 0. c c vglabc = 3911. / (4915.-27.) c do 9 i=1,12 9 qx(i) = px(i,8) c qx(13) = px(13,9) qx(15) = px(15,9) qx(17) = px(17,9) qx(14) = px(14,10) qx(16) = px(16,10) qx(18) = px(18,10) c do 2 j=1,4 p = px(j+7,8)*(1.-avlota(j+7))/ 1 (1.+avinta(15)*vioco(15,j)+avrota(16)*vioco(16,j)) do 21 i = 1,7 ioco(i,j) = p * vioco(i,j)/pr(i,8) 21 continue c do 22 i = 8,18 22 ioco(i,j) = p * vioco(i,j) / qx(i) c c 2 continue c c do 3 j=1,5 p = px(j,8)*(1-avlota(j))/ 1 (1.+avinta(15)*vfoodx(8,j)+avrota(16)*vfoodx(9,j)) do 31 i = 1,11 31 ufoodx(i,j) = vfoodx(i,j) * p / qx(i+7) c uxlab(j) = vxlab(j) * p/(pwaurb*swage(1)) c 3 continue c do 4 i=1,18 gcser(i) = vgcser(i) / 1 ( (1+avinta(15)*vgcser(15)+avrota(16)*vgcser(16))*qx(i) ) ginv(i) = vginv(i) / 2 ( (1+avinta(17)*vginv(17)+avrota(18)*vginv(18)) * qx(i) ) gsnv(i) = vgsnv(i) / 3 ( (1+avinta(17)*vgsnv(17)+avrota(18)*vgsnv(18)) * qx(i) ) iinv(i) = viinv(i) / 4 ( (1+avinta(17)*viinv(17)+avrota(18)*viinv(18)) * qx(i) ) tinv(i) = vtinv(i) / 5 ( (1+avinta(17)*vtinv(17)+avrota(18)*vtinv(18)) * qx(i) ) conv(i) = vconv(i) / 6 ( (1+avinta(17)*vconv(17)+avrota(18)*vconv(18)) * qx(i) ) hinv(i) = vhinv(i) / 7 ( (1+avinta(17)*vhinv(17)+avrota(18)*vhinv(18)) * qx(i) ) c 4 continue c c do 5 j = 1,4 p = ( 1 + avinta(17)*vcprin(17,j)+avrota(18)*vcprin(18,j) ) do 51 i = 1,18 51 cuprin(i,j) = p * vcprin(i,j) / qx(i) 5 continue c c glabco = vglabc / 1 ( (1 + avinta(15)*vgcser(15)+avrota(16)*vgcser(16))* 2 pwaurb*swage(5) ) c c c ------------------------------------------- c c DO 1717 I = 1,7 GOIOOL(I) = 0. 1717 CONTINUE C GOIROL(1) = (2.81/490)*2759 GOIROL(2) = (40.72/490)*2759 GOIROL(3) = (68.80/490)*2759 GOIROL(4) = (4.21/490)*2759 GOIROL(5) = (162.86/490)*2759 GOIROL(6) = (103.90/490)*2759 GOIROL(7) = (106.70/490)*2759 C DR(1,8,10) = 0./PR(1,8) DR(2,8,10) = 0./PR(2,8) DR(3,8,10) = 0./PR(3,8) DR(4,8,10) = 0./PR(4,8) DR(5,8,10) = (2.41/189.63)*353/PR(5,8) DR(6,8,10) = (187.22/189.63)*353/PR(6,8) DR(7,8,10) = 0./PR(7,8) C DX(1,6,9) = (17.84671/378.36731)*314/PX(1,6) DX(2,6,9) = 0./PX(1,6) DX(3,6,9) = (248.4906/378.36731)*314/PX(3,6) DX(4,6,9) = (18.03/378.36731)*314/PX(4,6) DX(5,6,9) = (94./378.36731)*314/PX(5,6) DX(6,6,9) = 0./PX(6,6) DX(7,6,9) = 0./PX(7,6) C DX(1,8,10) = (106.93/107.93)*1315/PX(1,8) DX(5,8,10) = (1./107.93)*1315/PX(5,8) C DX( 8,6,9) = 4533./PX(8,6) DX(11,6,9) = 1823./PX(11,6) DX(10,6,9) = 1213./PX(10,6) DX( 8,8,10) = 289/PX(8,8) DX(10,8,10) = 1749./PX(10,8) DX(11,8,10) = 2629./PX(11,8) C DTR(12,10) = CBET(1)*DR(1,8,10)+CBET(5)*DR(5,8,10)+ 1 CBET(6)*DR(6,8,10)+CBET(8)*DX(1,8,10)+CBET(15)*DX(8,8,10)+ 2 CBET(17)*DX(10,8,10)+CBET(18)*DX(11,8,10) C DTR(10,9) = CBET(8)*DX(1,6,9)+CBET(10)*DX(3,6,9)+ 1 CBET(11)*DX(4,6,9)+CBET(15)*DX(8,6,9)+CBET(18)*DX(11,6,9) XTR = 0.0 C DMANR(1) = (36/43.12)*5.256394 /PX(8,1) DMANR(2) = (36/43.12)*11.62070 /PX(8,2) DMANR(3) = (36/43.12)*7.492198 /PX(8,3) DMANR(4) = (36/43.12)*18.75339 /PX(8,4) DMANR(5) = (81/27.87)*9.023821 /PX(8,5) DMANR(6) = (81/27.87)*15.66232 /PX(8,6) DMANR(7) = (81/27.87)*3.191157 /PX(8,7) C C UPRINV(1) = 2381. / PUPRIN(1) UPRINV(2) = 1105./ PUPRIN(2) UPRINV(3) = 1675./ PUPRIN(3) UPRINV(4) = 6680. / PUPRIN(4) C poisoc = 0. poitra = 0. poicon = 0. poiind = 0. c do 135 i=1,7 poisoc = poisoc + pr(i,8) * gsnv(i) poitra = poitra + pr(i,8) * tinv(i) poicon = poicon + pr(i,8) * conv(i) poiind = poiind + pr(i,8) * iinv(i) 135 continue c do 136 i=8,18 poisoc = poisoc + px(i,8) * gsnv(i) poitra = poitra + px(i,8) * tinv(i) poicon = poicon + px(i,8) * conv(i) poiind = poiind + px(i,8) * iinv(i) 136 continue GOISOC = 1024. / poiSOC GOITRA = 1907./ poiTRA GOICON = 72. / poiCON GOIIND = 1768./ poIIND C DO 201 I = 1,7 PGNV(I) = 0. PHNV(I) = 0. DO 202 J = 1,18 PGNV(I) = PGNV(I) + GINV(J)*PX(J,I) 202 CONTINUE GOIRUR(I) = GOIROL(I) / PGNV(I) 201 CONTINUE C c c Food to Cash deliveries distributed over regions according to LSU number c See i-o table 86/87. c Distribution within Food sectors according to gross production value. c tlsu = 0. do 91 i=1,7 tlsu = tlsu + grqr(7,i) 91 continue c do 200 i=1,7 vfdr(i) = ( grqr(7,i) / tlsu ) * 667. tpv(i) = pr(1,i) * grqr(1,i) + pr(2,i) * grqr(2,i) + 1 pr(3,i) * grqr(3,i) + pr(4,i) * grqr(4,i) do 2011 j=1,4 fdr(j,i) = grqr(j,i) * vfdr(i) / tpv(i) 2011 continue 200 continue c c RETURN END C file 19 BLOCK DATA INICOEBD c c c version 28-Aug-1989 c IMPLICIT REAL (A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' C DATA CBET/1.,1.,1.,1.,1.,2.19,20.,1.,1.,1.,1.,1.,2.19,20., 1 .5,.5,0.2,0.,0.,.33,.33,.33,.33,.33,.33 / C DATA CINV/126*0.0/ C c c 0.2586 food c 0.2389 cash c 0.1539 man c 0.0432 mill c c 0.1500 trade c 0.0135 p.svc c c c 0.8581 c 0.1419 c 0.0516 india c 0.0902 row c c 1.0000 c c c DATA CODEM /.1048,.042,.056,.099,10*0.0,5*.95, 0.0, 0.0, 0.0 1 ,.1258,.021,.065,.090,10*0.0,5*.9, 0.0, 0.0, 0.0 2 ,.1258,.021,.065,.090,10*0.0,5*.9, 0.0, 0.0, 0.0 3 ,.1258,.021,.065,.090,10*0.0,5*.9, 0.0, 0.0, 0.0 4 ,.204,.0228,.026,.049,10*0.0,5*.9, 0.0, 0.0, 0.0 5 ,.204,.0228,.026,.049,10*0.0,5*.9, 0.0, 0.0, 0.0 6 ,.204,.0228,.026,.049,10*0.0,5*.9, 0.0, 0.0, 0.0 7 ,.175,.030,.0478,.049,10*0.0,5*.75, 0.0, 0.0, 0.0/ C c DATA CLOSS /.4, .1, .1, .1, 2./ c c no longer used? c c C C DATA UFOODR,UFOODX /49*0. , 77*0./ C DATA UXDEP /.007823,.007823,.007823,.007823,.011111,.0,.0/ C c DATA UX17OS/.270133,.270133,.270133,.270133,.348148,.0,.0/ data ux17os/5*0.15,2*0./ C C DATA CALFUR /0.3463,0.7273,0.6254,0.2140/ c DATA CAURB /108.67468,3.5694555,4.872394,231.79243/ data caurb /88.92, 3.52, 4.58, 226.9/ DATA DELTA /4*0.02/ C C DATA CATR /12*100000./ DATA CALFTR/12*0.33/ C END C C DK INIDAT C SUBROUTINE INICOESR c c c version 28-Aug-1989 c C IMPLICIT REAL (A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' C INTEGER I,J REAL DUM(20) C C DUM(5) = 0.0882 DUM(6) = 0.0 DUM(7) = 0.9118 c C dum(5) to dum(7) are applied to fraction of cash consumption c i.e. .2389 C DUM(8) = 0.15393 DUM(9) = 0.0 DUM(10) = 0.15 DUM(11) = 0.0135 DUM(12) = 0.0 DUM(13) = 0.0516 DUM(14) = 0.0902 C c dum(8) to dum(14) are straight from the i-o table 87 C CINV(8,1) = 1.0 MUINV(1) = 0.1 S1(1) = 0.05 * .1530/.1175 c S2(1) = 0.0852 S2(1) = 0.3 THETA(1) = 0.0274 GAMGOV(1) = 0.056 C DO 100 J=5,7 CODEM(J,1) = DUM(J)*0.2389 100 CONTINUE C DO 101 J=8,14 CODEM(J,1) = DUM(J) 101 CONTINUE C theta(2) = .0763 theta(3) = .034 theta(4) = .0251 c c DO 1 I=2,4 CINV(8,I) = 1.0 MUINV(I) = 0.1 S1(I) = 0.09 * .1530/.1175 c S2(I) = 0.0852 S2(I) = 0.3 GAMGOV(I) = 0.075 C DO 102 J=5,7 CODEM(J,I) = DUM(J)*0.2389 102 CONTINUE C DO 103 J=8,14 CODEM(J,I) = DUM(J) 103 CONTINUE C 1 CONTINUE C theta(5) = .033 theta(6) = .0463 theta(7) = .0386 c c DO 2 I=5,7 CINV(8,I)=0.8 CINV(15,I)=0.2 MUINV(I) = 0.36 S1(I) = 0.14 * .1530/.1175 c S2(I) = 0.067 S2(I) = 0.18 GAMGOV(I) = 0.094 C DO 105 J=5,7 CODEM(J,I) = DUM(J)*0.2389 105 CONTINUE C DO 106 J=8,14 CODEM(J,I) = DUM(J) 106 CONTINUE C 2 CONTINUE C S1(8) = 0.18 THETA(8) = 1. do 8888 j=1,7 8888 theta(8) = theta(8) - theta(j) c c GAMGOV(8)= 0.437 C DO 108 J=5,7 CODEM(J,8) = DUM(J)*0.2389 108 CONTINUE C DO 109 J=8,14 CODEM(J,8) = DUM(J) 109 CONTINUE C UFOODR(1,1) = 1.538461 UFOODR(2,2) = 1.1 UFOODR(3,3) = 1.3 UFOODR(4,4) = 1.1 UFOODR(5,5) = 3.33333 UFOODR(6,6) = 1. UFOODR(7,7) = 1. C C C RETURN END C C BLOCK DATA EXODATBD C DEBUG IMPLICIT REAL(A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' C DATA DR/700*.0/ DATA DX/1800*.0/ DATA DTR/120*.0/ DATA DCONSD/168*0./ DATA PWAURB/0.02662/ DATA PX/180*1./ DATA SR/700*.0/ DATA SX/12*0./ DATA PVTBUD/0./ DATA ST/12*1.E+7/ DATA TAU/7*.0/ C DATA XTR/0./ c c Indian Prices elsewhere initialized C c DATA PT/1., 0.8, 0.375, 0.7, 0.7, 0.5, 0.2, 0.5, 0.1, c 1 0.1, 0.1 ,0.0/ DATA PT/.43,0.34, 0.16, 0.30, 0.30, 0.22, 0.086, 0.22, 0.043, 1 0.043, 0.043 ,0.0/ c c PT: non endogenous in baseyear. These are preliminary values. c c AREA: Old 85/86 data used, scaled to Country total 86/87 c DATA AREA/167607,598563,287952,239184,598035,574598,481061/ C DATA PCH/7*3.990/ c c PCH: price of urea and complex used in 50/50 proportion C DATA PSI/3.69,3.92,4.54,6.15,6.01,6.86,5.80,6.07,5.44, 1 4.71,5.52,8.14,4.61,4.51,5.14,4.34,4.54,4.08, 2 3.53,4.13,6.11/ c c PSI: No data available, used scenario 1 values instead. c C DATA DCHEM/3.067, 1.558, 12.939, 5.753, 12.891, 50.089, 17.602/ c c DCHEM based on 2.3 times nutrient tons in 86/87 (SPBN 1988,p60). c This distributed according to 1984/85 fractions. c Similar procedure for DIMSE (SPBN 88,61) C DATA DIMSE/3.2705e-3, 136.4306e-3, 3.021103e-3, 1 6.1345e-3, 105.8726e-3, 11.09162e-3, 2 15.100e-3, 65.21832e-3, 11.77601e-3, 3 13.739e-3, 427.0336e-3, 19.58784e-3, 4 43.625e-3, 874.8556e-3, 2.113762e-3, 5 17.180e-3, 372.0083e-3, 16.09831e-3, 6 41.948e-3, 216.5806e-3, 8.311337e-3/ c C DATA YGOVTO,YRDTRA,YX17PR,Y811PR/1262.,100.,50.,71./ c c These are arbitrary initial values c c GRQR; For Livestock Data from SPBN 1988 were taken, p.39. c Weigths for conversion to LSU from IDS worksheets,1987. C Belt totals were split according to region totals for Hill, c according to 81/82 values for Terai. c Values for other crops were 1985/86 values scaled to Country c totals in 1986/87 c DATA grqr/ 1 73.2771,62.1906,126.319,182.4796,13.2679,277.10,0.09441, 2 400.8785,242.492,502.926,230.633,35.53,75.1566, 0.178021, 3 266.193,135.4712,266.175,100.495,28.903,113.2047, 0.081855, 4 182.235,48.523,275.788,158.734,42.508,218.4417, 0.071064, 5 993.197,310.329,150.3881,31.674,237.659,1065.77,0.0774720, 6 1107.06,297.827,155.845,64.014,141.77,2447.4773,0.061130, 7 908.267,103.875,46.801,48.740,22.214,2893.514, 0.056419/ c C DATA EKURB /5.324./ DATA EKTR /12*1./ C DATA PUPRIN /4*1./ DATA SWAGE / .80187,5.2766,1.20639,.21948,.83026/ C C END C C C C SUBROUTINE EXODATSR C IMPLICIT REAL (A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' C INTEGER I,J REAL VFDR(7),TPV(7) C DTR(12,10) = CBET(1)*DR(1,8,10)+CBET(5)*DR(5,8,10)+ 1 CBET(6)*DR(6,8,10)+CBET(8)*DX(1,8,10)+CBET(15)*DX(8,8,10)+ 2 CBET(17)*DX(10,8,10)+CBET(18)*DX(11,8,10) C DTR(10,9) = CBET(8)*DX(1,6,9)+CBET(10)*DX(3,6,9)+ 1 CBET(11)*DX(4,6,9)+CBET(15)*DX(8,6,9)+CBET(18)*DX(11,6,9) XTR = 0.0 C DO 100 I=1,7 c SLOC(1,I) = 0.15 * GRQR(1,I) c SLOC(2,I) = 0.18 * GRQR(2,I) c SLOC(3,I) = 0.1 * GRQR(3,I) c SLOC(4,I) = 0.1 * GRQR(4,I) c SLOC(5,I) = 0.1 * GRQR(5,I) c 04-Sep-1989 c SLOC(1,I) = 0.05 * GRQR(1,I) SLOC(2,I) = 0.05 * GRQR(2,I) SLOC(3,I) = 0.05 * GRQR(3,I) SLOC(4,I) = 0.05 * GRQR(4,I) SLOC(5,I) = 0.05 * GRQR(5,I) 100 CONTINUE C C RETURN END C SUBROUTINE MODMOJC C IMPLICIT REAL (A-Z) C C INCLUDE'INC.INC' include 'urbblk.for' c COMMON /URBBLK/ CALFUR(4),DLAURB(4),CAURB(4),EKURB(4),SWAGE(5), c 1 IOCO(18,4),UFOODX(11,7),UFOODR(7,7),UXLAB(7),UX17OS(7), c 2 UXDEP(7),DELTA(4),UVDEPR(4),PUPRIN(4),CUPRIN(18,4),UPRINV(4) C C include 'genblk.for' c COMMON /GENBLK/GRQR(7,7),SLOC(5,7),DIMSE(3,7),DCHEM(7),FDR(4,7), c 1 DMANR(7),AREA(7),PT(12),PR(7,9),PX(18,10),YREM(8),YX17PR, c 2 Y811PR,YTRANS(8),NOFHH(8),DX(18,10,10),DR(7,10,10),CBET(25), c 3 SR(7,10,10),SAVE(8),RINV(18,7),CINV(18,7),SX(12),CODEM(22,8), c 4 THETA(8),S1(8),S2(7),MUINV(7),PWAURB,YRDTRA,PVTBUD,CLOSS(5), c 5 DBUD(8),RINVPR(7),DTR(12,10),ST(12),DCONSD(21,8),CVFLAG(8), c 6 rallwd(7,10,10),reserv(100) C C include 'gblk.for' c COMMON /GBLK/GINV(18),HINV(18),GSNV(18),IINV(18),TINV(18), c 1 CONV(18),GOIRUR(7),GOIOTH(7),GOISOC,GOIIND,GOICON,GOITRA, c 2 GCSER(18),TAU(7),AVINTA(18),AVROTA(18),AVLOTA(18),PSI(3,7), c 3 PCH(7),GOIUR1(18),GOIUR2(18),GOVDEM(18),DTPTLO,DTPTFO,GLABCO, c 4 TRSUBS,TROPSS,TRILHH,FORAST,YGOVTO,GAMGOV(8),GOCON(18) C C include 'trblk.for' c COMMON /TRBLK/ CATR(12),CALFTR(12),EKTR(12),DRDTR(12),XTR include 'glblk.for' c COMMON /GLBLK/ GVIRUR,GVISOC,GVIIND,GVITRA,GVICON,GVITOT, c 1 GVCOMM,AGINPT,AVTAX,GOSER,GVBUD,GVSER,IMDUIN,IMDURO, c 2 SAVSPL,PGSVC,LTAX,GOVEMP C C INTEGER I,J REAL VFDR(7),TPV(7),PGNV(7),PHNV(7),GOIROL(7),GOIOOL(7), 1 vioco(18,4),vfoodx(11,7),vxlab(7),vgcser(18),vcprin(18,4), 2 vgsnv(18),viinv(18),vtinv(18),vhinv(18),vconv(18),vglabc, 3 vginv(18),qx(18) C c ----------------------------- C c data vioco/ c 1 7*0.,0.090353932,0.032099423,0.050407983,0.015217504,3*0., c 2 0.051239098,0.076955690,2*0., c 3 6*0.,0.010920369,0.035135101,0.013579242,0.024119772, c 4 0.000474799,3*0.,0.062109967,0.192512795,2*0., c 5 7*0.,0.005902807,0.025147577,0.231422397,0.152987832,3*0., c 6 0.056103865,0.039967798,2*0., c 7 7*0.,0.004660954,0.003015911,0.008499386,0.011515297,3*0., c 8 0.013815174,0.023783084,2*0./ c c coefficients for trade reduced 04-Sep-1989 (except for priv.serv.) c data vioco/ 1 7*0.,0.090353932,0.032099423,0.00,0.015217504,3*0., 2 0.051239098,0.076955690,2*0., 3 6*0.,0.010920369,0.035135101,0.00,0.024119772, 4 0.000474799,3*0.,0.062109967,0.192512795,2*0., 5 7*0.,0.005902807,0.025147577,0.15,0.152987832,3*0., 6 0.056103865,0.039967798,2*0., 7 7*0.,0.004660954,0.003015911,0.008499386,0.011515297,3*0., 8 0.013815174,0.023783084,2*0./ c data vfoodx /77*0./ c c data vginv /7*0.,0.014379572,0.700118419,0.010315780,0.010315780, c 1 5*0.,0.097945011,0.166925440/ data vginv /7*0.,0.014379572,0.700118419,0.0,0.010315780, 2 5*0.,0.097945011,0.166925440/ c data vhinv /7*0.,.0096,.6762,.0115,.0096,5*0., 3 .1437,.1494/ c c c data vcprin / c 1 7*0.,0.099976140,0.411891159,0.019758130,0.021997385,5*0., c 2 0.174292362,0.272084823, c 3 7*0.,0.075016835,0.570333468,0.010276279,0.016544809,5*0., c 4 0.036747288,0.291081322, c 5 7*0.,0.106101175,0.307233179,0.014677536,0.023384550,5*0., c 6 0.125421141,0.423182420, c 7 7*0.,0.066773678,0.890986127,0.009251775,0.014682164,5*0., c 8 0.006973810,0.011332446/ data vcprin / 1 7*0.,0.099976140,0.411891159,0.0,0.021997385,5*0., 2 0.174292362,0.272084823, 3 7*0.,0.075016835,0.570333468,0.0,0.016544809,5*0., 4 0.036747288,0.291081322, 5 7*0.,0.106101175,0.307233179,0.0,0.023384550,5*0., 6 0.125421141,0.423182420, 7 7*0.,0.066773678,0.890986127,0.0,0.014682164,5*0., 8 0.006973810,0.011332446/ c c data viinv / 7*0.,0.008955829,0.635936158,0.047769029,0.047769029, c 1 5*0.,0.097237744,0.162332212/ data viinv / 7*0.,0.008955829,0.635936158,0.0,0.047769029, 2 5*0.,0.097237744,0.162332212/ data vconv / 7*0.,0.000000000,0.645525114,0.000000000,0.107587519, 3 5*0.,0.135751921,0.111135446/ c data vtinv / 7*0.,0.010031444,0.708291435,0.012038159,0.010031444, c 4 5*0.,0.096050593,0.163556924/ data vtinv / 7*0.,0.010031444,0.708291435,0.0,0.010031444, 5 5*0.,0.096050593,0.163556924/ data vgsnv / 7*0.,0.021111243,0.833927045,0.000000000,0.000000000, 6 5*0.,0.078240458,0.066721254/ c c do 71 i=1,11 px(i,3) = px(i,8) + cbet(i+7) * pt(7) px(i,7) = px(i,8) + cbet(i+7) * pt(8) px(i,10) = px(i,8) + cbet(i+7) * pt(12) px(i,4) = px(i,7) + cbet(i+7) * pt(4) px(i,1) = px(i,3) + cbet(i+7) * pt(1) px(i,6) = px(i,3) + cbet(i+7) * pt(3) px(i,5) = px(i,6) + cbet(i+7) * pt(5) px(i,2) = px(i,5) + cbet(i+7) * pt(2) px(i,9) = px(i,6) + cbet(i+7) * pt(10) 71 continue c c vioco(1,1) = (35./113.)*529./(11098.-793.) vioco(2,1) = (63./113.)*529./(11098.-793.) vioco(3,1) = (15./113.)*529./(11098.-793.) vioco(4,1) = 0. vioco(5,1) = 0. vioco(6,1) = (53.3/718.5)*3082./(11098.-793.) vioco(7,1) = (665.2/718.5)*3082./(11098.-793.) c c xxx = ((2834.-23.)/(2834.-23.+752.-8.)) * (3866.-57.) do 1 j=1,4 vfoodx(1,j) = (14./18.)*21. / xxx vfoodx(2,j) = (5./6.)*7. / xxx vfoodx(3,j) = (7./9.)*10. / xxx vfoodx(8,j) = (19./25.)*42. / xxx vfoodx(9,j) = (19./25.)*15. / xxx vxlab(j) = (38./50.)*51. / xxx 1 continue c xxx = ( (752. - 8.)/(2834.-23.+752.-8.) ) * (3866.-57.) vxlab(5) = (12./50.)*51. / xxx vfoodx(1,5) = (4./18.)*21. / xxx vfoodx(2,5) = (1./6.)*7. / xxx vfoodx(3,5) = (2./9.)*10. / xxx vfoodx(8,5) = (6./25.)*42. / xxx vfoodx(9,5) = (6./25.)*15. / xxx c c vgcser(1) = (245./249.)*202. / (4915.-27.) vgcser(2) = 0. vgcser(3) = 0. vgcser(4) = 0. vgcser(5) = (4./249.)*202. / (4915.-27.) vgcser(6) = 0. vgcser(7) = 0. vgcser(8) = 220. / (4915.-27.) vgcser(9) = 37. / (4915.-27.) c vgcser(10) = 137. / (4915.-27.) vgcser(10) = 0. vgcser(11) = 75. / (4915.-27.) vgcser(12) = 0. vgcser(13) = 0. vgcser(14) = 0. vgcser(15) = 100. / (4915.-27.) vgcser(16) = 205. / (4915.-27.) vgcser(17) = 0. vgcser(18) = 0. c c vglabc = 3911. / (4915.-27.) c do 9 i=1,12 9 qx(i) = px(i,8) c qx(13) = px(13,9) qx(15) = px(15,9) qx(17) = px(17,9) qx(14) = px(14,10) qx(16) = px(16,10) qx(18) = px(18,10) c do 2 j=1,4 p = px(j+7,8)*(1.-avlota(j+7))/ 1 (1.+avinta(15)*vioco(15,j)+avrota(16)*vioco(16,j)) do 21 i = 1,7 ioco(i,j) = p * vioco(i,j)/pr(i,8) 21 continue c do 22 i = 8,18 22 ioco(i,j) = p * vioco(i,j) / qx(i) c c 2 continue c c do 3 j=1,5 p = px(j,8)*(1-avlota(j))/ 1 (1.+avinta(15)*vfoodx(8,j)+avrota(16)*vfoodx(9,j)) do 31 i = 1,11 31 ufoodx(i,j) = vfoodx(i,j) * p / qx(i+7) c uxlab(j) = vxlab(j) * p/(pwaurb*swage(1)) c 3 continue c do 4 i=1,18 gcser(i) = vgcser(i) / 1 ( (1+avinta(15)*vgcser(15)+avrota(16)*vgcser(16))*qx(i) ) ginv(i) = vginv(i) / 2 ( (1+avinta(17)*vginv(17)+avrota(18)*vginv(18)) * qx(i) ) gsnv(i) = vgsnv(i) / 3 ( (1+avinta(17)*vgsnv(17)+avrota(18)*vgsnv(18)) * qx(i) ) iinv(i) = viinv(i) / 4 ( (1+avinta(17)*viinv(17)+avrota(18)*viinv(18)) * qx(i) ) tinv(i) = vtinv(i) / 5 ( (1+avinta(17)*vtinv(17)+avrota(18)*vtinv(18)) * qx(i) ) conv(i) = vconv(i) / 6 ( (1+avinta(17)*vconv(17)+avrota(18)*vconv(18)) * qx(i) ) hinv(i) = vhinv(i) / 7 ( (1+avinta(17)*vhinv(17)+avrota(18)*vhinv(18)) * qx(i) ) c 4 continue c c do 5 j = 1,4 p = ( 1 + avinta(17)*vcprin(17,j)+avrota(18)*vcprin(18,j) ) do 51 i = 1,18 51 cuprin(i,j) = p * vcprin(i,j) / qx(i) 5 continue c c glabco = vglabc / 1 ( (1 + avinta(15)*vgcser(15)+avrota(16)*vgcser(16))* 2 pwaurb*swage(5) ) c c c ------------------------------------------- c c DO 1717 I = 1,7 GOIOOL(I) = 0. 1717 CONTINUE C GOIROL(1) = (2.81/490)*2759 GOIROL(2) = (40.72/490)*2759 GOIROL(3) = (68.80/490)*2759 GOIROL(4) = (4.21/490)*2759 GOIROL(5) = (162.86/490)*2759 GOIROL(6) = (103.90/490)*2759 GOIROL(7) = (106.70/490)*2759 C DR(1,8,10) = 0./PR(1,8) DR(2,8,10) = 0./PR(2,8) DR(3,8,10) = 0./PR(3,8) DR(4,8,10) = 0./PR(4,8) DR(5,8,10) = (2.41/189.63)*353/PR(5,8) DR(6,8,10) = (187.22/189.63)*353/PR(6,8) DR(7,8,10) = 0./PR(7,8) C DX(1,6,9) = (17.84671/378.36731)*314/PX(1,6) DX(2,6,9) = 0./PX(1,6) DX(3,6,9) = (248.4906/378.36731)*314/PX(3,6) DX(4,6,9) = (18.03/378.36731)*314/PX(4,6) DX(5,6,9) = (94./378.36731)*314/PX(5,6) DX(6,6,9) = 0./PX(6,6) DX(7,6,9) = 0./PX(7,6) C DX(1,8,10) = (106.93/107.93)*1315/PX(1,8) DX(5,8,10) = (1./107.93)*1315/PX(5,8) C DX( 8,6,9) = 8913./PX(8,6) DX(11,6,9) = 1943./PX(11,6) DX(10,6,9) = 1750./PX(10,6) DX( 8,8,10) = 569/PX(8,8) DX(10,8,10) = 2524./PX(10,8) DX(11,8,10) = 2822./PX(11,8) C DTR(12,10) = CBET(1)*DR(1,8,10)+CBET(5)*DR(5,8,10)+ 1 CBET(6)*DR(6,8,10)+CBET(8)*DX(1,8,10)+CBET(15)*DX(8,8,10)+ 2 CBET(17)*DX(10,8,10)+CBET(18)*DX(11,8,10) C DTR(10,9) = CBET(8)*DX(1,6,9)+CBET(10)*DX(3,6,9)+ 1 CBET(11)*DX(4,6,9)+CBET(15)*DX(8,6,9)+CBET(18)*DX(11,6,9) XTR = 0.0 C DMANR(1) = (36/43.12)*5.256394 /PX(8,1) DMANR(2) = (36/43.12)*11.62070 /PX(8,2) DMANR(3) = (36/43.12)*7.492198 /PX(8,3) DMANR(4) = (36/43.12)*18.75339 /PX(8,4) DMANR(5) = (81/27.87)*9.023821 /PX(8,5) DMANR(6) = (81/27.87)*15.66232 /PX(8,6) DMANR(7) = (81/27.87)*3.191157 /PX(8,7) C C UPRINV(1) = 2747. / PUPRIN(1) UPRINV(2) = 1275./ PUPRIN(2) UPRINV(3) = 1931./ PUPRIN(3) UPRINV(4) = 7706. / PUPRIN(4) C poisoc = 0. poitra = 0. poicon = 0. poiind = 0. c do 135 i=1,7 poisoc = poisoc + pr(i,8) * gsnv(i) poitra = poitra + pr(i,8) * tinv(i) poicon = poicon + pr(i,8) * conv(i) poiind = poiind + pr(i,8) * iinv(i) 135 continue c do 136 i=8,18 poisoc = poisoc + px(i,8) * gsnv(i) poitra = poitra + px(i,8) * tinv(i) poicon = poicon + px(i,8) * conv(i) poiind = poiind + px(i,8) * iinv(i) 136 continue GOISOC = 1182. / poiSOC GOITRA = 2200./ poiTRA GOICON = 83. / poiCON GOIIND = 2039./ poIIND C DO 201 I = 1,7 PGNV(I) = 0. PHNV(I) = 0. DO 202 J = 1,18 PGNV(I) = PGNV(I) + GINV(J)*PX(J,I) 202 CONTINUE GOIRUR(I) = GOIROL(I) / PGNV(I) 201 CONTINUE C c c Food to Cash deliveries distributed over regions according to LSU number c See i-o table 86/87. c Distribution within Food sectors according to gross production value. c tlsu = 0. do 91 i=1,7 tlsu = tlsu + grqr(7,i) 91 continue c do 200 i=1,7 vfdr(i) = ( grqr(7,i) / tlsu ) * 667. tpv(i) = pr(1,i) * grqr(1,i) + pr(2,i) * grqr(2,i) + 1 pr(3,i) * grqr(3,i) + pr(4,i) * grqr(4,i) do 2011 j=1,4 fdr(j,i) = grqr(j,i) * vfdr(i) / tpv(i) 2011 continue 200 continue c c RETURN END C file 20 SUBROUTINE CONSUM(REGION) C $DEBUG C IMPLICIT REAL (A-Z) LOGICAL RALLWD C REAL PF(19),X(14),G(3),B(5),C(14),BUDGET,XR(5), 1 MRES,MSUB(3),M(14) INTEGER J,REGION C C include 'genblk.for' C c COMMON /GENBLK/GRQR(7,7),SLOC(5,7),DIMSE(3,7),DCHEM(7),FDR(4,7), c 1 DMANR(7),AREA(7),PT(12),PR(7,9),PX(18,10),YREM(8),YX17PR, c 2 Y811PR,YTRANS(8),NOFHH(8),DX(18,10,10),DR(7,10,10),CBET(25), c 3 SR(7,10,10),SAVE(8),RINV(18,7),CINV(18,7),SX(12),CODEM(22,8), c 4 THETA(8),S1(8),S2(7),MUINV(7),PWAURB,YRDTRA,PVTBUD,CLOSS(5), c 5 DBUD(8),RINVPR(7),DTR(12,10),ST(12),DCONSD(21,8),CVFLAG(8) c 6 ,RALLWD(7,10,10),reserv(100) C C C C PX IS FINAL PRICES (MARKET VALUE) C DBUD IS CONSUMER BUDGET, S1 IS SAVINGS RATE,X IS CONSUMER DEMAND C NOFHH IS INFLATION FACTOR FOR CONSUMER DEMAND C CODEM CONTAINS COEFFICIENTS FOR DEMAND EQUATION IN THE FOLLOWING FORM C EVERY REGION HAS ITS COLUMN, EVERY COLUMN CONSISTS OF C C(1)..C(14),B(1)..B(5),G(1)..G(3) C C C C INITIALIZE LOCAL VARIABLES C C IF ((REGION .LT. 1) .OR. (REGION .GT. 8)) STOP ' wrong regionnr' C C IF (DBUD(REGION) .LE. 0.0 ) STOP ' BUDGET NEGATIVE ' BUDGET = DBUD(REGION)*1.0E6 MRES = BUDGET DO 1 J=1,3 G(J) = CODEM(J+19,REGION) 1 CONTINUE C C DO 2 J = 1,5 B(J) = CODEM(14+J,REGION) PF(J) = PR(J,REGION) 2 CONTINUE C C DO 3 J = 6,19 C(J-5)=CODEM(J-5,REGION) PF(J) = PX(J-5,REGION) 3 CONTINUE PF(12) = PR(7,REGION) C DO 4 J=1,3 IF (B(J) .EQ. .0) THEN MSUB(J) = G(J)*PF(J+5) ELSE IF (B(J) .EQ. 1. ) THEN MSUB(J)=G(J)*(1.+CLOSS(J))*PF(J) ELSE XHLP=B(J)*LOG((1.+CLOSS(J))*PF(J)/B(J)) + 1 (1.-B(J))*LOG(PF(J+5)/(1-B(J))) MSUB(J) = G(J) * EXP(XHLP) ENDIF C MRES = MRES - MSUB(J) C 4 CONTINUE C C DO 5 J=1,3 M(J) = MSUB(J) + C(J) * MRES 5 CONTINUE C C DO 6 J=4,14 M(J) = C(J) * MRES 6 CONTINUE C C DO 7 J = 1,5 XR(J) = B(J) * M(J) / PF(J) X(J) = (1.-B(J)) * M(J) / PF(J+5) 7 CONTINUE C C DO 8 J=6,14 if ( m(j) .gt. 0.) then X(J) = M(J) / PF(J+5) else x(j) = 0. endif 8 CONTINUE C C C RETURN CONSUMPTION C C DO 9 J = 1,5 DCONSD(J,REGION) = XR(J) * NOFHH(REGION) / 1.0E6 DCONSD(J+7,REGION) = X(J) * NOFHH(REGION) / 1.0E6 9 CONTINUE C DO 10 J=6,14 DCONSD(J+7,REGION) = X(J) * NOFHH(REGION) / 1.0E6 10 CONTINUE DCONSD(6,REGION) = 0. DCONSD(7,REGION) = DCONSD(14,REGION) DCONSD(14,REGION) = 0. C C RETURN END C C c SUBROUTINE PXLOC C $DEBUG C C C THIS ROUTINE COMPUTES PRICES OF URBAN GOODS C IN RURAL REGIONS AND SOME SECONDARY URBAN C PRICES C C IMPLICIT REAL (A-Z) LOGICAL RALLWD INTEGER I,J REAL UTC(7),CX(7) C C include 'urbblk.for' c COMMON /URBBLK/ CALFUR(4),DLAURB(4),CAURB(4),EKURB(4),SWAGE(5), c 1 IOCO(18,4),UFOODX(11,7),UFOODR(7,7),UXLAB(7),UX17OS(7), c 2 UXDEP(7),DELTA(4),UVDEPR(4),PUPRIN(4),CUPRIN(18,4),UPRINV(4) C C include 'genblk.for' c COMMON /GENBLK/GRQR(7,7),SLOC(5,7),DIMSE(3,7),DCHEM(7),FDR(4,7), c 1 DMANR(7),AREA(7),PT(12),PR(7,9),PX(18,10),YREM(8),YX17PR, c 2 Y811PR,YTRANS(8),NOFHH(8),DX(18,10,10),DR(7,10,10),CBET(25), c 3 SR(7,10,10),SAVE(8),RINV(18,7),CINV(18,7),SX(12),CODEM(22,8), c 4 THETA(8),S1(8),S2(7),MUINV(7),PWAURB,YRDTRA,PVTBUD,CLOSS(5), c 5 DBUD(8),RINVPR(7),DTR(12,10),ST(12),DCONSD(21,8),CVFLAG(8) c 6 ,RALLWD(7,10,10),reserv(100) C C include 'gblk.for' c COMMON /GBLK/GINV(18),HINV(18),GSNV(18),IINV(18),TINV(18), c 1 CONV(18),GOIRUR(7),GOIOTH(7),GOISOC,GOIIND,GOICON,GOITRA, c 2 GCSER(18),TAU(7),AVINTA(18),AVROTA(18),AVLOTA(18),PSI(3,7), c 3 PCH(7),GOIUR1(18),GOIUR2(18),GOVDEM(18),DTPTLO,DTPTFO,GLABCO, c 4 TRSUBS,TROPSS,TRILHH,FORAST,YGOVTO,GAMGOV(8),GOCON(18) C C C include 'blnblk.for' c common xprcn,slaurb,iprsvc,iprtra,shrsr(7,10,10),shrdr(7,10,10), c 1 shrdx(18,10,10) C do 1 j=13,17,2 px(j,5) = px(j,9)*(1.+avinta(j))+pt(9)*cbet(j+7) px(j,6) = px(j,9)*(1.+avinta(j))+pt(10)*cbet(j+7) px(j,7) = px(j,9)*(1.+avinta(j))+pt(11)*cbet(j+7) px(j,3) = shrdx(j,6,3)*( px(j,6)+cbet(j+7)*pt(3) ) + 1 shrdx(j,8,3)*( px(j,8)+cbet(j+7)*pt(7) ) px(j,8) = shrdx(j,3,8)*( px(j,3)+cbet(j+7)*pt(7) ) + 1 shrdx(j,7,8)*( px(j,7)+cbet(j+7)*pt(8) ) c c px(j,2) = px(j,5) + cbet(j+7)*pt(2) px(j,1) = px(j,3) + cbet(j+7)*pt(1) px(j,4) = px(j,7) + cbet(j+7)*pt(4) 1 continue c c c do 2 j=14,18,2 px(j,8) = px(j,10)*(1.+avrota(j)) + cbet(J+7)*pt(12) px(j,3) = shrdx(j,6,3)*( px(j,6)+cbet(j+7)*pt(3) ) + 1 shrdx(j,8,3)*( px(j,8)+cbet(j+7)*pt(7) ) px(j,7) = px(j,8)+cbet(j+7)*pt(8) px(j,6) = px(j,3)+cbet(j+7)*pt(3) px(j,5) = px(j,6) + cbet(j+7)*pt(5) px(j,2) = px(j,5) + cbet(j+7)*pt(2) px(j,1) = px(j,3) + cbet(j+7)*pt(1) px(j,4) = px(j,7) + cbet(j+7)*pt(4) C 2 continue c c do 5 j=1,7 cx(j) = 0.0 do 6 i=1,11 6 cx(j) = cx(j) + ufoodx(i,j) * px(i+7,8) do 7 i=1,7 7 cx(j) = cx(j) + ufoodr(i,j) * pr(i,8) c cx(j) = cx(j) * ( 1. + uxdep(j) + ux17os(j) ) px(j,8) = (1./(1.-avlota(j)))*(uxlab(j)*pwaurb*swage(1)+cx(j)) c 5 continue c c px(12,8) = 1. c do 8 j=1,12 px(j,3) = shrdx(j,6,3)*( px(j,6)+cbet(j+7)*pt(3) ) + 1 shrdx(j,8,3)*( px(j,8)+cbet(j+7)*pt(7) ) px(j,7) = px(j,8)+cbet(j+7)*pt(8) px(j,6) = px(j,3)+cbet(j+7)*pt(3) px(j,5) = px(j,6) + cbet(j+7)*pt(5) px(j,2) = px(j,5) + cbet(j+7)*pt(2) px(j,1) = px(j,3) + cbet(j+7)*pt(1) px(j,4) = px(j,7) + cbet(j+7)*pt(4) c 8 continue c return end C SUBROUTINE LOCNHB(DISNO,WEG,DIS,NEIGHB) C $DEBUG IMPLICIT REAL (A-Z) C C C LOCAL NUMBERING OR REGIONS AND ROADS TO BE USED IN MAIN C SUBROUTINE REGIO C C INTEGER DISNO,DIS(4),WEG(4),NEIGHB C C C REGION AND DISTRICT ARE USED HERE AS SYNONYM C DISNO IS THE CURRENT DISTRICT. DIS(1..4) ARE THE NEIGHBOURING C DISTRICTS. WEG(1..4) ARE THE ROADS TO THE NEIGHBOURING DISTRICTS C NEIGHB IS THE NUMBER OF NEIGHBOURS OF THE CURRENT REGION C C C C LOCAL NUMBERING OF REGIONS AND ROADS C THE SCHEME IS AS FOLLOWS C DISTR. NUMBERS C 1MOUNTAIN,2HILL_WEST,3HILL_CENTER,4HILL_EAST C 5TARAI_WEST,6TARAI_CENTER,7TARAI_EAST,8URBAN_REGION C 9INDIA,10REST_OF_THE_WORLD C TABLE OF ROAD NUMBERS C CONNECTION BETWEEN DIS.NOS ROAD NUMBER C 1-3 1 C 2-5 2 C 3-6 3 C 3-8 7 C 4-7 4 C 5-6 5 C 5-9 9 C 6-7 6 C 6-9 10 C 7-8 8 C 7-9 11 C 8-10 12 C C C IF (DISNO .EQ. 1) THEN NEIGHB = 1 DIS(1)=3 WEG(1)=1 ELSE IF (DISNO .EQ. 2) THEN NEIGHB = 1 DIS(1) = 5 WEG(1) = 2 ELSE IF (DISNO .EQ. 3) THEN NEIGHB = 3 DIS(1)=1 DIS(2)=6 DIS(3)=8 WEG(1)=1 WEG(2)=3 WEG(3)=7 ELSE IF (DISNO .EQ. 4) THEN NEIGHB = 1 DIS(1) = 7 WEG(1) = 4 ELSE IF (DISNO .EQ. 5) THEN NEIGHB = 3 DIS(1)=2 DIS(2)=6 DIS(3)=9 WEG(1)=2 WEG(2)=5 WEG(3)=9 ELSE IF (DISNO .EQ. 6) THEN NEIGHB = 4 DIS(1)=3 DIS(2)=5 DIS(3)=7 DIS(4)=9 WEG(1)=3 WEG(2)=5 WEG(3)=6 WEG(4)=10 ELSE IF (DISNO .EQ. 7) THEN NEIGHB = 4 DIS(1)=4 DIS(2)=6 DIS(3)=8 DIS(4)=9 WEG(1)=4 WEG(2)=6 WEG(3)=8 WEG(4)=11 ELSE IF (DISNO .EQ. 8) THEN NEIGHB = 3 DIS(1) = 3 DIS(2) = 7 DIS(3) = 10 WEG(1) = 7 WEG(2) = 8 WEG(3) = 12 ENDIF C RETURN END C SUBROUTINE LEES(POW,CONS) REAL POW(8),CONS(8),P(8),C(8),X1,X2 INTEGER I,K C DO 11 I = 1,8 P(I) = .9 C(I) = 8. 11 CONTINUE C c(1) = 3. c(3) = 3. c(8) = 5. C WRITE(*,*) ' GEEF POW EN CONS, 0 0 IS DEFAULT ' C K = 1 DO 1 I = 1,8 READ(*,*,END=2) X1,X2 C K = K + 1 IF (X1 .EQ. 0) THEN POW(I) = P(I) CONS(I) = C(I) ELSE POW(I) = X1 CONS(I) = X2 ENDIF C 1 CONTINUE C 2 CONTINUE DO 3 I = K,8 POW(I) = P(I) CONS(I) = C(I) 3 CONTINUE C RETURN END C C C THIS SUBROUTINE COMPUTES THE VALUE C OF DEPRECIATION OF URBAN CAPACITY C BESIDES THE PRICE OF INVESTMENTS C IS COMPUTED C C SUBROUTINE DEPRCN C include 'genblk.for' c COMMON /GENBLK/GRQR(7,7),SLOC(5,7),DIMSE(3,7),DCHEM(7),FDR(4,7), c 1 DMANR(7),AREA(7),PT(12),PR(7,9),PX(18,10),YREM(8),YX17PR, c 2 Y811PR,YTRANS(8),NOFHH(8),DX(18,10,10),DR(7,10,10),CBET(25), c 3 SR(7,10,10),SAVE(8),RINV(18,7),CINV(18,7),SX(12),CODEM(22,8), c 4 THETA(8),S1(8),S2(7),MUINV(7),PWAURB,YRDTRA,PVTBUD,CLOSS(5), c 5 DBUD(8),RINVPR(7),DTR(12,10),ST(12),DCONSD(21,8),CVFLAG(8), c 6 RALLWD(7,10,10),reserv(100) C C include 'urbblk.for' c COMMON /URBBLK/ CALFUR(4),DLAURB(4),CAURB(4),EKURB(4),SWAGE(5), c 1 IOCO(18,4),UFOODX(11,7),UFOODR(7,7),UXLAB(7),UX17OS(7), c 2 UXDEP(7),DELTA(4),UVDEPR(4),PUPRIN(4),CUPRIN(18,4),UPRINV(4) C C INTEGER I REAL Q(18) C CALL CVECTK(18,10,PX,8,1,18,Q) C CALL MGM(1,18,4,Q,0,CUPRIN,0,PUPRIN,0) C DO 1 I=1,4 UVDEPR(I) = PUPRIN(I) * DELTA(I) * EKURB(I) 1 CONTINUE C RETURN END c SUBROUTINE TRANCO C IMPLICIT REAL (A-Z) LOGICAL RALLWD C include 'genblk.for' c COMMON /GENBLK/GRQR(7,7),SLOC(5,7),DIMSE(3,7),DCHEM(7),FDR(4,7), c 1 DMANR(7),AREA(7),PT(12),PR(7,9),PX(18,10),YREM(8),YX17PR, c 2 Y811PR,YTRANS(8),NOFHH(8),DX(18,10,10),DR(7,10,10),CBET(25), c 3 SR(7,10,10),SAVE(8),RINV(18,7),CINV(18,7),SX(12),CODEM(22,8), c 4 THETA(8),S1(8),S2(7),MUINV(7),PWAURB,YRDTRA,PVTBUD,CLOSS(5), c 5 DBUD(8),RINVPR(7),DTR(12,10),ST(12),DCONSD(21,8),CVFLAG(8) c 6 ,RALLWD(7,10,10),reserv(100) C C include 'gblk.for' c COMMON /GBLK/GINV(18),HINV(18),GSNV(18),IINV(18),TINV(18), c 1 CONV(18),GOIRUR(7),GOIOTH(7),GOISOC,GOIIND,GOICON,GOITRA, c 2 GCSER(18),TAU(7),AVINTA(18),AVROTA(18),AVLOTA(18),PSI(3,7), c 3 PCH(7),GOIUR1(18),GOIUR2(18),GOVDEM(18),DTPTLO,DTPTFO,GLABCO, c 4 TRSUBS,TROPSS,TRILHH,FORAST,YGOVTO,GAMGOV(8),GOCON(18) C C include 'glblk.for' c COMMON /GLBLK/ GVIRUR,GVISOC,GVIIND,GVITRA,GVICON,GVITOT, c 1 GVCOMM,AGINPT,AVTAX,GOSER,GVBUD,GVSER,IMDUIN,IMDURO, c 2 SAVSPL,PGSVC,LTAX,GOVEMP C C include 'blnblk.for' c COMMON IPRCON,IPRMAN,IPRSVC,IPRTRA cC C include 'urbblk.for' c COMMON /URBBLK/ CALFUR(4),DLAURB(4),CAURB(4),EKURB(4),SWAGE(5), c 1 IOCO(18,4),UFOODX(11,7),UFOODR(7,7),UXLAB(7),UX17OS(7), c 2 UXDEP(7),DELTA(4),UVDEPR(4),PUPRIN(4),CUPRIN(18,4),UPRINV(4) C INTEGER ROAD(10,10),I,D1,D2,J REAL QT(13),TCOST C DATA ROAD /100*0/ C QT(1) = 0. do 31 i = 2,13 31 qt(i) = pt(i-1) c c ROAD(1,3) = 1 ROAD(2,5) = 2 ROAD(3,6) = 3 ROAD(4,7) = 4 ROAD(5,6) = 5 ROAD(6,7) = 6 ROAD(3,8) = 7 ROAD(7,8) = 8 ROAD(5,9) = 9 ROAD(6,9) = 10 ROAD(7,9) = 11 ROAD(8,10) = 12 C DO 1 I = 1,10 DO 1 J = I,10 ROAD(J,I) = ROAD(I,J) 1 CONTINUE C TCOST = 0. DO 2 I = 1,18 DO 2 D1= 1,10 DO 2 D2= 1,10 TCOST = TCOST + CBET(I+7) * QT(1+ROAD(D1,D2)) * DX(I,D1,D2) 2 CONTINUE C DO 3 I = 1,7 DO 3 D1= 1,10 DO 3 D2= 1,10 TCOST = TCOST+CBET(I)*QT(1+ROAD(D1,D2))* 1 (DR(I,D1,D2)+SR(I,D1,D2)) 3 CONTINUE C WRITE(*,*) ' TOTAL TRANSPORTATION COST IS% ',TCOST RETURN END c SUBROUTINE UNFRW(IUNIT,IRW) IMPLICIT REAL (A-Z) LOGICAL RALLWD,eris CHARACTER BAND*5,BND(5) C include 'urbblk.for' c COMMON /URBBLK/ CALFUR(4),DLAURB(4),CAURB(4),EKURB(4),SWAGE(5), c 1 IOCO(18,4),UFOODX(11,7),UFOODR(7,7),UXLAB(7),UX17OS(7), c 2 UXDEP(7),DELTA(4),UVDEPR(4),PUPRIN(4),CUPRIN(18,4),UPRINV(4) C C include 'genblk.for' c COMMON /GENBLK/GRQR(7,7),SLOC(5,7),DIMSE(3,7),DCHEM(7),FDR(4,7), c 1 DMANR(7),AREA(7),PT(12),PR(7,9),PX(18,10),YREM(8),YX17PR, c 2 Y811PR,YTRANS(8),NOFHH(8),DX(18,10,10),DR(7,10,10),CBET(25), c 3 SR(7,10,10),SAVE(8),RINV(18,7),CINV(18,7),SX(12),CODEM(22,8), c 4 THETA(8),S1(8),S2(7),MUINV(7),PWAURB,YRDTRA,PVTBUD,CLOSS(5), c 5 DBUD(8),RINVPR(7),DTR(12,10),ST(12),DCONSD(21,8),CVFLAG(8) c 6 ,RALLWD(7,10,10),reserv(100) C C include 'gblk.for' c COMMON /GBLK/GINV(18),HINV(18),GSNV(18),IINV(18),TINV(18), c 1 CONV(18),GOIRUR(7),GOIOTH(7),GOISOC,GOIIND,GOICON,GOITRA, c 2 GCSER(18),TAU(7),AVINTA(18),AVROTA(18),AVLOTA(18),PSI(3,7), c 3 PCH(7),GOIUR1(18),GOIUR2(18),GOVDEM(18),DTPTLO,DTPTFO,GLABCO, c 4 TRSUBS,TROPSS,TRILHH,FORAST,YGOVTO,GAMGOV(8),GOCON(18) C include 'trblk.for' c COMMON /TRBLK/ CATR(12),CALFTR(12),EKTR(12),DRDTR(12),XTR include 'glblk.for' c COMMON /GLBLK/ GVIRUR,GVISOC,GVIIND,GVITRA,GVICON,GVITOT, c 1 GVCOMM,AGINPT,AVTAX,GOSER,GVBUD,GVSER,IMDUIN,IMDURO, c 2 SAVSPL,PGSVC,LTAX,GOVEMP C C include 'blnblk.for' c COMMON IPRCON,IPRMAN,IPRSVC,IPRTRA REAL BLKURB(328),BLKGEN(5269),BLKG(321),BLKGL(18),BLKTR(49), 1 BLKBLN(4) C EQUIVALENCE (CATR(1),BLKTR(1)),(GRQR(1,1),BLKGEN(1)), 1 (GINV(1),BLKG(1)),(GVIRUR,BLKGL(1)),(CALFUR(1),BLKURB(1)), 2 (IPRCON,BLKBLN(1)),(BAND,BND) C C INTEGER IUNIT,IRW,J,i C IF IRW=0 : READ C IF IRW=1 : WRITE c c BAND = 'TAPE ' BND(5) = CHAR(48+IUNIT) OPEN(IUNIT,file=BAND,FORM='UNFORMATTED',STATUS='old') rewind(iunit) c c c reading of the arrays in parts of 256 elements IF(IRW.EQ.0)THEN READ(IUNIT)(BLKURB(I),I=1,256) READ(IUNIT)(BLKURB(I),I=257,328) J=0 1 READ(IUNIT)(BLKGEN(I+J*256),I=1,256) J=J+1 IF(J.LE.19)THEN GOTO 1 ELSE READ(IUNIT)(BLKGEN(I+5120),I=1,149) ENDIF READ(IUNIT)(BLKG(I),I=1,256) READ(IUNIT)(BLKG(I),I=257,321) READ(IUNIT) BLKGL READ(IUNIT) BLKTR READ(IUNIT) BLKBLN c writing of the arrays in parts of 256 elements ELSEIF (IRW.EQ.1) THEN WRITE(IUNIT)(BLKURB(I),I=1,256) WRITE(IUNIT)(BLKURB(I),I=257,328) J=0 2 WRITE(IUNIT)(BLKGEN(I+J*256),I=1,256) J=J+1 IF(J.LE.19)THEN GOTO 2 ELSE WRITE(IUNIT)(BLKGEN(I+5120),I=1,149) ENDIF WRITE(IUNIT)(BLKG(I),I=1,256) WRITE(IUNIT)(BLKG(I),I=257,321) WRITE(IUNIT) BLKGL WRITE(IUNIT) BLKTR WRITE(IUNIT) BLKBLN ENDIF CLOSE(IUNIT) RETURN END c LOGICAL FUNCTION EQVEC(N,V1,V2) C INTEGER N,I REAL V1(N),V2(N) LOGICAL TEMP,EQUAL C TEMP = .TRUE. C DO 1 I = 1,N TEMP = ( TEMP .AND. EQUAL(V1(I),V2(I))) 1 CONTINUE C EQVEC = TEMP C RETURN END C C X1 AND X2 SHOULD BE POSITIVE C LOGICAL FUNCTION EQUAL(X1,X2) C REAL X1,X2,XPRCN include 'blnblk.for' c COMMON XPRCN,IPRMAN,IPRSVC,IPRTRA cC EQUAL=((ABS(X1).GE. XPRCN*ABS(X2)).AND.(ABS(X2).GE.XPRCN*ABS(X1))) RETURN END C LOGICAL FUNCTION GRTR(X1,X2) C REAL X1,X2,XPRCN include 'blnblk.for' c COMMON XPRCN,IPRMAN,IPRSVC,IPRTRA cC GRTR =(ABS(X2).LT.XPRCN*ABS(X1)) RETURN END C LOGICAL FUNCTION LESS(X1,X2) C REAL X1,X2,XPRCN include 'blnblk.for' c COMMON XPRCN,IPRMAN,IPRSVC,IPRTRA cC LESS = (ABS(X1).LT. XPRCN*ABS(X2)) RETURN END C C C REAL FUNCTION POWER(X,Y) C C C X TO THE POWER Y C PROGRAM ABORTS IF X NEGATIVE C REAL X,Y,C C IF (X.LE.0) STOP ' FIRST ARGUMENT NEGATIVE IN FUNCTION POWER ' C = Y * LOG(X) POWER = EXP(C) RETURN END C C SUBROUTINE CVECTK(M1,M2,MAT,COLNO,I1,I2,VEC) C C C C THIS SUBROUTINE TAKES A COLUMN VECTOR OUT OF C A MATRIX. THE DIMENSION OF THE MATRIX IS C (M1,M2), COLNO IS THE COLUMN NUMBER TO BE C TAKEN, I1 BEGINNING INDEX, I2 FINAL INDEX C C INTEGER M1,M2,I1,I2,COLNO,I C REAL MAT(M1,M2),VEC(*) C DO 1 I = I1,I2 VEC(I-I1+1) = MAT(I,COLNO) 1 CONTINUE C RETURN END c SUBROUTINE MGM(D1,D2,D3,A1,T1,A2,T2,A3,T3) C C C THIS SUBROUTINE SUPPLIES A GENERAL MATRIX MULTIPLICATION PROCEDURE C THE PARAMETERS ARE AS FOLLOWS C D1,D2 IS THE DIMENSION OF THE LEFTMOST MULTIPLICANT A1, TAKING INTO C CONSIDERATION TRANSPOSITION. D2,D3 IS THE DIMENSION OF THE SECOND C MULTIPLIER A2 ALSO AFTER TAKING ACCOUNT OF TRANSPOSING THE MATRIX. C THE RESULT IS OF DIMENSION D1,D3 AND STORED INTO POSSIBLY TRANSPOSED A C T1,T2 AND T3 ARE TRANSPOSITION INDICATORS. IF 0 NO TRANSPOSITION, IF 1 C THE CORRESPONDING A IS TRANSPOSED. C EXAMPLE A_(3,4),B_(5,4),C_(5,3). TO GET INTO C THE PRODUCT OF C B AND A-TRANSPOSED THE CALL SHOULD BE C CALL MGM(5,4,3,B,0,A,1,C,0) C C ANOTHER CALL WITH THE SAME RESULT WOULD BE C CALL MGM(3,4,5,A,0,B,1,C,1) C C C NOTE THE ACTUAL PARAMETERS SHOULD BE CHOSEN VERY CAREFULLY C SINCE THERE IS NOT CHECKING ON ARRAY BOUNDS WHATEVER. C INTEGER D1,D2,D3,T1,T2,T3,I,J,K,I1,I2,I3 REAL A1(*),A2(*),A3(*) C DO 1 I=1,D1 DO 2 J=1,D3 C I3=(1-T3)*(I+(J-1)*D1)+T3*(J+(I-1)*D3) A3(I3) = 0.0 C DO 3 K=1,D2 I1=(1-T1)*(I+(K-1)*D1)+T1*(K+(I-1)*D2) I2=(1-T2)*(K+(J-1)*D2)+T2*(J+(K-1)*D3) A3(I3)=A3(I3)+A1(I1)*A2(I2) C 3 CONTINUE 2 CONTINUE 1 CONTINUE RETURN END C C SUBROUTINE RVECTK(M1,M2,MAT,ROWNO,I1,I2,VEC) C C C SIMILAR TO RVECTAK C INTEGER M1,M2,I1,I2,ROWNO,I REAL MAT(M1,M2),VEC(*) C DO 1 I = I1,I2 VEC(I-I1+1) = MAT(ROWNO,I) 1 CONTINUE RETURN END C C SUBROUTINE VECVEC(N,A,B,C) C C C DOTPRODUCT ROUTINE. THE INNER PRODUCT OF A AND B IS DELIVERED IN C C INTEGER I,N REAL A,B,C DIMENSION A(N),B(N) C C = 0.0 DO 1 I=1,N C = C + A(I) * B(I) 1 CONTINUE RETURN END C C REAL FUNCTION FRAC(POW,CONS,Z) C C REAL POW,CONS,Z,ZHLP C ZHLP = (ABS(Z))**POW FRAC = ZHLP / (ZHLP + CONS) C RETURN END C file 21 SUBROUTINE URBBUD IMPLICIT REAL (A-Z) LOGICAL RALLWD C C include 'genblk.for' cc COMMON /GENBLK/GRQR(7,7),SLOC(5,7),DIMSE(3,7),DCHEM(7),FDR(4,7), c 1 DMANR(7),AREA(7),PT(12),PR(7,9),PX(18,10),YREM(8),YX17PR, c 2 Y811PR,YTRANS(8),NOFHH(8),DX(18,10,10),DR(7,10,10),CBET(25), c 3 SR(7,10,10),SAVE(8),RINV(18,7),CINV(18,7),SX(12),CODEM(22,8), c 4 THETA(8),S1(8),S2(7),MUINV(7),PWAURB,YRDTRA,PVTBUD,CLOSS(5), c 5 DBUD(8),RINVPR(7),DTR(12,10),ST(12),DCONSD(21,8),CVFLAG(8) c 6 ,RALLWD(7,10,10),reserv(100) C C include 'gblk.for' cc COMMON /GBLK/GINV(18),HINV(18),GSNV(18),IINV(18),TINV(18), c 1 CONV(18),GOIRUR(7),GOIOTH(7),GOISOC,GOIIND,GOICON,GOITRA, c 2 GCSER(18),TAU(7),AVINTA(18),AVROTA(18),AVLOTA(18),PSI(3,7), c 3 PCH(7),GOIUR1(18),GOIUR2(18),GOVDEM(18),DTPTLO,DTPTFO,GLABCO, c 4 TRSUBS,TROPSS,TRILHH,FORAST,YGOVTO,GAMGOV(8),GOCON(18) C C include 'glblk.for' cc COMMON /GLBLK/ GVIRUR,GVISOC,GVIIND,GVITRA,GVICON,GVITOT, c 1 GVCOMM,AGINPT,AVTAX,GOSER,GVBUD,GVSER,IMDUIN,IMDURO, c 2 SAVSPL,PGSVC,LTAX,GOVEMP C C include 'blnblk.for' cc COMMON IPRCON,IPRMAN,IPRSVC,IPRTRA cC C include 'urbblk.for' cc COMMON /URBBLK/ CALFUR(4),DLAURB(4),CAURB(4),EKURB(4),SWAGE(5), c 1 IOCO(18,4),UFOODX(11,7),UFOODR(7,7),UXLAB(7),UX17OS(7), c 2 UXDEP(7),DELTA(4),UVDEPR(4),PUPRIN(4),CUPRIN(18,4),UPRINV(4) C C INTEGER I,J REAL VIPRVT,RSVSPL,GB0,PB0,XX,VA(7),XHELP C C C THIS ROUTINE CALCULATES URBAN BUDGET OF C PRIVATE AND GOVERNMENT AGENTS. THERE IS C PARTLY MUTUAL DETERMINATION OF THIS BUDGET C FIRST THE INDEPENDENT BUDGET PARTS ARE C COMPUTED. C C INDEPENDENT PART OF GOVERNMENT BUDGET C GVIRUR = 0.0 GVISOC = 0.0 GVIIND = 0.0 GVITRA = 0.0 GVICON = 0.0 C DO 1 J=1,18 C C GVIRUR C DO 2 I=1,7 GVIRUR = GVIRUR + PX(J,I)* 1 (GINV(J)*GOIRUR(I)+HINV(J)*GOIOTH(I)) 2 CONTINUE C C UNIT PRICE OF GVISOC,ETC. C GVISOC = GVISOC + GSNV(J)*PX(J,8) GVIIND = GVIIND + IINV(J)*PX(J,8) GVITRA = GVITRA + TINV(J)*PX(J,8) GVICON = GVICON + CONV(J)*PX(J,8) C 1 CONTINUE C C TOTAL VALUE OF GVISOC ETC. C GVISOC = GVISOC * GOISOC GVIIND = GVIIND * GOIIND GVITRA = GVITRA * GOITRA GVICON = GVICON * GOICON C C TOTAL VALUE OF INVESTMENTS C GVITOT = GVIRUR + GVISOC + GVIIND + GVITRA + GVICON C C C C C TOTAL COMMITTED EXPENDITURE C TRILHH = 0.0 C DO 21 I = 1,8 TRILHH = TRILHH + YTRANS(I) 21 CONTINUE C GVCOMM = GVITOT + DTPTLO + DTPTFO + TROPSS + TRILHH C C GOVERNMENT INCOME SOURCES C C LANDTAX C CALL VECVEC(7,TAU,AREA,LTAX) C C DUTIES ON IMPORTS FROM INDIA C IMDUIN = 0.0 DO 3 J = 13,17,2 IMDUIN = IMDUIN + PX(J,9) * AVINTA(J)* 1 ( DX(J,9,5) + DX(J,9,6) + DX(J,9,7) ) 3 CONTINUE C C DUTIES ON IMPORTS FROM OTHER COUNTRIES C IMDURO = 0.0 DO 4 J = 14,18,2 IMDURO = IMDURO + PX(J,10) * AVROTA(J) * DX(J,10,8) 4 CONTINUE C C LOCAL SALES TAXES C AVTAX = 0.0 DO 5 J = 1,12 AVTAX = AVTAX + PX(J,8) * AVLOTA(J) * SX(J) 5 CONTINUE C C SALES OF SEEDS AND FERTILIZER C AGINPT = 0.0 DO 6 I = 1,7 AGINPT = AGINPT + PCH(I) * DCHEM(I) DO 7 J = 1,3 AGINPT = AGINPT + PSI(J,I) * DIMSE(J,I) 7 CONTINUE 6 CONTINUE C C SURPLUS OF RURAL DOMESTIC SAVINGS OVER RURAL PRIVATE INVESTMENT C RSVSPL = 0.0 DO 8 I = 1,7 RSVSPL = RSVSPL + SAVE(I) DO 9 J = 1,18 RSVSPL = RSVSPL - PX(J,I) * RINV(J,I) 9 CONTINUE 8 CONTINUE C CALL DEPRCN C CALL VECVEC(4,PUPRIN,UPRINV,VIPRVT) C C C GOVMT FIXED BUDGET PART C C GB0 = LTAX + IMDUIN + IMDURO + AGINPT + FORAST + AVTAX + 1 RSVSPL - VIPRVT + reserv(20) c c reserv(20) is non tax revenue c C C NOW THE INDEPENDENT PART OF THE C URBAN BUDGET IS COMPUTED C C DO 31 J = 1,7 VA(J) = (UXLAB(J)*PWAURB*SWAGE(1)+(UXDEP(J)+UX17OS(J))*PX(J,8)* 1 (1-AVLOTA(J)))/(1+UXDEP(J)+UX17OS(J)) 31 CONTINUE C CALL VECVEC(7,VA,SX,XHELP) YX17PR = 0.7*YX17PR + 0.3*XHELP C PB0 = THETA(8) *(Y811PR + YX17PR + YRDTRA)+YTRANS(8)+YREM(8)+ 1 TROPSS + DTPTLO - reserv(20) C C UNIT PRICE OF GOVERNMENT SERVICES C C PGSVC = 0.0 DO 10 J = 1,18 PGSVC = PGSVC + PX(J,8) * GCSER(J) 10 CONTINUE C PGSVC = PGSVC + PWAURB * GLABCO * SWAGE(5) C XX = S1(8) * GAMGOV(8) * PWAURB * GLABCO *SWAGE(5)/ PGSVC C GVBUD = (GB0 + S1(8)*PB0)/(1-XX) - XX * GVCOMM / (1-XX) PVTBUD = PB0 + XX * (GVBUD - GVCOMM) / S1(8) GVSER = GVBUD - GVCOMM C C GV SERVICES IN REAL TERMS C GOSER = GVSER / PGSVC C C OUTPUT OF IMPORTANT GOVERNMENT DEMAND COMPONENTS C DO 11 J=1,18 GOIUR1(J) = IINV(J)*GOIIND + CONV(J)*GOICON + TINV(J)*GOITRA GOIUR2(J) = GSNV(J)*GOISOC GOCON(J) = GCSER(J)*GOSER GOVDEM(J) = GOIUR1(J) + GOIUR2(J) + GOCON(J) 11 CONTINUE C GOVEMP = GLABCO * GOSER YGOVTO = PWAURB * GOVEMP * SWAGE(5) C RETURN END c c c c SUBROUTINE URBPRO C C C THIS ROUTINE CALCULATES SUPPLY OF C SECTORS 8-11 C C IMPLICIT REAL (A-Z) LOGICAL RALLWD INTEGER I REAL P,C(4),PINP(18),R C C include 'urbblk.for' c COMMON /URBBLK/ CALFUR(4),DLAURB(4),CAURB(4),EKURB(4),SWAGE(5), c 1 IOCO(18,4),UFOODX(11,7),UFOODR(7,7),UXLAB(7),UX17OS(7), c 2 UXDEP(7),DELTA(4),UVDEPR(4),PUPRIN(4),CUPRIN(18,4),UPRINV(4) C C include 'genblk.for' c COMMON /GENBLK/GRQR(7,7),SLOC(5,7),DIMSE(3,7),DCHEM(7),FDR(4,7), c 1 DMANR(7),AREA(7),PT(12),PR(7,9),PX(18,10),YREM(8),YX17PR, c 2 Y811PR,YTRANS(8),NOFHH(8),DX(18,10,10),DR(7,10,10),CBET(25), c 3 SR(7,10,10),SAVE(8),RINV(18,7),CINV(18,7),SX(12),CODEM(22,8), c 4 THETA(8),S1(8),S2(7),MUINV(7),PWAURB,YRDTRA,PVTBUD,CLOSS(5), c 5 DBUD(8),RINVPR(7),DTR(12,10),ST(12),DCONSD(21,8),CVFLAG(8) c 6 ,RALLWD(7,10,10),RESERV(100) C C include 'gblk.for' c COMMON /GBLK/GINV(18),HINV(18),GSNV(18),IINV(18),TINV(18), c 1 CONV(18),GOIRUR(7),GOIOTH(7),GOISOC,GOIIND,GOICON,GOITRA, c 2 GCSER(18),TAU(7),AVINTA(18),AVROTA(18),AVLOTA(18),PSI(3,7), c 3 PCH(7),GOIUR1(18),GOIUR2(18),GOVDEM(18),DTPTLO,DTPTFO,GLABCO, c 4 TRSUBS,TROPSS,TRILHH,FORAST,YGOVTO,GAMGOV(8),GOCON(18) C C CALL CVECTK(18,10,PX,8,1,18,PINP) CALL CVECTK(7,9,PR,8,1,7,PINP) C C CALL MGM(1,18,4,PINP,0,IOCO,0,C,0) C C C PINP STORES INPUT PRICES FOR URBAN INTER- C MEDIATE INPUTS. C STORES COST OF INTER- C MEDIATE INPUTS. C Y811PR = 0.0 C DO 1 I =1,4 P = PX(I+7,8) * ( 1 - AVLOTA(I+7)) - C(I) R = P * CAURB(I)*CALFUR(I)/(PWAURB*SWAGE(I)) C IF (P .LE. 0) THEN DLAURB(I) = 0.0 SX(I+7) = 0.7 * SX(I+7) ELSE DLAURB(I) = POWER(R,1/(1-CALFUR(I)))*EKURB(I) SX(I+7) = 0.3*(CAURB(I) * POWER(DLAURB(I),CALFUR(I)) * 1 POWER(EKURB(I),1-CALFUR(I))) + 0.7 * SX(I+7) ENDIF C Y811PR = Y811PR + P * SX(I+7) C 1 CONTINUE C C C C DO 2 I=1,7 C SX(I)=DX(I,8,3)+DX(I,8,7)+DX(I,8,10)+DCONSD(I+7,8) C 2 CONTINUE C RETURN END C C SUBROUTINE URBREG(POW,CONS) IMPLICIT REAL (A-Z) LOGICAL RALLWD C c this version is to be used to generate base year solution c i.e. supply of transportation over roads is adjusted by c adjusting the constants of transp production functions c C include 'genblk.for' c COMMON /GENBLK/GRQR(7,7),SLOC(5,7),DIMSE(3,7),DCHEM(7),FDR(4,7), c 1 DMANR(7),AREA(7),PT(12),PR(7,9),PX(18,10),YREM(8),YX17PR, c 2 Y811PR,YTRANS(8),NOFHH(8),DX(18,10,10),DR(7,10,10),CBET(25), c 3 SR(7,10,10),SAVE(8),RINV(18,7),CINV(18,7),SX(12),CODEM(22,8), c 4 THETA(8),S1(8),S2(7),MUINV(7),PWAURB,YRDTRA,PVTBUD,CLOSS(5), c 5 DBUD(8),RINVPR(7),DTR(12,10),ST(12),DCONSD(21,8),CVFLAG(8) c 6 ,RALLWD(7,10,10),RESERV(100) C C include 'gblk.for' c COMMON /GBLK/GINV(18),HINV(18),GSNV(18),IINV(18),TINV(18), c 1 CONV(18),GOIRUR(7),GOIOTH(7),GOISOC,GOIIND,GOICON,GOITRA, c 2 GCSER(18),TAU(7),AVINTA(18),AVROTA(18),AVLOTA(18),PSI(3,7), c 3 PCH(7),GOIUR1(18),GOIUR2(18),GOVDEM(18),DTPTLO,DTPTFO,GLABCO, c 4 TRSUBS,TROPSS,TRILHH,FORAST,YGOVTO,GAMGOV(8),GOCON(18) C C include 'urbblk.for' c COMMON /URBBLK/ CALFUR(4),DLAURB(4),CAURB(4),EKURB(4),SWAGE(5), c 1 IOCO(18,4),UFOODX(11,7),UFOODR(7,7),UXLAB(7),UX17OS(7), c 2 UXDEP(7),DELTA(4),UVDEPR(4),PUPRIN(4),CUPRIN(18,4),UPRINV(4) C include 'trblk.for' c COMMON /TRBLK/CATR(12),CALFTR(12),EKTR(12),DRDTR(12),XTR C include 'blnblk.for' c COMMON XPRCN,SLAURB,IPRSVC,IPRTRA,SHRSR(7,10,10),SHRDR(7,10,10), c 1 SHRDX(18,10,10) C include 'glblk.for' c COMMON /GLBLK/ GVIRUR,GVISOC,GVIIND,GVITRA,GVICON,GVITOT, c 1 GVCOMM,AGINPT,AVTAX,GOSER,GVBUD,GVSER,IMDUIN,IMDURO, c 2 SAVSPL,PGSVC,LTAX,GOVEMP C C INDEX I,J,K REFER TO DIMENSIONS IN LEFT TO RIGHT ORDER C INTEGER DIS(4),WEG(4),IDRH(7),I,NEIGHB,J,INDDIS,INDROU,IDRL(7), 1 DIS0,N,K C C REAL RDEM(7),XDEM(18),SPEED2,PRL(7),PRH(7), 1 TDX(18),TDR(7),DT(12),VEC1(18),VEC2(18),TPI(18), 2 PPX(18),PPR(7),XID(18),RID(7),TSR(7),CX(7),POW,CONS,dlaurt C LOGICAL EQUAL,GRTR,LESS,NOADJT,CVFLAG C SPEED2 = 0.1 DO 1 I = 1,18 XID(I) = 0. 1 CONTINUE C C COMPUTE LOCAL NUMBERING OF NEIGHBOURING REGIONS C DIS0 = 8 NEIGHB = 3 DIS(1) = 3 DIS(2) = 7 DIS(3) = 10 WEG(1) = 7 WEG(2) = 8 WEG(3) = 12 C c IF (PT(7) + PT(3) + PT(10) .LT. PT(8) + PT(11)) THEN c INDROU = WEG(1) c INDDIS = DIS(1) c ELSE c INDROU = WEG(2) c INDDIS = DIS(2) c ENDIF C C RECOMPUTE PX(1-7,8) C DO 555 J=1,7 CX(J) = 0.0 DO 6 I=1,11 CX(J) = CX(J) + UFOODX(I,J)*PX(I+7,8) 6 CONTINUE DO 7 I=1,7 CX(J) = CX(J) + UFOODR(I,J) * PR(I,8) 7 CONTINUE C CX(J) = CX(J) * ( 1 + UXDEP(J) + UX17OS(J) ) PX(J,8) = (1./(1-AVLOTA(J)))*(UXLAB(J)*PWAURB*SWAGE(1)+CX(J)) C 555 CONTINUE C C C RESET URBAN ORIGINATED EXTERNAL TRADE C DO 4 I=1,7 DO 41 J=1,NEIGHB DX(I,DIS(J),8) = 0.0 DR(I,DIS(J),8) = 0.0 sr(i,8,dis(j)) = 0.0 41 CONTINUE 4 CONTINUE C C DO 5 I=8,18 DO 51 J = 1,NEIGHB DX(I,DIS(J),8) = 0.0 51 CONTINUE 5 CONTINUE C DO 501 I=1,NEIGHB DTR(WEG(I),8) = 0.0 501 CONTINUE C CALL PRICH(DIS0,PRH,IDRH) CALL PRICL(DIS0,PRL,IDRL) C do 161 i=1,7 161 ppr(i) = min( prh(i) , max(prl(i),pr(i,8)) ) CALL CVECTK(18,10,PX,8,1,18,PPX) C C DO 701 I=1,7 PR(I,8)=PPR(I) 701 CONTINUE C C C C C CALL MGM(18,4,1,IOCO,0,SX(8),0,VEC1,0) CALL MGM(7,7,1,UFOODR,0,SX,0,VEC2,0) CALL MGM(11,7,1,UFOODX,0,SX,0,VEC2(8),0) C DO 141 I = 1,7 RID(I) = VEC1(I) + VEC2(I) 141 CONTINUE C DO 43 I = 8,18 XID(I) = VEC1(I) + VEC2(I) 43 CONTINUE C C C COMPUTE TOTAL URBAN PRIVATE INVESTMENT DEMAND C CALL MGM(18,4,1,CUPRIN,0,UPRINV,0,TPI,0) C C DEMAND FOR X-GOODS FROM OTHER REGIONS C DO 602 I = 1,18 XDEM(I) = 0.0 DO 62 J = 1,NEIGHB XDEM(I) = XDEM(I) + DX(I,8,DIS(J)) 62 CONTINUE 602 CONTINUE C C ADD GOVERNMENT DEMAND ,INTERMEDIATE DEMAND AND PRIVATE INVESTMENTS C DO 601 I=1,18 XDEM(I) = XDEM(I) + GOVDEM(I) + TPI(I) + XID(I) 601 CONTINUE C C C DEMAND AND SUPPLY OF R-GOODS FROM OTHER REGIONS C C DO 603 I = 1,7 RDEM(I) = RID(I) TSR(I) = 0.0 DO 63 J = 1,NEIGHB RDEM(I) = RDEM(I) + DR(I,8,DIS(J)) TSR(I) = TSR(I) + SR(I,DIS(J),8) 63 CONTINUE 603 CONTINUE C SAVE(8) = S1(8) * PVTBUD DBUD(8) = (PVTBUD - SAVE(8))/NOFHH(8) C C CONSUMER DEMAND IN VOLUME C CALL CONSUM(8) C C C TOTAL DEMAND IN VOLUME C DO 2001 I=1,14 TDX(I)=XDEM(I) + DCONSD(I+7,8) 2001 CONTINUE C TDX(10) = TDX(10) + XTR C DO 706 I=15,18 TDX(I) = XDEM(I) 706 CONTINUE C DO 707 I=1,7 TDR(I) = RDEM(I) + DCONSD(I,8) 707 CONTINUE C C ADJUST PRICES OF R-GOODS C NOADJT = .TRUE. DO 101 I=1,7 IF (TDR(I) .GT. TSR(I)) THEN ppr(i) = prh(i) pr(i,8) = prh(i) c dr(i,dis(idrh(i)),8) = tdr(i) - tsr(i) c do 1013 j = 1,neighb 1013 dr(i,dis(j),8)=shrdr(i,dis(j),8)*(tdr(i)-tsr(i)) c c c DR(I,DIS(IDRH(I)),8) = TDR(I) - TSR(I) c PPR(I) = PRH(I) c ELSE IF (TDR(I) .LT. TSR(I)) THEN c IF (PPR(I).LE.PRL(I)*(1.+1.E-6)+1.E-6) THEN c PPR(I) = PRL(I) c SR(I,8,DIS(IDRL(I))) = TSR(I) - TDR(I) c ELSE c PPR(I)=PPR(I)+FRAC(POW,CONS,TDR(I)-TSR(I)) c 1 *(PRL(I)-PPR(I)) c NOADJT = .FALSE. c ENDIF c ENDIF c c else if (tdr(i) .lt. tsr(i)) then c ppr(i) = prl(i) pr(i,8) = prl(i) c sr(i,8,dis(idrl(i))) = tsr(i) - tdr(i) do 1014 j = 1,neighb 1014 sr(i,8,dis(j))=shrsr(i,8,dis(j))*(tsr(i)-tdr(i)) c endif c c PR(I,8) = PPR(I) c 101 CONTINUE C C C DO 831 I = 8,11 IF ( .NOT. EQUAL(TDX(I),SX(I))) THEN NOADJT = .FALSE. IF (TDX(I) .GT. SX(I)) THEN PPX(I) = (1.+0.2*FRAC(POW,CONS,1.-SX(I)/TDX(I)))*PPX(I) ELSE PPX(I) = (1.-0.2*FRAC(POW,CONS,1.-TDX(I)/SX(I)))*PPX(I) ENDIF ENDIF PX(I,8) = PPX(I) 831 CONTINUE C C DO 837 I =13,17,2 DX(I,3,8) = shrdx(i,3,8) * TDX(I) DX(I,7,8) = shrdx(i,7,8) * TDX(I) DX(I+1,10,8) = TDX(I+1) 837 CONTINUE C C ADAPTING TRANSPORTATION REQUIREMENTS C DO 937 I = 1,7 do 9371 j=1,neighb DTR(WEG(j),8) = DTR(WEG(j),8) + 1 (DR(I,DIS(j),8)+SR(I,8,DIS(j)))*CBET(I) 9371 continue 937 CONTINUE C DO 939 I = 13,17,2 DTR(7,8) = DTR(7,8) + DX(I,3,8) * CBET(I+7) DTR(8,8) = DTR(8,8) + DX(I,7,8) * CBET(I+7) DTR(12,8) = DTR(12,8) + TDX(I+1) * CBET(I+8) 939 CONTINUE C C C ADJUSTING TRANSPORTATION LEVELS C YRDTRA = 0. XTR = 0.0 DO 971 I =1,12 DRDTR(I) = 0.0 C DO 972 J = 1,10 DRDTR(I) = DRDTR(I) + DTR(I,J) 972 CONTINUE if (( i .ne. 12) .and. (i.ne.6) ) then CATR(I) = DRDTR(I) ** (1 - CALFTR(I)) * 1 (CALFTR(I)*PT(I)/PX(10,8)) ** (-CALFTR(I)) ST(I) = DRDTR(I) XTR = XTR + (ST(I)/CATR(I))**(1/CALFTR(I)) YRDTRA = YRDTRA + (1-CALFTR(I)) * PT(I) * ST(I) endif C 971 CONTINUE C c c the following lines are to be used for simulation runs c c DO 971 I =1,12 c DRDTR(I) = 0.0 C c DO 972 J = 1,10 c DRDTR(I) = DRDTR(I) + DTR(I,J) c 972 CONTINUE c c xtrhlp = ( ( calftr(i)*pt(i)*catr(i)/px(10,8) ) ** c 1 ( 1./(1.-calftr(i)) ) ) * ektr(i) c xtr = xtr + xtrhlp c st(i)=catr(i)* (xtrhlp**calftr(i)) * (ektr(i)**(1-calftr(i))) c c yrdtra = yrdtra + pt(i) * drdtr(i) - px(10,8) * xtrhlp c c 971 CONTINUE c c C CVFLAG(8) = NOADJT C C DO 997 I=1,7 SX(I) = TDX(I) 997 CONTINUE C C RETURN END C file 22 SUBROUTINE REGIO(POW,CONS,DIS0) IMPLICIT REAL (A-Z) C C FOR REGIONS 1..7 C include 'genblk.for' c C c COMMON /GENBLK/GRQR(7,7),SLOC(5,7),DIMSE(3,7),DCHEM(7),FDR(4,7), c 1 DMANR(7),AREA(7),PT(12),PR(7,9),PX(18,10),YREM(8),YX17PR, c 2 Y811PR,YTRANS(8),NOFHH(8),DX(18,10,10),DR(7,10,10),CBET(25), c 3 SR(7,10,10),SAVE(8),RINV(18,7),CINV(18,7),SX(12),CODEM(22,8), c 4 THETA(8),S1(8),S2(7),MUINV(7),PWAURB,YRDTRA,PVTBUD,CLOSS(5), c 5 DBUD(8),RINVPR(7),DTR(12,10),ST(12),DCONSD(21,8),CVFLAG(8), c 6 RALLWD(7,10,10),reserv(100) C include 'gblk.for' C c COMMON /GBLK/GINV(18),HINV(18),GSNV(18),IINV(18),TINV(18), c 1 CONV(18),GOIRUR(7),GOIOTH(7),GOISOC,GOIIND,GOICON,GOITRA, c 2 GCSER(18),TAU(7),AVINTA(18),AVROTA(18),AVLOTA(18),PSI(3,7), c 3 PCH(7),GOIUR1(18),GOIUR2(18),GOVDEM(18),DTPTLO,DTPTFO,GLABCO, c 4 TRSUBS,TROPSS,TRILHH,FORAST,YGOVTO,GAMGOV(8),GOCON(18) C include 'blnblk.for' C c common xprcn,slaurb,iprsvc,iprtra,shrsr(7,10,10),shrdr(7,10,10), c 1 shrdx(18,10,10) C C C C INDEX I,J,K REFER TO DIMENSIONS IN LEFT TO RIGHT ORDER C C GRQR IS GROSS PRODUCTION OF GOOD I IN REGION J C SLOC IS LOCAL SEEDS OF GOOD I IN REGION J RETAINED FROM PRODUCTION C DIMSE IS DEMAND FOR IMPROVED SEEDS I IN REGION J C DCHEM IS DEMAND FOR CHEMICALS IN REGION I C FDR IS FOTHER USE OF GOOD I IN REGION J C DMANR IS INTERMEDIATE USE OF MANUFACTURING PRODUCTS IN REGION I C AREA IS TOTAL AREA IN REGION I C PT IS PRICE OF UNIT OF TRANSPORTATION OVER ROAD I C PX IS PRICE OF GOOD I IN REGION J C YREM IS REMITTANCES IN REGION I C YGOVTO IS TOTAL GOVERNMENT WAGES C YURBPR IS TOTAL PRIVATE URBAN INCOME C YTRANS IS TOTAL DOMESTIC GOVERNMENT TRANSFERS IN REGION I C NOFHH IS NUMBER OF HOUSEHOLDS IN REGION I C DX IS DEMAND FOR GOOD I IMPORTED FROM REGION J TO REGION K C DR IS SIMILAR, BUT FOR RAW GOODS C SR IS DUMPING OF EXCESS OF GOOD I BY REGION J IN REGION K C CBET IS CONVERSION FACTOR OF GOOD I TO WEIGHT UNITS C TAU IS RATE OF LANDTAX IN REGION I C PCH IS PRICE OF CHEMICALS IN REGION I C PSI IS PRICE OF IMPROVED SEEDS IN REGION I C GOIRUR IS AMOUNT OF AGRICULTURAL INVESTMENT BY GOVERNMENT IN REGION I C GOIOTH IS AMOUNT OF OTHER RURAL INVESTMENT BY GOVERNMENT IN REGION I C THETA IS FRACTION OF URBAN PRIVATE INCOME TRANSFERED TO REGION I C S1 IS SAVINGS RATE IN REGION I C S2 IS RURAL PRIVATE INVESTMENT AS A FRACTION OF GROSS AGRICULTURAL OUT C CINV IS FRACTION OF MONETIZED INVESTMENT OF REGION J GOING TO GOOD I C HINV IS FRACTION OF OTHER GOVERNMENT RURAL INVESTMENT GOING TO GOOD I C GINV IF FRACTION OF AGR. GOV. INVESTMENT GOING TO GOOD I C DBUD IS CONSUMER EXPENDITURE BUDGET IN REGION I C RINVPR IS TOTAL PRIVATE RURAL INVESTMENT IN REAL TERMS C DTR TRANSPORTATION DEMAND OVER ROAD I IN INITIATED BY REGION J C INTEGER DIS0,DIS(4),WEG(4),IDRH(7),IDRL(7), 1 I,NEIGHB,J,ITEL,K,N C C REAL RDEM(7),XDEM(18),RSUP(7),PRL(7), 1 TDX(18),PRH(7),TDR(7),DT(12),TRANS,POW,CONS, 2 TSR(7),PPX(18),PPR(7),QR(7),PNDX,APX(4) C LOGICAL EQUAL,GRTR,LESS,CNVGNC,RALLWD C C C COMPUTE LOCAL NUMBERING OF NEIGHBOURING REGIONS C CALL LOCNHB(DIS0,WEG,DIS,NEIGHB) do 777 i=1,7 do 777 j=1,8 c if (dr(i,j,dis0)*dr(i,dis0,j).gt.0.) 1 dr(i,dis0,j) = max(dr(i,dis0,j)-dr(i,j,dis0),0.) c if (sr(i,j,dis0)*sr(i,dis0,j).gt.0.) 1 sr(i,j,dis0) = max(sr(i,j,dis0)-sr(i,dis0,j),0.) c 777 continue c call pxloc call prich(dis0,prh,idrh) call pricl(dis0,prl,idrl) C WRITE(*,'(/,'' pr '',6f8.3,F10.1)') (pr(i,dis0),i=1,7) C WRITE(*,'('' PRL1 '',6F8.3,F10.1)') (PRL(I),I=1,7) C WRITE(*,'('' PRH1 '',6F8.3,F10.1)') (PRH(I),I=1,7) c c do 2999 i =1,7 if (prl(i) .gt. prh(i)) then c c c PRL(I) = (PRL(I) + PRH(I))/2 c PRH(I) = PRL(I) c ENDIF c atmp = 0. btmp = 0. do 2998 j=1,7 atmp = atmp + sr(i,dis0,j) btmp = btmp + dr(i,j,dis0) 2998 continue c if (atmp .gt. 0.) then c prl(i) = 0.99*prh(i) pr(i,dis0) = prl(i) prh(i) = prl(i) else if (btmp .gt. 0.) then c prh(i) = 1.01 * prl(i) pr(i,dis0) = prh(i) prl(i) = prh(i) else prh(i) = (prl(i)+prh(i))/2. prl(i) = prh(i) endif c endif pr(i,dis0) = min( max(pr(i,dis0),prl(i)) ,prh(i) ) 2999 continue c c C RESET REGION ORIGINATED EXTERNAL TRADE C C ITEL = 0 C DO 4 I=1,7 DO 41 J=1,NEIGHB DX(I,DIS(J),DIS0) = 0.0 DR(I,DIS(J),DIS0) = 0.0 SR(I,DIS0,DIS(J)) = 0.0 41 CONTINUE 4 CONTINUE C C DO 5 I=8,18 DO 51 J = 1,NEIGHB DX(I,DIS(J),DIS0) = 0.0 51 CONTINUE 5 CONTINUE C DO 501 I=1,NEIGHB DTR(WEG(I),DIS0) = 0.0 501 CONTINUE C C WRITE(*,*) ' PR(.,DIS0) ' C WRITE(*,*) (PR(I,DIS0),I=1,7) C C C C WRITE(*,'( A5,6F8.3,F10.1)') ' PRH2 ',(PRH(I),I=1,7) C WRITE(*,'( A5,6F8.3,F10.1)') ' PRL2 ',(PRL(I),I=1,7) C DO 701 I=1,7 IF (PR(I,DIS0) .LT. PRL(I)) PR(I,DIS0)=PRL(I) IF (PR(I,DIS0) .GT. PRH(I)) PR(I,DIS0)=PRH(I) PPR(I) = PR(I,DIS0) 701 CONTINUE C CC WRITE(*,*) ' PPR' CC WRITE(*,*) PPR DO 1313 I=1,18 PPX(I) = PX(I,DIS0) 1313 CONTINUE C C DO 702 I=1,4 QR(I) = GRQR(I,DIS0) - SLOC(I,DIS0) - FDR(I,DIS0) 702 CONTINUE C QR(5) = GRQR(5,DIS0) - SLOC(5,DIS0) QR(6) = GRQR(6,DIS0) QR(7) = GRQR(7,DIS0) C C COLLECT EXTERNAL SUPPLY AND DEMAND C C GOVERNMENT INVESTMENTS C DO 601 I=1,18 XDEM(I) = GINV(I)*GOIRUR(DIS0) + HINV(I)*GOIOTH(DIS0) 601 CONTINUE C C DEMAND FOR X-GOODS FROM OTHER REGIONS C DO 602 I = 1,18 DO 62 J = 1,NEIGHB XDEM(I) = XDEM(I) + DX(I,DIS0,DIS(J)) 62 CONTINUE 602 CONTINUE C C DEMAND AND SUPPLY OF R-GOODS FROM OTHER REGIONS C 1 DO 603 I = 1,7 RDEM(I) = 0.0 RSUP(I) = 0.0 DO 63 J = 1,NEIGHB RDEM(I) = RDEM(I) + DR(I,DIS0,DIS(J)) RSUP(I) = RSUP(I) + SR(I,DIS(J),DIS0) 63 CONTINUE C C TOTAL SUPPLY OF R-GOODS C TSR(I) = QR(I) + RSUP(I) C 603 CONTINUE C YCOST = PSI(1,DIS0)*DIMSE(1,DIS0) + PSI(2,DIS0)*DIMSE(2,DIS0)+ 1 PSI(3,DIS0)*DIMSE(3,DIS0) + PCH(DIS0)*DCHEM(DIS0) + 2 PPX(8)*DMANR(DIS0)+TAU(DIS0)*AREA(DIS0) C YGOV = GAMGOV(DIS0) * YGOVTO YURB = THETA(DIS0) * ( Y811PR + YX17PR + YRDTRA ) C C PRICE INDEX OF RURAL PRIVATE INVESTMENT GOODS, MONETIZED C PNDX = 0.0 DO 704 I = 1,18 PNDX = PNDX + CINV(I,DIS0)*PPX(I) 704 CONTINUE C C 2000 CONTINUE ITEL = ITEL + 1 C C COMPUTE AGRICULTURAL INCOME C YAGR = 0 DO 703 I=1,7 YAGR = YAGR + PPR(I) * QR(I) 703 CONTINUE YAGR = YAGR - YCOST C C COMPUTE VALUE AND VOLUME OF PRIVATE RURAL INVESTMENT C IRPVAL = 0.0 DO 713 I=1,7 IRPVAL = IRPVAL + PPR(I) * GRQR(I,DIS0) 713 CONTINUE C IRPVAL = S2(DIS0) * IRPVAL RINVPR(DIS0) = IRPVAL/PNDX C C MONETIZED PART OF PRIVATE RURAL INVESTMENT C IRPMON = MUINV(DIS0) * IRPVAL DO 705 I = 1,18 RINV(I,DIS0) = CINV(I,DIS0) * IRPMON / PNDX 705 CONTINUE C C YRUR = YAGR + YGOV + YURB + YREM(DIS0) + YTRANS(DIS0) C C DEBUG C WRITE(*,*) 'YAGR ', YAGR C SAVE(DIS0) = S1(DIS0) * YRUR DBUD(DIS0) = (YRUR - SAVE(DIS0))/NOFHH(DIS0) C C CONSUMER DEMAND IN VOLUME C CALL CONSUM(DIS0) C C C TOTAL DEMAND IN VOLUME C DO 2001 I=1,14 TDX(I)=XDEM(I) + DCONSD(I+7,DIS0) + RINV(I,DIS0) 2001 CONTINUE C TDX(8) = TDX(8) + DMANR(DIS0) C DO 706 I=15,18 TDX(I) = XDEM(I) + RINV(I,DIS0) 706 CONTINUE C DO 707 I=1,7 TDR(I) = RDEM(I) + DCONSD(I,DIS0) 707 CONTINUE C C ADJUST PRICES OF R-GOODS C CNVGNC = .TRUE. olprcn = xprcn c xprcn = 0.99 DO 101 I=1,7 IF (grtr(TDR(I),TSR(I))) THEN if (ppr(i).ge. prh(i)*(1.-1e-4)+1.e-5) then ppr(i) = prh(i) pr(i,dis0) = prh(i) if((dis0.eq.3).or.(dis0.ge.5)) then c if(dis0.gt.9) then c do 812 j=1,neighb dr(i,dis(j),dis0) = 1 shrdr(i,dis(j),dis0)*(tdr(i)-tsr(i)) 812 continue c else dr(i,dis(idrh(i)),dis0) = tdr(i)-tsr(i) endif else PPR(I)=PPR(I)+FRAC(POW,CONS,TDR(I)-TSR(I)) 1 *(PRH(I)-PPR(I)) cnvgnc = .false. endif c ELSE IF(less(TDR(I),TSR(I))) THEN if (ppr(i).le. prl(i)*(1.+1e-4)+1.e-5) then ppr(i) = prl(i) pr(i,dis0) = prL(i) if((dis0.eq.3).or.(dis0.ge.5)) then c if(dis0.gt.9) then c do 813 j=1,neighb sr(i,dis0,dis(j)) = 1 shrsr(i,dis0,dis(j))*(tsr(i)-tdr(i)) 813 continue c else sr(i,dis0,dis(idrl(i))) = tsr(i)-tdr(i) endif else PPR(I)=PPR(I)+FRAC(POW,CONS,TDR(I)-TSR(I)) 1 *(PRl(I)-PPR(I)) cnvgnc = .false. endif c endif pr(i,dis0) = ppr(i) c 101 continue c xprcn = olprcn C C WRITE(*,*) ' PPR' C WRITE(*,*) PPR C C WRITE(*,*) CNVGNC IF ((.NOT. CNVGNC) .AND. (ITEL .LE. 70)) GOTO 2000 C C C C ADAPTING TRANSPORTATION REQUIREMENTS C DO 709 I=1,7 do 814 j=1,neighb dTR(WEG(j),DIS0) = DTR(WEG(j),DIS0) + 1 DR(I,DIS(j),DIS0)*CBET(I) DTR(WEG(j),DIS0) = DTR(WEG(j),DIS0) + 1 SR(I,DIS0,DIS(j))*CBET(I) 814 continue c 709 CONTINUE C do 710 i=1,18 do 171 j=1,neighb dx(i,dis(j),dis0)=shrdx(i,dis(j),dis0)*tdx(i) dtr(weg(j),dis0)=dtr(weg(j),dis0)+ 1 dx(i,dis(j),dis0)*cbet(i+7) 171 continue 710 continue c C WRITE(*,*) ' PT(WEG())% ',(PT(WEG(K)),K=1,NEIGHB) C C C COMPUTATION OF REGIONAL BALANCE OF PAYMENTS C C C 1. VALUE OF ALL GOODS SOLD OUTSIDE THE REGION C C XX = 0.0 DO 711 I=1,7 DO 712 J= 1,NEIGHB XX = XX + PPR(I)*(DR(I,DIS0,DIS(J))+SR(I,DIS0,DIS(J))) 712 CONTINUE 711 CONTINUE C DO 913 I=1,18 DO 914 J=1,NEIGHB XX=XX+PPX(I)*DX(I,DIS0,DIS(J)) 914 CONTINUE 913 CONTINUE C C C 2. VALUE OF ALL GOODS IMPORTED INTO THE REGION C XM = 0.0 DO 915 I=1,7 DO 916 J=1,NEIGHB XM = XM + PPR(I)*(SR(I,DIS(J),DIS0)+DR(I,DIS(J),DIS0)) 916 CONTINUE 915 CONTINUE C DO 917 I=1,18 XM=XM+PPX(I)*TDX(I) 917 CONTINUE C WRITE(*,*) ' BALANCE OF PAYMENTS IN REGION ',DIS0,' IS ',XX-XM C FX= PSI(1,DIS0)*DIMSE(1,DIS0) + PSI(2,DIS0)*DIMSE(2,DIS0)+ 1 PSI(3,DIS0)*DIMSE(3,DIS0) + PCH(DIS0)*DCHEM(DIS0) + 2 TAU(DIS0)*AREA(DIS0)+SAVE(DIS0) 3 - YGOV - YREM(DIS0) - YTRANS(DIS0) - YURB 4 - IRPMON C C DO 918 I=1,18 FX = FX-PPX(I)*(GINV(I)*GOIRUR(DIS0) + HINV(I)*GOIOTH(DIS0)) 918 CONTINUE C WRITE(*,*) ' IT SHOULD BE EQUAL TO ', FX C WRITE(*,'(A9,7F9.3)')' PPR ',(PPR(I),I=1,7) C WRITE(*,'(A9,7F9.3)')' PRH ',(PRH(I),I=1,7) C WRITE(*,'(A9,7F9.3)')' PRL ',(PRL(I),I=1,7) CC WRITE(*,*) ' PRH% ',PRH CC WRITE(*,*) ' PRL% ',PRL C RETURN END C file 23 BLOCK DATA INICOEBD c c c version 28-Aug-1989 c IMPLICIT REAL (A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' C DATA CBET/1.,1.,1.,1.,1.,2.19,20.,1.,1.,1.,1.,1.,2.19,20., 1 .5,.5,0.2,0.,0.,.33,.33,.33,.33,.33,.33 / C DATA CINV/126*0.0/ C c c 0.2586 food c 0.2389 cash c 0.1539 man c 0.0432 mill c c 0.1500 trade c 0.0135 p.svc c c c 0.8581 c 0.1419 c 0.0516 india c 0.0902 row c c 1.0000 c c c DATA CODEM /.1048,.042,.056,.099,10*0.0,5*.95, 0.0, 0.0, 0.0 1 ,.1258,.021,.065,.090,10*0.0,5*.9, 0.0, 0.0, 0.0 2 ,.1258,.021,.065,.090,10*0.0,5*.9, 0.0, 0.0, 0.0 3 ,.1258,.021,.065,.090,10*0.0,5*.9, 0.0, 0.0, 0.0 4 ,.204,.0228,.026,.049,10*0.0,5*.9, 0.0, 0.0, 0.0 5 ,.204,.0228,.026,.049,10*0.0,5*.9, 0.0, 0.0, 0.0 6 ,.204,.0228,.026,.049,10*0.0,5*.9, 0.0, 0.0, 0.0 7 ,.175,.030,.0478,.049,10*0.0,5*.75, 0.0, 0.0, 0.0/ C c DATA CLOSS /.4, .1, .1, .1, 2./ c c no longer used? c c C C DATA UFOODR,UFOODX /49*0. , 77*0./ C DATA UXDEP /.007823,.007823,.007823,.007823,.011111,.0,.0/ C c DATA UX17OS/.270133,.270133,.270133,.270133,.348148,.0,.0/ data ux17os/5*0.15,2*0./ C C DATA CALFUR /0.3463,0.7273,0.6254,0.2140/ c DATA CAURB /108.67468,3.5694555,4.872394,231.79243/ data caurb /88.92, 3.52, 4.58, 226.9/ DATA DELTA /4*0.02/ C C DATA CATR /12*100000./ DATA CALFTR/12*0.33/ C END C C DK INIDAT C SUBROUTINE INICOESR c c c version 28-Aug-1989 c C IMPLICIT REAL (A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' C INTEGER I,J REAL DUM(20) C C DUM(5) = 0.0882 DUM(6) = 0.0 DUM(7) = 0.9118 c C dum(5) to dum(7) are applied to fraction of cash consumption c i.e. .2389 C DUM(8) = 0.15393 DUM(9) = 0.0 DUM(10) = 0.15 DUM(11) = 0.0135 DUM(12) = 0.0 DUM(13) = 0.0516 DUM(14) = 0.0902 C c dum(8) to dum(14) are straight from the i-o table 87 C CINV(8,1) = 1.0 MUINV(1) = 0.1 S1(1) = 0.05 * .1530/.1175 c S2(1) = 0.0852 S2(1) = 0.3 THETA(1) = 0.0274 GAMGOV(1) = 0.056 C DO 100 J=5,7 CODEM(J,1) = DUM(J)*0.2389 100 CONTINUE C DO 101 J=8,14 CODEM(J,1) = DUM(J) 101 CONTINUE C theta(2) = .0763 theta(3) = .034 theta(4) = .0251 c c DO 1 I=2,4 CINV(8,I) = 1.0 MUINV(I) = 0.1 S1(I) = 0.09 * .1530/.1175 c S2(I) = 0.0852 S2(I) = 0.3 GAMGOV(I) = 0.075 C DO 102 J=5,7 CODEM(J,I) = DUM(J)*0.2389 102 CONTINUE C DO 103 J=8,14 CODEM(J,I) = DUM(J) 103 CONTINUE C 1 CONTINUE C theta(5) = .033 theta(6) = .0463 theta(7) = .0386 c c DO 2 I=5,7 CINV(8,I)=0.8 CINV(15,I)=0.2 MUINV(I) = 0.36 S1(I) = 0.14 * .1530/.1175 c S2(I) = 0.067 S2(I) = 0.18 GAMGOV(I) = 0.094 C DO 105 J=5,7 CODEM(J,I) = DUM(J)*0.2389 105 CONTINUE C DO 106 J=8,14 CODEM(J,I) = DUM(J) 106 CONTINUE C 2 CONTINUE C S1(8) = 0.18 THETA(8) = 1. do 8888 j=1,7 8888 theta(8) = theta(8) - theta(j) c c GAMGOV(8)= 0.437 C DO 108 J=5,7 CODEM(J,8) = DUM(J)*0.2389 108 CONTINUE C DO 109 J=8,14 CODEM(J,8) = DUM(J) 109 CONTINUE C UFOODR(1,1) = 1.538461 UFOODR(2,2) = 1.1 UFOODR(3,3) = 1.3 UFOODR(4,4) = 1.1 UFOODR(5,5) = 3.33333 UFOODR(6,6) = 1. UFOODR(7,7) = 1. C C C RETURN END C C BLOCK DATA EXODATBD C DEBUG IMPLICIT REAL(A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' C DATA DR/700*.0/ DATA DX/1800*.0/ DATA DTR/120*.0/ DATA DCONSD/168*0./ DATA PWAURB/0.02/ DATA PX/180*1./ DATA SR/700*.0/ DATA SX/12*0./ DATA PVTBUD/0./ DATA ST/12*1.E+7/ DATA TAU/7*.0/ C DATA XTR/0./ c c Indian Prices elsewhere initialized C c DATA PT/1., 0.8, 0.375, 0.7, 0.7, 0.5, 0.2, 0.5, 0.1, c 1 0.1, 0.1 ,0.0/ DATA PT/.43,0.34, 0.16, 0.30, 0.30, 0.22, 0.086, 0.22, 0.043, 1 0.043, 0.043 ,0.0/ c c PT: non endogenous in baseyear. These are preliminary values. c c AREA: Old 85/86 data used, scaled to Country total 86/87 c DATA AREA/167607,598563,287952,239184,598035,574598,481061/ C DATA PCH/7*3.990/ c c PCH: price of urea and complex used in 50/50 proportion C DATA PSI/3.69,3.92,4.54,6.15,6.01,6.86,5.80,6.07,5.44, 1 4.71,5.52,8.14,4.61,4.51,5.14,4.34,4.54,4.08, 2 3.53,4.13,6.11/ c c PSI: No data available, used scenario 1 values instead. c C DATA DCHEM/3.067, 1.558, 12.939, 5.753, 12.891, 50.089, 17.602/ c c DCHEM based on 2.3 times nutrient tons in 86/87 (SPBN 1988,p60). c This distributed according to 1984/85 fractions. c Similar procedure for DIMSE (SPBN 88,61) C DATA DIMSE/3.2705e-3, 136.4306e-3, 3.021103e-3, 1 6.1345e-3, 105.8726e-3, 11.09162e-3, 2 15.100e-3, 65.21832e-3, 11.77601e-3, 3 13.739e-3, 427.0336e-3, 19.58784e-3, 4 43.625e-3, 874.8556e-3, 2.113762e-3, 5 17.180e-3, 372.0083e-3, 16.09831e-3, 6 41.948e-3, 216.5806e-3, 8.311337e-3/ c C DATA YGOVTO,YRDTRA,YX17PR,Y811PR/1262.,100.,50.,71./ c c These are arbitrary initial values c c GRQR; For Livestock Data from SPBN 1988 were taken, p.39. c Weigths for conversion to LSU from IDS worksheets,1987. C Belt totals were split according to region totals for Hill, c according to 81/82 values for Terai. c Values for other crops were 1985/86 values scaled to Country c totals in 1986/87 c DATA grqr/ 1 67.7500,57.4998,116.791,168.7158,12.2668,256.19,0.0642, 2 370.642,224.202,464.992,213.238,32.85,69.49, 0.164589, 3 246.115,125.25,246.099,92.915,26.72,104.66, 0.075679, 4 168.490,44.863,254.886,146.669,39.30,201.9606, 0.065702, 5 918.284,286.922,139.0449,29.245,219.73,985.36, 0.071627, 6 1023.56,275.363,144.089,59.186,131.07,2262.8,0.056517, 7 839.759,96.031,43.271,45.064,20.538,2675.2, 0.052162/ c C DATA EKURB /4*1./ DATA EKTR /12*1./ C DATA PUPRIN /4*1./ DATA SWAGE / .80187,5.2766,1.20639,.21948,.83026/ C C END C C C C SUBROUTINE EXODATSR C IMPLICIT REAL (A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' C INTEGER I,J REAL VFDR(7),TPV(7) C DTR(12,10) = CBET(1)*DR(1,8,10)+CBET(5)*DR(5,8,10)+ 1 CBET(6)*DR(6,8,10)+CBET(8)*DX(1,8,10)+CBET(15)*DX(8,8,10)+ 2 CBET(17)*DX(10,8,10)+CBET(18)*DX(11,8,10) C DTR(10,9) = CBET(8)*DX(1,6,9)+CBET(10)*DX(3,6,9)+ 1 CBET(11)*DX(4,6,9)+CBET(15)*DX(8,6,9)+CBET(18)*DX(11,6,9) XTR = 0.0 C DO 100 I=1,7 c SLOC(1,I) = 0.15 * GRQR(1,I) c SLOC(2,I) = 0.18 * GRQR(2,I) c SLOC(3,I) = 0.1 * GRQR(3,I) c SLOC(4,I) = 0.1 * GRQR(4,I) c SLOC(5,I) = 0.1 * GRQR(5,I) c 04-Sep-1989 c SLOC(1,I) = 0.05 * GRQR(1,I) SLOC(2,I) = 0.05 * GRQR(2,I) SLOC(3,I) = 0.05 * GRQR(3,I) SLOC(4,I) = 0.05 * GRQR(4,I) SLOC(5,I) = 0.05 * GRQR(5,I) 100 CONTINUE C C RETURN END C SUBROUTINE MODMOJC C IMPLICIT REAL (A-Z) C C INCLUDE'INC.INC' include 'urbblk.for' c COMMON /URBBLK/ CALFUR(4),DLAURB(4),CAURB(4),EKURB(4),SWAGE(5), c 1 IOCO(18,4),UFOODX(11,7),UFOODR(7,7),UXLAB(7),UX17OS(7), c 2 UXDEP(7),DELTA(4),UVDEPR(4),PUPRIN(4),CUPRIN(18,4),UPRINV(4) C C include 'genblk.for' c COMMON /GENBLK/GRQR(7,7),SLOC(5,7),DIMSE(3,7),DCHEM(7),FDR(4,7), c 1 DMANR(7),AREA(7),PT(12),PR(7,9),PX(18,10),YREM(8),YX17PR, c 2 Y811PR,YTRANS(8),NOFHH(8),DX(18,10,10),DR(7,10,10),CBET(25), c 3 SR(7,10,10),SAVE(8),RINV(18,7),CINV(18,7),SX(12),CODEM(22,8), c 4 THETA(8),S1(8),S2(7),MUINV(7),PWAURB,YRDTRA,PVTBUD,CLOSS(5), c 5 DBUD(8),RINVPR(7),DTR(12,10),ST(12),DCONSD(21,8),CVFLAG(8), c 6 rallwd(7,10,10),reserv(100) C C include 'gblk.for' c COMMON /GBLK/GINV(18),HINV(18),GSNV(18),IINV(18),TINV(18), c 1 CONV(18),GOIRUR(7),GOIOTH(7),GOISOC,GOIIND,GOICON,GOITRA, c 2 GCSER(18),TAU(7),AVINTA(18),AVROTA(18),AVLOTA(18),PSI(3,7), c 3 PCH(7),GOIUR1(18),GOIUR2(18),GOVDEM(18),DTPTLO,DTPTFO,GLABCO, c 4 TRSUBS,TROPSS,TRILHH,FORAST,YGOVTO,GAMGOV(8),GOCON(18) C C include 'trblk.for' c COMMON /TRBLK/ CATR(12),CALFTR(12),EKTR(12),DRDTR(12),XTR include 'glblk.for' c COMMON /GLBLK/ GVIRUR,GVISOC,GVIIND,GVITRA,GVICON,GVITOT, c 1 GVCOMM,AGINPT,AVTAX,GOSER,GVBUD,GVSER,IMDUIN,IMDURO, c 2 SAVSPL,PGSVC,LTAX,GOVEMP C C INTEGER I,J REAL VFDR(7),TPV(7),PGNV(7),PHNV(7),GOIROL(7),GOIOOL(7), 1 vioco(18,4),vfoodx(11,7),vxlab(7),vgcser(18),vcprin(18,4), 2 vgsnv(18),viinv(18),vtinv(18),vhinv(18),vconv(18),vglabc, 3 vginv(18),qx(18) C c ----------------------------- C c data vioco/ c 1 7*0.,0.090353932,0.032099423,0.050407983,0.015217504,3*0., c 2 0.051239098,0.076955690,2*0., c 3 6*0.,0.010920369,0.035135101,0.013579242,0.024119772, c 4 0.000474799,3*0.,0.062109967,0.192512795,2*0., c 5 7*0.,0.005902807,0.025147577,0.231422397,0.152987832,3*0., c 6 0.056103865,0.039967798,2*0., c 7 7*0.,0.004660954,0.003015911,0.008499386,0.011515297,3*0., c 8 0.013815174,0.023783084,2*0./ c c coefficients for trade reduced 04-Sep-1989 (except for priv.serv.) c data vioco/ 1 7*0.,0.090353932,0.032099423,0.00,0.015217504,3*0., 2 0.051239098,0.076955690,2*0., 3 6*0.,0.010920369,0.035135101,0.00,0.024119772, 4 0.000474799,3*0.,0.062109967,0.192512795,2*0., 5 7*0.,0.005902807,0.025147577,0.15,0.152987832,3*0., 6 0.056103865,0.039967798,2*0., 7 7*0.,0.004660954,0.003015911,0.008499386,0.011515297,3*0., 8 0.013815174,0.023783084,2*0./ c data vfoodx /77*0./ c c data vginv /7*0.,0.014379572,0.700118419,0.010315780,0.010315780, c 1 5*0.,0.097945011,0.166925440/ data vginv /7*0.,0.014379572,0.700118419,0.0,0.010315780, 2 5*0.,0.097945011,0.166925440/ c data vhinv /7*0.,.0096,.6762,.0115,.0096,5*0., 3 .1437,.1494/ c c c data vcprin / c 1 7*0.,0.099976140,0.411891159,0.019758130,0.021997385,5*0., c 2 0.174292362,0.272084823, c 3 7*0.,0.075016835,0.570333468,0.010276279,0.016544809,5*0., c 4 0.036747288,0.291081322, c 5 7*0.,0.106101175,0.307233179,0.014677536,0.023384550,5*0., c 6 0.125421141,0.423182420, c 7 7*0.,0.066773678,0.890986127,0.009251775,0.014682164,5*0., c 8 0.006973810,0.011332446/ data vcprin / 1 7*0.,0.099976140,0.411891159,0.0,0.021997385,5*0., 2 0.174292362,0.272084823, 3 7*0.,0.075016835,0.570333468,0.0,0.016544809,5*0., 4 0.036747288,0.291081322, 5 7*0.,0.106101175,0.307233179,0.0,0.023384550,5*0., 6 0.125421141,0.423182420, 7 7*0.,0.066773678,0.890986127,0.0,0.014682164,5*0., 8 0.006973810,0.011332446/ c c data viinv / 7*0.,0.008955829,0.635936158,0.047769029,0.047769029, c 1 5*0.,0.097237744,0.162332212/ data viinv / 7*0.,0.008955829,0.635936158,0.0,0.047769029, 2 5*0.,0.097237744,0.162332212/ data vconv / 7*0.,0.000000000,0.645525114,0.000000000,0.107587519, 3 5*0.,0.135751921,0.111135446/ c data vtinv / 7*0.,0.010031444,0.708291435,0.012038159,0.010031444, c 4 5*0.,0.096050593,0.163556924/ data vtinv / 7*0.,0.010031444,0.708291435,0.0,0.010031444, 5 5*0.,0.096050593,0.163556924/ data vgsnv / 7*0.,0.021111243,0.833927045,0.000000000,0.000000000, 6 5*0.,0.078240458,0.066721254/ c c do 71 i=1,11 px(i,3) = px(i,8) + cbet(i+7) * pt(7) px(i,7) = px(i,8) + cbet(i+7) * pt(8) px(i,10) = px(i,8) + cbet(i+7) * pt(12) px(i,4) = px(i,7) + cbet(i+7) * pt(4) px(i,1) = px(i,3) + cbet(i+7) * pt(1) px(i,6) = px(i,3) + cbet(i+7) * pt(3) px(i,5) = px(i,6) + cbet(i+7) * pt(5) px(i,2) = px(i,5) + cbet(i+7) * pt(2) px(i,9) = px(i,6) + cbet(i+7) * pt(10) 71 continue c c vioco(1,1) = (35./113.)*529./(11098.-793.) vioco(2,1) = (63./113.)*529./(11098.-793.) vioco(3,1) = (15./113.)*529./(11098.-793.) vioco(4,1) = 0. vioco(5,1) = 0. vioco(6,1) = (53.3/718.5)*3082./(11098.-793.) vioco(7,1) = (665.2/718.5)*3082./(11098.-793.) c c xxx = ((2834.-23.)/(2834.-23.+752.-8.)) * (3866.-57.) do 1 j=1,4 vfoodx(1,j) = (14./18.)*21. / xxx vfoodx(2,j) = (5./6.)*7. / xxx vfoodx(3,j) = (7./9.)*10. / xxx vfoodx(8,j) = (19./25.)*42. / xxx vfoodx(9,j) = (19./25.)*15. / xxx vxlab(j) = (38./50.)*51. / xxx 1 continue c xxx = ( (752. - 8.)/(2834.-23.+752.-8.) ) * (3866.-57.) vxlab(5) = (12./50.)*51. / xxx vfoodx(1,5) = (4./18.)*21. / xxx vfoodx(2,5) = (1./6.)*7. / xxx vfoodx(3,5) = (2./9.)*10. / xxx vfoodx(8,5) = (6./25.)*42. / xxx vfoodx(9,5) = (6./25.)*15. / xxx c c vgcser(1) = (245./249.)*202. / (4915.-27.) vgcser(2) = 0. vgcser(3) = 0. vgcser(4) = 0. vgcser(5) = (4./249.)*202. / (4915.-27.) vgcser(6) = 0. vgcser(7) = 0. vgcser(8) = 220. / (4915.-27.) vgcser(9) = 37. / (4915.-27.) c vgcser(10) = 137. / (4915.-27.) vgcser(10) = 0. vgcser(11) = 75. / (4915.-27.) vgcser(12) = 0. vgcser(13) = 0. vgcser(14) = 0. vgcser(15) = 100. / (4915.-27.) vgcser(16) = 205. / (4915.-27.) vgcser(17) = 0. vgcser(18) = 0. c c vglabc = 3911. / (4915.-27.) c do 9 i=1,12 9 qx(i) = px(i,8) c qx(13) = px(13,9) qx(15) = px(15,9) qx(17) = px(17,9) qx(14) = px(14,10) qx(16) = px(16,10) qx(18) = px(18,10) c do 2 j=1,4 p = px(j+7,8)*(1.-avlota(j+7))/ 1 (1.+avinta(15)*vioco(15,j)+avrota(16)*vioco(16,j)) do 21 i = 1,7 ioco(i,j) = p * vioco(i,j)/pr(i,8) 21 continue c do 22 i = 8,18 22 ioco(i,j) = p * vioco(i,j) / qx(i) c c 2 continue c c do 3 j=1,5 p = px(j,8)*(1-avlota(j))/ 1 (1.+avinta(15)*vfoodx(8,j)+avrota(16)*vfoodx(9,j)) do 31 i = 1,11 31 ufoodx(i,j) = vfoodx(i,j) * p / qx(i+7) c uxlab(j) = vxlab(j) * p/(pwaurb*swage(1)) c 3 continue c do 4 i=1,18 gcser(i) = vgcser(i) / 1 ( (1+avinta(15)*vgcser(15)+avrota(16)*vgcser(16))*qx(i) ) ginv(i) = vginv(i) / 2 ( (1+avinta(17)*vginv(17)+avrota(18)*vginv(18)) * qx(i) ) gsnv(i) = vgsnv(i) / 3 ( (1+avinta(17)*vgsnv(17)+avrota(18)*vgsnv(18)) * qx(i) ) iinv(i) = viinv(i) / 4 ( (1+avinta(17)*viinv(17)+avrota(18)*viinv(18)) * qx(i) ) tinv(i) = vtinv(i) / 5 ( (1+avinta(17)*vtinv(17)+avrota(18)*vtinv(18)) * qx(i) ) conv(i) = vconv(i) / 6 ( (1+avinta(17)*vconv(17)+avrota(18)*vconv(18)) * qx(i) ) hinv(i) = vhinv(i) / 7 ( (1+avinta(17)*vhinv(17)+avrota(18)*vhinv(18)) * qx(i) ) c 4 continue c c do 5 j = 1,4 p = ( 1 + avinta(17)*vcprin(17,j)+avrota(18)*vcprin(18,j) ) do 51 i = 1,18 51 cuprin(i,j) = p * vcprin(i,j) / qx(i) 5 continue c c glabco = vglabc / 1 ( (1 + avinta(15)*vgcser(15)+avrota(16)*vgcser(16))* 2 pwaurb*swage(5) ) c c c ------------------------------------------- c c DO 1717 I = 1,7 GOIOOL(I) = 0. 1717 CONTINUE C C GOIROL(1) = (2.81/490)*2759 GOIROL(2) = (40.72/490)*2759 GOIROL(3) = (68.80/490)*2759 GOIROL(4) = (4.21/490)*2759 GOIROL(5) = (162.86/490)*2759 GOIROL(6) = (103.90/490)*2759 GOIROL(7) = (106.70/490)*2759 C DR(1,8,10) = 0./PR(1,8) DR(2,8,10) = 0./PR(2,8) DR(3,8,10) = 0./PR(3,8) DR(4,8,10) = 0./PR(4,8) DR(5,8,10) = (2.41/189.63)*353/51.522 DR(6,8,10) = (187.22/189.63)*353/2.8518 DR(7,8,10) = 0./PR(7,8) C DX(1,6,9) = (17.84671/378.36731)*314/7.465 DX(2,6,9) = 0./PX(1,6) DX(3,6,9) = (248.4906/378.36731)*314/6.199 DX(4,6,9) = (18.03/378.36731)*314/4.162 DX(5,6,9) = (94./378.36731)*314/51.792 DX(6,6,9) = 0./PX(6,6) DX(7,6,9) = 0./PX(7,6) C DX(1,8,10) = (106.93/107.93)*1315/7.194 DX(5,8,10) = (1./107.93)*1315/51.522 C DX( 8,6,9) = 4533./3.905 DX(11,6,9) = 1823./2.233 DX(10,6,9) = 1213./1.762 DX( 8,8,10) = 289/3.777 DX(10,8,10) = 1749./1.709 DX(11,8,10) = 2629./2.240 C DTR(12,10) = CBET(1)*DR(1,8,10)+CBET(5)*DR(5,8,10)+ 1 CBET(6)*DR(6,8,10)+CBET(8)*DX(1,8,10)+CBET(15)*DX(8,8,10)+ 2 CBET(17)*DX(10,8,10)+CBET(18)*DX(11,8,10) C DTR(10,9) = CBET(8)*DX(1,6,9)+CBET(10)*DX(3,6,9)+ 1 CBET(11)*DX(4,6,9)+CBET(15)*DX(8,6,9)+CBET(18)*DX(11,6,9) XTR = 0.0 C DMANR(1) = (36/43.12)*5.256394 /4.054 DMANR(2) = (36/43.12)*11.62070 /4.257 DMANR(3) = (36/43.12)*7.492198 /3.817 DMANR(4) = (36/43.12)*18.75339 /4.056 DMANR(5) = (81/27.87)*9.023821 /4.070 DMANR(6) = (81/27.87)*15.66232 /3.905 DMANR(7) = (81/27.87)*3.191157 /3.891 C C UPRINV(1) = 2381. / PUPRIN(1) UPRINV(2) = 1105./ PUPRIN(2) UPRINV(3) = 1675./ PUPRIN(3) UPRINV(4) = 6680. / PUPRIN(4) C poisoc = 0. poitra = 0. poicon = 0. poiind = 0. c do 135 i=1,7 poisoc = poisoc + pr(i,8) * gsnv(i) poitra = poitra + pr(i,8) * tinv(i) poicon = poicon + pr(i,8) * conv(i) poiind = poiind + pr(i,8) * iinv(i) 135 continue c do 136 i=8,18 poisoc = poisoc + px(i,8) * gsnv(i) poitra = poitra + px(i,8) * tinv(i) poicon = poicon + px(i,8) * conv(i) poiind = poiind + px(i,8) * iinv(i) 136 continue GOISOC = 1024. / poiSOC GOITRA = 1907./ poiTRA GOICON = 72. / poiCON GOIIND = 1768./ poIIND C DO 201 I = 1,7 PGNV(I) = 0. PHNV(I) = 0. DO 202 J = 1,18 PGNV(I) = PGNV(I) + GINV(J)*PX(J,I) 202 CONTINUE GOIRUR(I) = GOIROL(I) / PGNV(I) 201 CONTINUE C c c Food to Cash deliveries distributed over regions according to LSU number c See i-o table 86/87. c Distribution within Food sectors according to gross production value. c tlsu = 0. do 91 i=1,7 tlsu = tlsu + grqr(7,i) 91 continue c do 200 i=1,7 vfdr(i) = ( grqr(7,i) / tlsu ) * 667. tpv(i) = pr(1,i) * grqr(1,i) + pr(2,i) * grqr(2,i) + 1 pr(3,i) * grqr(3,i) + pr(4,i) * grqr(4,i) do 2011 j=1,4 fdr(j,i) = grqr(j,i) * vfdr(i) / tpv(i) 2011 continue 200 continue c c RETURN END C file 24 BLOCK DATA INICOEBD c c c version 28-Aug-1989 c IMPLICIT REAL (A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' C DATA CBET/1.,1.,1.,1.,1.,2.19,20.,1.,1.,1.,1.,1.,2.19,20., 1 .5,.5,0.2,0.,0.,.33,.33,.33,.33,.33,.33 / C DATA CINV/126*0.0/ C c c 0.2586 food c 0.2389 cash c 0.1539 man c 0.0432 mill c c 0.1500 trade c 0.0135 p.svc c c c 0.8581 c 0.1419 c 0.0516 india c 0.0902 row c c 1.0000 c c c DATA CODEM /.1048,.042,.056,.099,10*0.0,5*.95, 0.0, 0.0, 0.0 1 ,.1258,.021,.065,.090,10*0.0,5*.9, 0.0, 0.0, 0.0 2 ,.1258,.021,.065,.090,10*0.0,5*.9, 0.0, 0.0, 0.0 3 ,.1258,.021,.065,.090,10*0.0,5*.9, 0.0, 0.0, 0.0 4 ,.204,.0228,.026,.049,10*0.0,5*.9, 0.0, 0.0, 0.0 5 ,.204,.0228,.026,.049,10*0.0,5*.9, 0.0, 0.0, 0.0 6 ,.204,.0228,.026,.049,10*0.0,5*.9, 0.0, 0.0, 0.0 7 ,.175,.030,.0478,.049,10*0.0,5*.75, 0.0, 0.0, 0.0/ C c DATA CLOSS /.4, .1, .1, .1, 2./ c c no longer used? c c C C DATA UFOODR,UFOODX /49*0. , 77*0./ C DATA UXDEP /.007823,.007823,.007823,.007823,.011111,.0,.0/ C c DATA UX17OS/.270133,.270133,.270133,.270133,.348148,.0,.0/ data ux17os/5*0.15,2*0./ C C DATA CALFUR /0.3463,0.7273,0.6254,0.2140/ c DATA CAURB /108.67468,3.5694555,4.872394,231.79243/ data caurb /88.92, 3.52, 4.58, 226.9/ DATA DELTA /4*0.02/ C C DATA CATR /12*100000./ DATA CALFTR/12*0.33/ C END C C DK INIDAT C SUBROUTINE INICOESR c c c version 28-Aug-1989 c C IMPLICIT REAL (A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' C INTEGER I,J REAL DUM(20) C C DUM(5) = 0.0882 DUM(6) = 0.0 DUM(7) = 0.9118 c C dum(5) to dum(7) are applied to fraction of cash consumption c i.e. .2389 C DUM(8) = 0.15393 DUM(9) = 0.0 DUM(10) = 0.15 DUM(11) = 0.0135 DUM(12) = 0.0 DUM(13) = 0.0516 DUM(14) = 0.0902 C c dum(8) to dum(14) are straight from the i-o table 87 C CINV(8,1) = 1.0 MUINV(1) = 0.1 S1(1) = 0.05 * .1530/.1175 c S2(1) = 0.0852 S2(1) = 0.3 THETA(1) = 0.0274 GAMGOV(1) = 0.056 C DO 100 J=5,7 CODEM(J,1) = DUM(J)*0.2389 100 CONTINUE C DO 101 J=8,14 CODEM(J,1) = DUM(J) 101 CONTINUE C theta(2) = .0763 theta(3) = .034 theta(4) = .0251 c c DO 1 I=2,4 CINV(8,I) = 1.0 MUINV(I) = 0.1 S1(I) = 0.09 * .1530/.1175 c S2(I) = 0.0852 S2(I) = 0.3 GAMGOV(I) = 0.075 C DO 102 J=5,7 CODEM(J,I) = DUM(J)*0.2389 102 CONTINUE C DO 103 J=8,14 CODEM(J,I) = DUM(J) 103 CONTINUE C 1 CONTINUE C theta(5) = .033 theta(6) = .0463 theta(7) = .0386 c c DO 2 I=5,7 CINV(8,I)=0.8 CINV(15,I)=0.2 MUINV(I) = 0.36 S1(I) = 0.14 * .1530/.1175 c S2(I) = 0.067 S2(I) = 0.18 GAMGOV(I) = 0.094 C DO 105 J=5,7 CODEM(J,I) = DUM(J)*0.2389 105 CONTINUE C DO 106 J=8,14 CODEM(J,I) = DUM(J) 106 CONTINUE C 2 CONTINUE C S1(8) = 0.18 THETA(8) = 1. do 8888 j=1,7 8888 theta(8) = theta(8) - theta(j) c c GAMGOV(8)= 0.437 C DO 108 J=5,7 CODEM(J,8) = DUM(J)*0.2389 108 CONTINUE C DO 109 J=8,14 CODEM(J,8) = DUM(J) 109 CONTINUE C UFOODR(1,1) = 1.538461 UFOODR(2,2) = 1.1 UFOODR(3,3) = 1.3 UFOODR(4,4) = 1.1 UFOODR(5,5) = 3.33333 UFOODR(6,6) = 1. UFOODR(7,7) = 1. C C C RETURN END C C BLOCK DATA EXODATBD C DEBUG IMPLICIT REAL(A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' C DATA DR/700*.0/ DATA DX/1800*.0/ DATA DTR/120*.0/ DATA DCONSD/168*0./ DATA PWAURB/0.0242/ DATA PX/180*1./ DATA SR/700*.0/ DATA SX/12*0./ DATA PVTBUD/0./ DATA ST/12*1.E+7/ DATA TAU/7*.0/ C DATA XTR/0./ c c Indian Prices elsewhere initialized C c DATA PT/1., 0.8, 0.375, 0.7, 0.7, 0.5, 0.2, 0.5, 0.1, c 1 0.1, 0.1 ,0.0/ DATA PT/.43,0.34, 0.16, 0.30, 0.30, 0.22, 0.086, 0.22, 0.043, 1 0.043, 0.043 ,0.0/ c c PT: non endogenous in baseyear. These are preliminary values. c c AREA: Old 85/86 data used, scaled to Country total 86/87 c DATA AREA/167607,598563,287952,239184,598035,574598,481061/ C DATA PCH/7*3.990/ c c PCH: price of urea and complex used in 50/50 proportion C DATA PSI/3.69,3.92,4.54,6.15,6.01,6.86,5.80,6.07,5.44, 1 4.71,5.52,8.14,4.61,4.51,5.14,4.34,4.54,4.08, 2 3.53,4.13,6.11/ c c PSI: No data available, used scenario 1 values instead. c C DATA DCHEM/3.067, 1.558, 12.939, 5.753, 12.891, 50.089, 17.602/ c c DCHEM based on 2.3 times nutrient tons in 86/87 (SPBN 1988,p60). c This distributed according to 1984/85 fractions. c Similar procedure for DIMSE (SPBN 88,61) C DATA DIMSE/3.2705e-3, 136.4306e-3, 3.021103e-3, 1 6.1345e-3, 105.8726e-3, 11.09162e-3, 2 15.100e-3, 65.21832e-3, 11.77601e-3, 3 13.739e-3, 427.0336e-3, 19.58784e-3, 4 43.625e-3, 874.8556e-3, 2.113762e-3, 5 17.180e-3, 372.0083e-3, 16.09831e-3, 6 41.948e-3, 216.5806e-3, 8.311337e-3/ c C DATA YGOVTO,YRDTRA,YX17PR,Y811PR/1262.,100.,50.,71./ c c These are arbitrary initial values c c GRQR; For Livestock Data from SPBN 1988 were taken, p.39. c Weigths for conversion to LSU from IDS worksheets,1987. C Belt totals were split according to region totals for Hill, c according to 81/82 values for Terai. c Values for other crops were 1985/86 values scaled to Country c totals in 1986/87 c DATA grqr/ 1 70.4603,59.8008,121.463,175.4652,12.7575,266.44,0.0668, 2 385.469,233.171,483.594,221.768,34.17,72.27, 0.171174, 3 255.960,130.2638,255.943,96.632,27.79,108.8606, 0.078707, 4 175.231,46.657,265.187,152.536,40.873,210.0398, 0.068331, 5 955.019,298.400,144.6073,30.456,228.518,1024.78,0.0744920, 6 1064.51,286.379,149.854,61.554,136.31,2353.3,0.058778, 7 873.354,99.873,45.002,46.866,21.359,2782.2, 0.054249/ c C DATA EKURB /4*1.84/ DATA EKTR /12*1./ C DATA PUPRIN /4*1./ DATA SWAGE / .80187,5.2766,1.20639,.21948,.83026/ C C END C C C C SUBROUTINE EXODATSR C IMPLICIT REAL (A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' C INTEGER I,J REAL VFDR(7),TPV(7) C DTR(12,10) = CBET(1)*DR(1,8,10)+CBET(5)*DR(5,8,10)+ 1 CBET(6)*DR(6,8,10)+CBET(8)*DX(1,8,10)+CBET(15)*DX(8,8,10)+ 2 CBET(17)*DX(10,8,10)+CBET(18)*DX(11,8,10) C DTR(10,9) = CBET(8)*DX(1,6,9)+CBET(10)*DX(3,6,9)+ 1 CBET(11)*DX(4,6,9)+CBET(15)*DX(8,6,9)+CBET(18)*DX(11,6,9) XTR = 0.0 C DO 100 I=1,7 c SLOC(1,I) = 0.15 * GRQR(1,I) c SLOC(2,I) = 0.18 * GRQR(2,I) c SLOC(3,I) = 0.1 * GRQR(3,I) c SLOC(4,I) = 0.1 * GRQR(4,I) c SLOC(5,I) = 0.1 * GRQR(5,I) c 04-Sep-1989 c SLOC(1,I) = 0.05 * GRQR(1,I) SLOC(2,I) = 0.05 * GRQR(2,I) SLOC(3,I) = 0.05 * GRQR(3,I) SLOC(4,I) = 0.05 * GRQR(4,I) SLOC(5,I) = 0.05 * GRQR(5,I) 100 CONTINUE C C RETURN END C SUBROUTINE MODMOJC C IMPLICIT REAL (A-Z) C C INCLUDE'INC.INC' include 'urbblk.for' c COMMON /URBBLK/ CALFUR(4),DLAURB(4),CAURB(4),EKURB(4),SWAGE(5), c 1 IOCO(18,4),UFOODX(11,7),UFOODR(7,7),UXLAB(7),UX17OS(7), c 2 UXDEP(7),DELTA(4),UVDEPR(4),PUPRIN(4),CUPRIN(18,4),UPRINV(4) C C include 'genblk.for' c COMMON /GENBLK/GRQR(7,7),SLOC(5,7),DIMSE(3,7),DCHEM(7),FDR(4,7), c 1 DMANR(7),AREA(7),PT(12),PR(7,9),PX(18,10),YREM(8),YX17PR, c 2 Y811PR,YTRANS(8),NOFHH(8),DX(18,10,10),DR(7,10,10),CBET(25), c 3 SR(7,10,10),SAVE(8),RINV(18,7),CINV(18,7),SX(12),CODEM(22,8), c 4 THETA(8),S1(8),S2(7),MUINV(7),PWAURB,YRDTRA,PVTBUD,CLOSS(5), c 5 DBUD(8),RINVPR(7),DTR(12,10),ST(12),DCONSD(21,8),CVFLAG(8), c 6 rallwd(7,10,10),reserv(100) C C include 'gblk.for' c COMMON /GBLK/GINV(18),HINV(18),GSNV(18),IINV(18),TINV(18), c 1 CONV(18),GOIRUR(7),GOIOTH(7),GOISOC,GOIIND,GOICON,GOITRA, c 2 GCSER(18),TAU(7),AVINTA(18),AVROTA(18),AVLOTA(18),PSI(3,7), c 3 PCH(7),GOIUR1(18),GOIUR2(18),GOVDEM(18),DTPTLO,DTPTFO,GLABCO, c 4 TRSUBS,TROPSS,TRILHH,FORAST,YGOVTO,GAMGOV(8),GOCON(18) C C include 'trblk.for' c COMMON /TRBLK/ CATR(12),CALFTR(12),EKTR(12),DRDTR(12),XTR include 'glblk.for' c COMMON /GLBLK/ GVIRUR,GVISOC,GVIIND,GVITRA,GVICON,GVITOT, c 1 GVCOMM,AGINPT,AVTAX,GOSER,GVBUD,GVSER,IMDUIN,IMDURO, c 2 SAVSPL,PGSVC,LTAX,GOVEMP C C INTEGER I,J REAL VFDR(7),TPV(7),PGNV(7),PHNV(7),GOIROL(7),GOIOOL(7), 1 vioco(18,4),vfoodx(11,7),vxlab(7),vgcser(18),vcprin(18,4), 2 vgsnv(18),viinv(18),vtinv(18),vhinv(18),vconv(18),vglabc, 3 vginv(18),qx(18) C c ----------------------------- C c data vioco/ c 1 7*0.,0.090353932,0.032099423,0.050407983,0.015217504,3*0., c 2 0.051239098,0.076955690,2*0., c 3 6*0.,0.010920369,0.035135101,0.013579242,0.024119772, c 4 0.000474799,3*0.,0.062109967,0.192512795,2*0., c 5 7*0.,0.005902807,0.025147577,0.231422397,0.152987832,3*0., c 6 0.056103865,0.039967798,2*0., c 7 7*0.,0.004660954,0.003015911,0.008499386,0.011515297,3*0., c 8 0.013815174,0.023783084,2*0./ c c coefficients for trade reduced 04-Sep-1989 (except for priv.serv.) c data vioco/ 1 7*0.,0.090353932,0.032099423,0.00,0.015217504,3*0., 2 0.051239098,0.076955690,2*0., 3 6*0.,0.010920369,0.035135101,0.00,0.024119772, 4 0.000474799,3*0.,0.062109967,0.192512795,2*0., 5 7*0.,0.005902807,0.025147577,0.15,0.152987832,3*0., 6 0.056103865,0.039967798,2*0., 7 7*0.,0.004660954,0.003015911,0.008499386,0.011515297,3*0., 8 0.013815174,0.023783084,2*0./ c data vfoodx /77*0./ c c data vginv /7*0.,0.014379572,0.700118419,0.010315780,0.010315780, c 1 5*0.,0.097945011,0.166925440/ data vginv /7*0.,0.014379572,0.700118419,0.0,0.010315780, 2 5*0.,0.097945011,0.166925440/ c data vhinv /7*0.,.0096,.6762,.0115,.0096,5*0., 3 .1437,.1494/ c c c data vcprin / c 1 7*0.,0.099976140,0.411891159,0.019758130,0.021997385,5*0., c 2 0.174292362,0.272084823, c 3 7*0.,0.075016835,0.570333468,0.010276279,0.016544809,5*0., c 4 0.036747288,0.291081322, c 5 7*0.,0.106101175,0.307233179,0.014677536,0.023384550,5*0., c 6 0.125421141,0.423182420, c 7 7*0.,0.066773678,0.890986127,0.009251775,0.014682164,5*0., c 8 0.006973810,0.011332446/ data vcprin / 1 7*0.,0.099976140,0.411891159,0.0,0.021997385,5*0., 2 0.174292362,0.272084823, 3 7*0.,0.075016835,0.570333468,0.0,0.016544809,5*0., 4 0.036747288,0.291081322, 5 7*0.,0.106101175,0.307233179,0.0,0.023384550,5*0., 6 0.125421141,0.423182420, 7 7*0.,0.066773678,0.890986127,0.0,0.014682164,5*0., 8 0.006973810,0.011332446/ c c data viinv / 7*0.,0.008955829,0.635936158,0.047769029,0.047769029, c 1 5*0.,0.097237744,0.162332212/ data viinv / 7*0.,0.008955829,0.635936158,0.0,0.047769029, 2 5*0.,0.097237744,0.162332212/ data vconv / 7*0.,0.000000000,0.645525114,0.000000000,0.107587519, 3 5*0.,0.135751921,0.111135446/ c data vtinv / 7*0.,0.010031444,0.708291435,0.012038159,0.010031444, c 4 5*0.,0.096050593,0.163556924/ data vtinv / 7*0.,0.010031444,0.708291435,0.0,0.010031444, 5 5*0.,0.096050593,0.163556924/ data vgsnv / 7*0.,0.021111243,0.833927045,0.000000000,0.000000000, 6 5*0.,0.078240458,0.066721254/ c c do 71 i=1,11 px(i,3) = px(i,8) + cbet(i+7) * pt(7) px(i,7) = px(i,8) + cbet(i+7) * pt(8) px(i,10) = px(i,8) + cbet(i+7) * pt(12) px(i,4) = px(i,7) + cbet(i+7) * pt(4) px(i,1) = px(i,3) + cbet(i+7) * pt(1) px(i,6) = px(i,3) + cbet(i+7) * pt(3) px(i,5) = px(i,6) + cbet(i+7) * pt(5) px(i,2) = px(i,5) + cbet(i+7) * pt(2) px(i,9) = px(i,6) + cbet(i+7) * pt(10) 71 continue c c vioco(1,1) = (35./113.)*529./(11098.-793.) vioco(2,1) = (63./113.)*529./(11098.-793.) vioco(3,1) = (15./113.)*529./(11098.-793.) vioco(4,1) = 0. vioco(5,1) = 0. vioco(6,1) = (53.3/718.5)*3082./(11098.-793.) vioco(7,1) = (665.2/718.5)*3082./(11098.-793.) c c xxx = ((2834.-23.)/(2834.-23.+752.-8.)) * (3866.-57.) do 1 j=1,4 vfoodx(1,j) = (14./18.)*21. / xxx vfoodx(2,j) = (5./6.)*7. / xxx vfoodx(3,j) = (7./9.)*10. / xxx vfoodx(8,j) = (19./25.)*42. / xxx vfoodx(9,j) = (19./25.)*15. / xxx vxlab(j) = (38./50.)*51. / xxx 1 continue c xxx = ( (752. - 8.)/(2834.-23.+752.-8.) ) * (3866.-57.) vxlab(5) = (12./50.)*51. / xxx vfoodx(1,5) = (4./18.)*21. / xxx vfoodx(2,5) = (1./6.)*7. / xxx vfoodx(3,5) = (2./9.)*10. / xxx vfoodx(8,5) = (6./25.)*42. / xxx vfoodx(9,5) = (6./25.)*15. / xxx c c vgcser(1) = (245./249.)*202. / (4915.-27.) vgcser(2) = 0. vgcser(3) = 0. vgcser(4) = 0. vgcser(5) = (4./249.)*202. / (4915.-27.) vgcser(6) = 0. vgcser(7) = 0. vgcser(8) = 220. / (4915.-27.) vgcser(9) = 37. / (4915.-27.) c vgcser(10) = 137. / (4915.-27.) vgcser(10) = 0. vgcser(11) = 75. / (4915.-27.) vgcser(12) = 0. vgcser(13) = 0. vgcser(14) = 0. vgcser(15) = 100. / (4915.-27.) vgcser(16) = 205. / (4915.-27.) vgcser(17) = 0. vgcser(18) = 0. c c vglabc = 3911. / (4915.-27.) c do 9 i=1,12 9 qx(i) = px(i,8) c qx(13) = px(13,9) qx(15) = px(15,9) qx(17) = px(17,9) qx(14) = px(14,10) qx(16) = px(16,10) qx(18) = px(18,10) c do 2 j=1,4 p = px(j+7,8)*(1.-avlota(j+7))/ 1 (1.+avinta(15)*vioco(15,j)+avrota(16)*vioco(16,j)) do 21 i = 1,7 ioco(i,j) = p * vioco(i,j)/pr(i,8) 21 continue c do 22 i = 8,18 22 ioco(i,j) = p * vioco(i,j) / qx(i) c c 2 continue c c do 3 j=1,5 p = px(j,8)*(1-avlota(j))/ 1 (1.+avinta(15)*vfoodx(8,j)+avrota(16)*vfoodx(9,j)) do 31 i = 1,11 31 ufoodx(i,j) = vfoodx(i,j) * p / qx(i+7) c uxlab(j) = vxlab(j) * p/(pwaurb*swage(1)) c 3 continue c do 4 i=1,18 gcser(i) = vgcser(i) / 1 ( (1+avinta(15)*vgcser(15)+avrota(16)*vgcser(16))*qx(i) ) ginv(i) = vginv(i) / 2 ( (1+avinta(17)*vginv(17)+avrota(18)*vginv(18)) * qx(i) ) gsnv(i) = vgsnv(i) / 3 ( (1+avinta(17)*vgsnv(17)+avrota(18)*vgsnv(18)) * qx(i) ) iinv(i) = viinv(i) / 4 ( (1+avinta(17)*viinv(17)+avrota(18)*viinv(18)) * qx(i) ) tinv(i) = vtinv(i) / 5 ( (1+avinta(17)*vtinv(17)+avrota(18)*vtinv(18)) * qx(i) ) conv(i) = vconv(i) / 6 ( (1+avinta(17)*vconv(17)+avrota(18)*vconv(18)) * qx(i) ) hinv(i) = vhinv(i) / 7 ( (1+avinta(17)*vhinv(17)+avrota(18)*vhinv(18)) * qx(i) ) c 4 continue c c do 5 j = 1,4 p = ( 1 + avinta(17)*vcprin(17,j)+avrota(18)*vcprin(18,j) ) do 51 i = 1,18 51 cuprin(i,j) = p * vcprin(i,j) / qx(i) 5 continue c c glabco = vglabc / 1 ( (1 + avinta(15)*vgcser(15)+avrota(16)*vgcser(16))* 2 pwaurb*swage(5) ) c c c ------------------------------------------- c c DO 1717 I = 1,7 GOIOOL(I) = 0. 1717 CONTINUE C GOIROL(1) = (2.81/490)*2759 GOIROL(2) = (40.72/490)*2759 GOIROL(3) = (68.80/490)*2759 GOIROL(4) = (4.21/490)*2759 GOIROL(5) = (162.86/490)*2759 GOIROL(6) = (103.90/490)*2759 GOIROL(7) = (106.70/490)*2759 C DR(1,8,10) = 0./PR(1,8) DR(2,8,10) = 0./PR(2,8) DR(3,8,10) = 0./PR(3,8) DR(4,8,10) = 0./PR(4,8) DR(5,8,10) = (2.41/189.63)*353/56.674 DR(6,8,10) = (187.22/189.63)*353/3.096 DR(7,8,10) = 0./PR(7,8) C DX(1,6,9) = (17.84671/378.36731)*314/8.211 DX(2,6,9) = 0./PX(1,6) DX(3,6,9) = (248.4906/378.36731)*314/6.818 DX(4,6,9) = (18.03/378.36731)*314/6.778 DX(5,6,9) = (94./378.36731)*314/56.972 DX(6,6,9) = 0./PX(6,6) DX(7,6,9) = 0./PX(7,6) C DX(1,8,10) = (106.93/107.93)*1315/7.913 DX(5,8,10) = (1./107.93)*1315/56.674 C DX( 8,6,9) = 5026./4.296 DX(11,6,9) = 1846./2.456 DX(10,6,9) = 1061./1.934 DX( 8,8,10) = 459/4.155 DX(10,8,10) = 1465./1.880 DX(11,8,10) = 2661./2.464 C DTR(12,10) = CBET(1)*DR(1,8,10)+CBET(5)*DR(5,8,10)+ 1 CBET(6)*DR(6,8,10)+CBET(8)*DX(1,8,10)+CBET(15)*DX(8,8,10)+ 2 CBET(17)*DX(10,8,10)+CBET(18)*DX(11,8,10) C DTR(10,9) = CBET(8)*DX(1,6,9)+CBET(10)*DX(3,6,9)+ 1 CBET(11)*DX(4,6,9)+CBET(15)*DX(8,6,9)+CBET(18)*DX(11,6,9) XTR = 0.0 C DMANR(1) = (36/43.12)*5.256394 /4.459 DMANR(2) = (36/43.12)*11.62070 /4.683 DMANR(3) = (36/43.12)*7.492198 /4.199 DMANR(4) = (36/43.12)*18.75339 /4.461 DMANR(5) = (81/27.87)*9.023821 /4.477 DMANR(6) = (81/27.87)*15.66232 /4.296 DMANR(7) = (81/27.87)*3.191157 /4.280 C C UPRINV(1) = 2556. / PUPRIN(1) UPRINV(2) = 1186./ PUPRIN(2) UPRINV(3) = 1798./ PUPRIN(3) UPRINV(4) = 7172. / PUPRIN(4) C poisoc = 0. poitra = 0. poicon = 0. poiind = 0. c do 135 i=1,7 poisoc = poisoc + pr(i,8) * gsnv(i) poitra = poitra + pr(i,8) * tinv(i) poicon = poicon + pr(i,8) * conv(i) poiind = poiind + pr(i,8) * iinv(i) 135 continue c do 136 i=8,18 poisoc = poisoc + px(i,8) * gsnv(i) poitra = poitra + px(i,8) * tinv(i) poicon = poicon + px(i,8) * conv(i) poiind = poiind + px(i,8) * iinv(i) 136 continue GOISOC = 1100. / poiSOC GOITRA = 2048./ poiTRA GOICON = 78. / poiCON GOIIND = 1898./ poIIND C DO 201 I = 1,7 PGNV(I) = 0. PHNV(I) = 0. DO 202 J = 1,18 PGNV(I) = PGNV(I) + GINV(J)*PX(J,I) 202 CONTINUE GOIRUR(I) = GOIROL(I) / PGNV(I) 201 CONTINUE C c c Food to Cash deliveries distributed over regions according to LSU number c See i-o table 86/87. c Distribution within Food sectors according to gross production value. c tlsu = 0. do 91 i=1,7 tlsu = tlsu + grqr(7,i) 91 continue c do 200 i=1,7 vfdr(i) = ( grqr(7,i) / tlsu ) * 667. tpv(i) = pr(1,i) * grqr(1,i) + pr(2,i) * grqr(2,i) + 1 pr(3,i) * grqr(3,i) + pr(4,i) * grqr(4,i) do 2011 j=1,4 fdr(j,i) = grqr(j,i) * vfdr(i) / tpv(i) 2011 continue 200 continue c c RETURN END C file 25 BLOCK DATA INICOEBD c c c version 28-Aug-1989 c IMPLICIT REAL (A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' C DATA CBET/1.,1.,1.,1.,1.,2.19,20.,1.,1.,1.,1.,1.,2.19,20., 1 .5,.5,0.2,0.,0.,.33,.33,.33,.33,.33,.33 / C DATA CINV/126*0.0/ C c c 0.2586 food c 0.2389 cash c 0.1539 man c 0.0432 mill c c 0.1500 trade c 0.0135 p.svc c c c 0.8581 c 0.1419 c 0.0516 india c 0.0902 row c c 1.0000 c c c DATA CODEM /.1048,.042,.056,.099,10*0.0,5*.95, 0.0, 0.0, 0.0 1 ,.1258,.021,.065,.090,10*0.0,5*.9, 0.0, 0.0, 0.0 2 ,.1258,.021,.065,.090,10*0.0,5*.9, 0.0, 0.0, 0.0 3 ,.1258,.021,.065,.090,10*0.0,5*.9, 0.0, 0.0, 0.0 4 ,.204,.0228,.026,.049,10*0.0,5*.9, 0.0, 0.0, 0.0 5 ,.204,.0228,.026,.049,10*0.0,5*.9, 0.0, 0.0, 0.0 6 ,.204,.0228,.026,.049,10*0.0,5*.9, 0.0, 0.0, 0.0 7 ,.175,.030,.0478,.049,10*0.0,5*.75, 0.0, 0.0, 0.0/ C c DATA CLOSS /.4, .1, .1, .1, 2./ c c no longer used? c c C C DATA UFOODR,UFOODX /49*0. , 77*0./ C DATA UXDEP /.007823,.007823,.007823,.007823,.011111,.0,.0/ C c DATA UX17OS/.270133,.270133,.270133,.270133,.348148,.0,.0/ data ux17os/5*0.15,2*0./ C C DATA CALFUR /0.3463,0.7273,0.6254,0.2140/ c DATA CAURB /108.67468,3.5694555,4.872394,231.79243/ data caurb /88.92, 3.52, 4.58, 226.9/ DATA DELTA /4*0.02/ C C DATA CATR /12*100000./ DATA CALFTR/12*0.33/ C END C C DK INIDAT C SUBROUTINE INICOESR c c c version 28-Aug-1989 c C IMPLICIT REAL (A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' C INTEGER I,J REAL DUM(20) C C DUM(5) = 0.0882 DUM(6) = 0.0 DUM(7) = 0.9118 c C dum(5) to dum(7) are applied to fraction of cash consumption c i.e. .2389 C DUM(8) = 0.15393 DUM(9) = 0.0 DUM(10) = 0.15 DUM(11) = 0.0135 DUM(12) = 0.0 DUM(13) = 0.0516 DUM(14) = 0.0902 C c dum(8) to dum(14) are straight from the i-o table 87 C CINV(8,1) = 1.0 MUINV(1) = 0.1 S1(1) = 0.05 * .1530/.1175 c S2(1) = 0.0852 S2(1) = 0.3 THETA(1) = 0.0274 GAMGOV(1) = 0.056 C DO 100 J=5,7 CODEM(J,1) = DUM(J)*0.2389 100 CONTINUE C DO 101 J=8,14 CODEM(J,1) = DUM(J) 101 CONTINUE C theta(2) = .0763 theta(3) = .034 theta(4) = .0251 c c DO 1 I=2,4 CINV(8,I) = 1.0 MUINV(I) = 0.1 S1(I) = 0.09 * .1530/.1175 c S2(I) = 0.0852 S2(I) = 0.3 GAMGOV(I) = 0.075 C DO 102 J=5,7 CODEM(J,I) = DUM(J)*0.2389 102 CONTINUE C DO 103 J=8,14 CODEM(J,I) = DUM(J) 103 CONTINUE C 1 CONTINUE C theta(5) = .033 theta(6) = .0463 theta(7) = .0386 c c DO 2 I=5,7 CINV(8,I)=0.8 CINV(15,I)=0.2 MUINV(I) = 0.36 S1(I) = 0.14 * .1530/.1175 c S2(I) = 0.067 S2(I) = 0.18 GAMGOV(I) = 0.094 C DO 105 J=5,7 CODEM(J,I) = DUM(J)*0.2389 105 CONTINUE C DO 106 J=8,14 CODEM(J,I) = DUM(J) 106 CONTINUE C 2 CONTINUE C S1(8) = 0.18 THETA(8) = 1. do 8888 j=1,7 8888 theta(8) = theta(8) - theta(j) c c GAMGOV(8)= 0.437 C DO 108 J=5,7 CODEM(J,8) = DUM(J)*0.2389 108 CONTINUE C DO 109 J=8,14 CODEM(J,8) = DUM(J) 109 CONTINUE C UFOODR(1,1) = 1.538461 UFOODR(2,2) = 1.1 UFOODR(3,3) = 1.3 UFOODR(4,4) = 1.1 UFOODR(5,5) = 3.33333 UFOODR(6,6) = 1. UFOODR(7,7) = 1. C C C RETURN END C C BLOCK DATA EXODATBD C DEBUG IMPLICIT REAL(A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' C DATA DR/700*.0/ DATA DX/1800*.0/ DATA DTR/120*.0/ DATA DCONSD/168*0./ DATA PWAURB/0.02662/ DATA PX/180*1./ DATA SR/700*.0/ DATA SX/12*0./ DATA PVTBUD/0./ DATA ST/12*1.E+7/ DATA TAU/7*.0/ C DATA XTR/0./ c c Indian Prices elsewhere initialized C c DATA PT/1., 0.8, 0.375, 0.7, 0.7, 0.5, 0.2, 0.5, 0.1, c 1 0.1, 0.1 ,0.0/ DATA PT/.43,0.34, 0.16, 0.30, 0.30, 0.22, 0.086, 0.22, 0.043, 1 0.043, 0.043 ,0.0/ c c PT: non endogenous in baseyear. These are preliminary values. c c AREA: Old 85/86 data used, scaled to Country total 86/87 c DATA AREA/167607,598563,287952,239184,598035,574598,481061/ C DATA PCH/7*3.990/ c c PCH: price of urea and complex used in 50/50 proportion C DATA PSI/3.69,3.92,4.54,6.15,6.01,6.86,5.80,6.07,5.44, 1 4.71,5.52,8.14,4.61,4.51,5.14,4.34,4.54,4.08, 2 3.53,4.13,6.11/ c c PSI: No data available, used scenario 1 values instead. c C DATA DCHEM/3.067, 1.558, 12.939, 5.753, 12.891, 50.089, 17.602/ c c DCHEM based on 2.3 times nutrient tons in 86/87 (SPBN 1988,p60). c This distributed according to 1984/85 fractions. c Similar procedure for DIMSE (SPBN 88,61) C DATA DIMSE/3.2705e-3, 136.4306e-3, 3.021103e-3, 1 6.1345e-3, 105.8726e-3, 11.09162e-3, 2 15.100e-3, 65.21832e-3, 11.77601e-3, 3 13.739e-3, 427.0336e-3, 19.58784e-3, 4 43.625e-3, 874.8556e-3, 2.113762e-3, 5 17.180e-3, 372.0083e-3, 16.09831e-3, 6 41.948e-3, 216.5806e-3, 8.311337e-3/ c C DATA YGOVTO,YRDTRA,YX17PR,Y811PR/1262.,100.,50.,71./ c c These are arbitrary initial values c c GRQR; For Livestock Data from SPBN 1988 were taken, p.39. c Weigths for conversion to LSU from IDS worksheets,1987. C Belt totals were split according to region totals for Hill, c according to 81/82 values for Terai. c Values for other crops were 1985/86 values scaled to Country c totals in 1986/87 c DATA grqr/ 1 73.2771,62.1906,126.319,182.4796,13.2679,277.10,0.09441, 2 400.8785,242.492,502.926,230.633,35.53,75.1566, 0.178021, 3 266.193,135.4712,266.175,100.495,28.903,113.2047, 0.081855, 4 182.235,48.523,275.788,158.734,42.508,218.4417, 0.071064, 5 993.197,310.329,150.3881,31.674,237.659,1065.77,0.0774720, 6 1107.06,297.827,155.845,64.014,141.77,2447.4773,0.061130, 7 908.267,103.875,46.801,48.740,22.214,2893.514, 0.056419/ c C DATA EKURB /4*1.324/ DATA EKTR /12*1./ C DATA PUPRIN /4*1./ DATA SWAGE / .80187,5.2766,1.20639,.21948,.83026/ C C END C C C C SUBROUTINE EXODATSR C IMPLICIT REAL (A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' C INTEGER I,J REAL VFDR(7),TPV(7) C DTR(12,10) = CBET(1)*DR(1,8,10)+CBET(5)*DR(5,8,10)+ 1 CBET(6)*DR(6,8,10)+CBET(8)*DX(1,8,10)+CBET(15)*DX(8,8,10)+ 2 CBET(17)*DX(10,8,10)+CBET(18)*DX(11,8,10) C DTR(10,9) = CBET(8)*DX(1,6,9)+CBET(10)*DX(3,6,9)+ 1 CBET(11)*DX(4,6,9)+CBET(15)*DX(8,6,9)+CBET(18)*DX(11,6,9) XTR = 0.0 C DO 100 I=1,7 c SLOC(1,I) = 0.15 * GRQR(1,I) c SLOC(2,I) = 0.18 * GRQR(2,I) c SLOC(3,I) = 0.1 * GRQR(3,I) c SLOC(4,I) = 0.1 * GRQR(4,I) c SLOC(5,I) = 0.1 * GRQR(5,I) c 04-Sep-1989 c SLOC(1,I) = 0.05 * GRQR(1,I) SLOC(2,I) = 0.05 * GRQR(2,I) SLOC(3,I) = 0.05 * GRQR(3,I) SLOC(4,I) = 0.05 * GRQR(4,I) SLOC(5,I) = 0.05 * GRQR(5,I) 100 CONTINUE C C RETURN END C SUBROUTINE MODMOJC C IMPLICIT REAL (A-Z) C C INCLUDE'INC.INC' include 'urbblk.for' c COMMON /URBBLK/ CALFUR(4),DLAURB(4),CAURB(4),EKURB(4),SWAGE(5), c 1 IOCO(18,4),UFOODX(11,7),UFOODR(7,7),UXLAB(7),UX17OS(7), c 2 UXDEP(7),DELTA(4),UVDEPR(4),PUPRIN(4),CUPRIN(18,4),UPRINV(4) C C include 'genblk.for' c COMMON /GENBLK/GRQR(7,7),SLOC(5,7),DIMSE(3,7),DCHEM(7),FDR(4,7), c 1 DMANR(7),AREA(7),PT(12),PR(7,9),PX(18,10),YREM(8),YX17PR, c 2 Y811PR,YTRANS(8),NOFHH(8),DX(18,10,10),DR(7,10,10),CBET(25), c 3 SR(7,10,10),SAVE(8),RINV(18,7),CINV(18,7),SX(12),CODEM(22,8), c 4 THETA(8),S1(8),S2(7),MUINV(7),PWAURB,YRDTRA,PVTBUD,CLOSS(5), c 5 DBUD(8),RINVPR(7),DTR(12,10),ST(12),DCONSD(21,8),CVFLAG(8), c 6 rallwd(7,10,10),reserv(100) C C include 'gblk.for' c COMMON /GBLK/GINV(18),HINV(18),GSNV(18),IINV(18),TINV(18), c 1 CONV(18),GOIRUR(7),GOIOTH(7),GOISOC,GOIIND,GOICON,GOITRA, c 2 GCSER(18),TAU(7),AVINTA(18),AVROTA(18),AVLOTA(18),PSI(3,7), c 3 PCH(7),GOIUR1(18),GOIUR2(18),GOVDEM(18),DTPTLO,DTPTFO,GLABCO, c 4 TRSUBS,TROPSS,TRILHH,FORAST,YGOVTO,GAMGOV(8),GOCON(18) C C include 'trblk.for' c COMMON /TRBLK/ CATR(12),CALFTR(12),EKTR(12),DRDTR(12),XTR include 'glblk.for' c COMMON /GLBLK/ GVIRUR,GVISOC,GVIIND,GVITRA,GVICON,GVITOT, c 1 GVCOMM,AGINPT,AVTAX,GOSER,GVBUD,GVSER,IMDUIN,IMDURO, c 2 SAVSPL,PGSVC,LTAX,GOVEMP C C INTEGER I,J REAL VFDR(7),TPV(7),PGNV(7),PHNV(7),GOIROL(7),GOIOOL(7), 1 vioco(18,4),vfoodx(11,7),vxlab(7),vgcser(18),vcprin(18,4), 2 vgsnv(18),viinv(18),vtinv(18),vhinv(18),vconv(18),vglabc, 3 vginv(18),qx(18) C c ----------------------------- C c data vioco/ c 1 7*0.,0.090353932,0.032099423,0.050407983,0.015217504,3*0., c 2 0.051239098,0.076955690,2*0., c 3 6*0.,0.010920369,0.035135101,0.013579242,0.024119772, c 4 0.000474799,3*0.,0.062109967,0.192512795,2*0., c 5 7*0.,0.005902807,0.025147577,0.231422397,0.152987832,3*0., c 6 0.056103865,0.039967798,2*0., c 7 7*0.,0.004660954,0.003015911,0.008499386,0.011515297,3*0., c 8 0.013815174,0.023783084,2*0./ c c coefficients for trade reduced 04-Sep-1989 (except for priv.serv.) c data vioco/ 1 7*0.,0.090353932,0.032099423,0.00,0.015217504,3*0., 2 0.051239098,0.076955690,2*0., 3 6*0.,0.010920369,0.035135101,0.00,0.024119772, 4 0.000474799,3*0.,0.062109967,0.192512795,2*0., 5 7*0.,0.005902807,0.025147577,0.15,0.152987832,3*0., 6 0.056103865,0.039967798,2*0., 7 7*0.,0.004660954,0.003015911,0.008499386,0.011515297,3*0., 8 0.013815174,0.023783084,2*0./ c data vfoodx /77*0./ c c data vginv /7*0.,0.014379572,0.700118419,0.010315780,0.010315780, c 1 5*0.,0.097945011,0.166925440/ data vginv /7*0.,0.014379572,0.700118419,0.0,0.010315780, 2 5*0.,0.097945011,0.166925440/ c data vhinv /7*0.,.0096,.6762,.0115,.0096,5*0., 3 .1437,.1494/ c c c data vcprin / c 1 7*0.,0.099976140,0.411891159,0.019758130,0.021997385,5*0., c 2 0.174292362,0.272084823, c 3 7*0.,0.075016835,0.570333468,0.010276279,0.016544809,5*0., c 4 0.036747288,0.291081322, c 5 7*0.,0.106101175,0.307233179,0.014677536,0.023384550,5*0., c 6 0.125421141,0.423182420, c 7 7*0.,0.066773678,0.890986127,0.009251775,0.014682164,5*0., c 8 0.006973810,0.011332446/ data vcprin / 1 7*0.,0.099976140,0.411891159,0.0,0.021997385,5*0., 2 0.174292362,0.272084823, 3 7*0.,0.075016835,0.570333468,0.0,0.016544809,5*0., 4 0.036747288,0.291081322, 5 7*0.,0.106101175,0.307233179,0.0,0.023384550,5*0., 6 0.125421141,0.423182420, 7 7*0.,0.066773678,0.890986127,0.0,0.014682164,5*0., 8 0.006973810,0.011332446/ c c data viinv / 7*0.,0.008955829,0.635936158,0.047769029,0.047769029, c 1 5*0.,0.097237744,0.162332212/ data viinv / 7*0.,0.008955829,0.635936158,0.0,0.047769029, 2 5*0.,0.097237744,0.162332212/ data vconv / 7*0.,0.000000000,0.645525114,0.000000000,0.107587519, 3 5*0.,0.135751921,0.111135446/ c data vtinv / 7*0.,0.010031444,0.708291435,0.012038159,0.010031444, c 4 5*0.,0.096050593,0.163556924/ data vtinv / 7*0.,0.010031444,0.708291435,0.0,0.010031444, 5 5*0.,0.096050593,0.163556924/ data vgsnv / 7*0.,0.021111243,0.833927045,0.000000000,0.000000000, 6 5*0.,0.078240458,0.066721254/ c c do 71 i=1,11 px(i,3) = px(i,8) + cbet(i+7) * pt(7) px(i,7) = px(i,8) + cbet(i+7) * pt(8) px(i,10) = px(i,8) + cbet(i+7) * pt(12) px(i,4) = px(i,7) + cbet(i+7) * pt(4) px(i,1) = px(i,3) + cbet(i+7) * pt(1) px(i,6) = px(i,3) + cbet(i+7) * pt(3) px(i,5) = px(i,6) + cbet(i+7) * pt(5) px(i,2) = px(i,5) + cbet(i+7) * pt(2) px(i,9) = px(i,6) + cbet(i+7) * pt(10) 71 continue c c vioco(1,1) = (35./113.)*529./(11098.-793.) vioco(2,1) = (63./113.)*529./(11098.-793.) vioco(3,1) = (15./113.)*529./(11098.-793.) vioco(4,1) = 0. vioco(5,1) = 0. vioco(6,1) = (53.3/718.5)*3082./(11098.-793.) vioco(7,1) = (665.2/718.5)*3082./(11098.-793.) c c xxx = ((2834.-23.)/(2834.-23.+752.-8.)) * (3866.-57.) do 1 j=1,4 vfoodx(1,j) = (14./18.)*21. / xxx vfoodx(2,j) = (5./6.)*7. / xxx vfoodx(3,j) = (7./9.)*10. / xxx vfoodx(8,j) = (19./25.)*42. / xxx vfoodx(9,j) = (19./25.)*15. / xxx vxlab(j) = (38./50.)*51. / xxx 1 continue c xxx = ( (752. - 8.)/(2834.-23.+752.-8.) ) * (3866.-57.) vxlab(5) = (12./50.)*51. / xxx vfoodx(1,5) = (4./18.)*21. / xxx vfoodx(2,5) = (1./6.)*7. / xxx vfoodx(3,5) = (2./9.)*10. / xxx vfoodx(8,5) = (6./25.)*42. / xxx vfoodx(9,5) = (6./25.)*15. / xxx c c vgcser(1) = (245./249.)*202. / (4915.-27.) vgcser(2) = 0. vgcser(3) = 0. vgcser(4) = 0. vgcser(5) = (4./249.)*202. / (4915.-27.) vgcser(6) = 0. vgcser(7) = 0. vgcser(8) = 220. / (4915.-27.) vgcser(9) = 37. / (4915.-27.) c vgcser(10) = 137. / (4915.-27.) vgcser(10) = 0. vgcser(11) = 75. / (4915.-27.) vgcser(12) = 0. vgcser(13) = 0. vgcser(14) = 0. vgcser(15) = 100. / (4915.-27.) vgcser(16) = 205. / (4915.-27.) vgcser(17) = 0. vgcser(18) = 0. c c vglabc = 3911. / (4915.-27.) c do 9 i=1,12 9 qx(i) = px(i,8) c qx(13) = px(13,9) qx(15) = px(15,9) qx(17) = px(17,9) qx(14) = px(14,10) qx(16) = px(16,10) qx(18) = px(18,10) c do 2 j=1,4 p = px(j+7,8)*(1.-avlota(j+7))/ 1 (1.+avinta(15)*vioco(15,j)+avrota(16)*vioco(16,j)) do 21 i = 1,7 ioco(i,j) = p * vioco(i,j)/pr(i,8) 21 continue c do 22 i = 8,18 22 ioco(i,j) = p * vioco(i,j) / qx(i) c c 2 continue c c do 3 j=1,5 p = px(j,8)*(1-avlota(j))/ 1 (1.+avinta(15)*vfoodx(8,j)+avrota(16)*vfoodx(9,j)) do 31 i = 1,11 31 ufoodx(i,j) = vfoodx(i,j) * p / qx(i+7) c uxlab(j) = vxlab(j) * p/(pwaurb*swage(1)) c 3 continue c do 4 i=1,18 gcser(i) = vgcser(i) / 1 ( (1+avinta(15)*vgcser(15)+avrota(16)*vgcser(16))*qx(i) ) ginv(i) = vginv(i) / 2 ( (1+avinta(17)*vginv(17)+avrota(18)*vginv(18)) * qx(i) ) gsnv(i) = vgsnv(i) / 3 ( (1+avinta(17)*vgsnv(17)+avrota(18)*vgsnv(18)) * qx(i) ) iinv(i) = viinv(i) / 4 ( (1+avinta(17)*viinv(17)+avrota(18)*viinv(18)) * qx(i) ) tinv(i) = vtinv(i) / 5 ( (1+avinta(17)*vtinv(17)+avrota(18)*vtinv(18)) * qx(i) ) conv(i) = vconv(i) / 6 ( (1+avinta(17)*vconv(17)+avrota(18)*vconv(18)) * qx(i) ) hinv(i) = vhinv(i) / 7 ( (1+avinta(17)*vhinv(17)+avrota(18)*vhinv(18)) * qx(i) ) c 4 continue c c do 5 j = 1,4 p = ( 1 + avinta(17)*vcprin(17,j)+avrota(18)*vcprin(18,j) ) do 51 i = 1,18 51 cuprin(i,j) = p * vcprin(i,j) / qx(i) 5 continue c c glabco = vglabc / 1 ( (1 + avinta(15)*vgcser(15)+avrota(16)*vgcser(16))* 2 pwaurb*swage(5) ) c c c ------------------------------------------- c c DO 1717 I = 1,7 GOIOOL(I) = 0. 1717 CONTINUE C GOIROL(1) = (2.81/490)*2759 GOIROL(2) = (40.72/490)*2759 GOIROL(3) = (68.80/490)*2759 GOIROL(4) = (4.21/490)*2759 GOIROL(5) = (162.86/490)*2759 GOIROL(6) = (103.90/490)*2759 GOIROL(7) = (106.70/490)*2759 C DR(1,8,10) = 0./PR(1,8) DR(2,8,10) = 0./PR(2,8) DR(3,8,10) = 0./PR(3,8) DR(4,8,10) = 0./PR(4,8) DR(5,8,10) = (2.41/189.63)*353/62.341 DR(6,8,10) = (187.22/189.63)*353/3.406 DR(7,8,10) = 0./PR(7,8) C DX(1,6,9) = (17.84671/378.36731)*314/9.032 DX(2,6,9) = 0./PX(1,6) DX(3,6,9) = (248.4906/378.36731)*314/7.500 DX(4,6,9) = (18.03/378.36731)*314/7.456 DX(5,6,9) = (94./378.36731)*314/62.669 DX(6,6,9) = 0./PX(6,6) DX(7,6,9) = 0./PX(7,6) C DX(1,8,10) = (106.93/107.93)*1315/8.705 DX(5,8,10) = (1./107.93)*1315/62.341 C DX( 8,6,9) = 6498./4.725 DX(11,6,9) = 1886./2.702 DX(10,6,9) = 1089./2.132 DX( 8,8,10) = 594/4.571 DX(10,8,10) = 1503./2.068 DX(11,8,10) = 2720./2.710 C DTR(12,10) = CBET(1)*DR(1,8,10)+CBET(5)*DR(5,8,10)+ 1 CBET(6)*DR(6,8,10)+CBET(8)*DX(1,8,10)+CBET(15)*DX(8,8,10)+ 2 CBET(17)*DX(10,8,10)+CBET(18)*DX(11,8,10) C DTR(10,9) = CBET(8)*DX(1,6,9)+CBET(10)*DX(3,6,9)+ 1 CBET(11)*DX(4,6,9)+CBET(15)*DX(8,6,9)+CBET(18)*DX(11,6,9) XTR = 0.0 C DMANR(1) = (36/43.12)*5.256394 /4.905 DMANR(2) = (36/43.12)*11.62070 /5.151 DMANR(3) = (36/43.12)*7.492198 /4.619 DMANR(4) = (36/43.12)*18.75339 /4.907 DMANR(5) = (81/27.87)*9.023821 /4.925 DMANR(6) = (81/27.87)*15.66232 /4.725 DMANR(7) = (81/27.87)*3.191157 /4.708 C C UPRINV(1) = 2747. / PUPRIN(1) UPRINV(2) = 1275./ PUPRIN(2) UPRINV(3) = 1931./ PUPRIN(3) UPRINV(4) = 7706. / PUPRIN(4) C poisoc = 0. poitra = 0. poicon = 0. poiind = 0. c do 135 i=1,7 poisoc = poisoc + pr(i,8) * gsnv(i) poitra = poitra + pr(i,8) * tinv(i) poicon = poicon + pr(i,8) * conv(i) poiind = poiind + pr(i,8) * iinv(i) 135 continue c do 136 i=8,18 poisoc = poisoc + px(i,8) * gsnv(i) poitra = poitra + px(i,8) * tinv(i) poicon = poicon + px(i,8) * conv(i) poiind = poiind + px(i,8) * iinv(i) 136 continue GOISOC = 1182. / poiSOC GOITRA = 2200./ poiTRA GOICON = 83. / poiCON GOIIND = 2039./ poIIND C DO 201 I = 1,7 PGNV(I) = 0. PHNV(I) = 0. DO 202 J = 1,18 PGNV(I) = PGNV(I) + GINV(J)*PX(J,I) 202 CONTINUE GOIRUR(I) = GOIROL(I) / PGNV(I) 201 CONTINUE C c c Food to Cash deliveries distributed over regions according to LSU number c See i-o table 86/87. c Distribution within Food sectors according to gross production value. c tlsu = 0. do 91 i=1,7 tlsu = tlsu + grqr(7,i) 91 continue c do 200 i=1,7 vfdr(i) = ( grqr(7,i) / tlsu ) * 667. tpv(i) = pr(1,i) * grqr(1,i) + pr(2,i) * grqr(2,i) + 1 pr(3,i) * grqr(3,i) + pr(4,i) * grqr(4,i) do 2011 j=1,4 fdr(j,i) = grqr(j,i) * vfdr(i) / tpv(i) 2011 continue 200 continue c c RETURN END C file 26 BLOCK DATA INICOEBD c c c version 28-Aug-1989 c IMPLICIT REAL (A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' C DATA CBET/1.,1.,1.,1.,1.,2.19,20.,1.,1.,1.,1.,1.,2.19,20., 1 .5,.5,0.2,0.,0.,.33,.33,.33,.33,.33,.33 / C DATA CINV/126*0.0/ C c c 0.2586 food c 0.2389 cash c 0.1539 man c 0.0432 mill c c 0.1500 trade c 0.0135 p.svc c c c 0.8581 c 0.1419 c 0.0516 india c 0.0902 row c c 1.0000 c c c DATA CODEM /.1048,.042,.056,.099,10*0.0,5*.95, 0.0, 0.0, 0.0 1 ,.1258,.021,.065,.090,10*0.0,5*.9, 0.0, 0.0, 0.0 2 ,.1258,.021,.065,.090,10*0.0,5*.9, 0.0, 0.0, 0.0 3 ,.1258,.021,.065,.090,10*0.0,5*.9, 0.0, 0.0, 0.0 4 ,.204,.0228,.026,.049,10*0.0,5*.9, 0.0, 0.0, 0.0 5 ,.204,.0228,.026,.049,10*0.0,5*.9, 0.0, 0.0, 0.0 6 ,.204,.0228,.026,.049,10*0.0,5*.9, 0.0, 0.0, 0.0 7 ,.175,.030,.0478,.049,10*0.0,5*.75, 0.0, 0.0, 0.0/ C c DATA CLOSS /.4, .1, .1, .1, 2./ c c no longer used? c c C C DATA UFOODR,UFOODX /49*0. , 77*0./ C DATA UXDEP /.007823,.007823,.007823,.007823,.011111,.0,.0/ C c DATA UX17OS/.270133,.270133,.270133,.270133,.348148,.0,.0/ data ux17os/5*0.15,2*0./ C C DATA CALFUR /0.3463,0.7273,0.6254,0.2140/ c DATA CAURB /108.67468,3.5694555,4.872394,231.79243/ data caurb /88.92, 3.52, 4.58, 226.9/ DATA DELTA /4*0.02/ C C DATA CATR /12*100000./ DATA CALFTR/12*0.33/ C END C C DK INIDAT C SUBROUTINE INICOESR c c c version 28-Aug-1989 c C IMPLICIT REAL (A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' C INTEGER I,J REAL DUM(20) C C DUM(5) = 0.0882 DUM(6) = 0.0 DUM(7) = 0.9118 c C dum(5) to dum(7) are applied to fraction of cash consumption c i.e. .2389 C DUM(8) = 0.15393 DUM(9) = 0.0 DUM(10) = 0.15 DUM(11) = 0.0135 DUM(12) = 0.0 DUM(13) = 0.0516 DUM(14) = 0.0902 C c dum(8) to dum(14) are straight from the i-o table 87 C CINV(8,1) = 1.0 MUINV(1) = 0.1 S1(1) = 0.05 * .1530/.1175 c S2(1) = 0.0852 S2(1) = 0.3 THETA(1) = 0.0274 GAMGOV(1) = 0.056 C DO 100 J=5,7 CODEM(J,1) = DUM(J)*0.2389 100 CONTINUE C DO 101 J=8,14 CODEM(J,1) = DUM(J) 101 CONTINUE C theta(2) = .0763 theta(3) = .034 theta(4) = .0251 c c DO 1 I=2,4 CINV(8,I) = 1.0 MUINV(I) = 0.1 S1(I) = 0.09 * .1530/.1175 c S2(I) = 0.0852 S2(I) = 0.3 GAMGOV(I) = 0.075 C DO 102 J=5,7 CODEM(J,I) = DUM(J)*0.2389 102 CONTINUE C DO 103 J=8,14 CODEM(J,I) = DUM(J) 103 CONTINUE C 1 CONTINUE C theta(5) = .033 theta(6) = .0463 theta(7) = .0386 c c DO 2 I=5,7 CINV(8,I)=0.8 CINV(15,I)=0.2 MUINV(I) = 0.36 S1(I) = 0.14 * .1530/.1175 c S2(I) = 0.067 S2(I) = 0.18 GAMGOV(I) = 0.094 C DO 105 J=5,7 CODEM(J,I) = DUM(J)*0.2389 105 CONTINUE C DO 106 J=8,14 CODEM(J,I) = DUM(J) 106 CONTINUE C 2 CONTINUE C S1(8) = 0.18 THETA(8) = 1. do 8888 j=1,7 8888 theta(8) = theta(8) - theta(j) c c GAMGOV(8)= 0.437 C DO 108 J=5,7 CODEM(J,8) = DUM(J)*0.2389 108 CONTINUE C DO 109 J=8,14 CODEM(J,8) = DUM(J) 109 CONTINUE C UFOODR(1,1) = 1.538461 UFOODR(2,2) = 1.1 UFOODR(3,3) = 1.3 UFOODR(4,4) = 1.1 UFOODR(5,5) = 3.33333 UFOODR(6,6) = 1. UFOODR(7,7) = 1. C C C RETURN END C C BLOCK DATA EXODATBD C DEBUG IMPLICIT REAL(A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' C DATA DR/700*.0/ DATA DX/1800*.0/ DATA DTR/120*.0/ DATA DCONSD/168*0./ DATA PWAURB/0.029282/ DATA PX/180*1./ DATA SR/700*.0/ DATA SX/12*0./ DATA PVTBUD/0./ DATA ST/12*1.E+7/ DATA TAU/7*.0/ C DATA XTR/0./ c c Indian Prices elsewhere initialized C c DATA PT/1., 0.8, 0.375, 0.7, 0.7, 0.5, 0.2, 0.5, 0.1, c 1 0.1, 0.1 ,0.0/ DATA PT/.43,0.34, 0.16, 0.30, 0.30, 0.22, 0.086, 0.22, 0.043, 1 0.043, 0.043 ,0.0/ c c PT: non endogenous in baseyear. These are preliminary values. c c AREA: Old 85/86 data used, scaled to Country total 86/87 c DATA AREA/167607,598563,287952,239184,598035,574598,481061/ C DATA PCH/7*3.990/ c c PCH: price of urea and complex used in 50/50 proportion C DATA PSI/3.69,3.92,4.54,6.15,6.01,6.86,5.80,6.07,5.44, 1 4.71,5.52,8.14,4.61,4.51,5.14,4.34,4.54,4.08, 2 3.53,4.13,6.11/ c c PSI: No data available, used scenario 1 values instead. c C DATA DCHEM/3.067, 1.558, 12.939, 5.753, 12.891, 50.089, 17.602/ c c DCHEM based on 2.3 times nutrient tons in 86/87 (SPBN 1988,p60). c This distributed according to 1984/85 fractions. c Similar procedure for DIMSE (SPBN 88,61) C DATA DIMSE/3.2705e-3, 136.4306e-3, 3.021103e-3, 1 6.1345e-3, 105.8726e-3, 11.09162e-3, 2 15.100e-3, 65.21832e-3, 11.77601e-3, 3 13.739e-3, 427.0336e-3, 19.58784e-3, 4 43.625e-3, 874.8556e-3, 2.113762e-3, 5 17.180e-3, 372.0083e-3, 16.09831e-3, 6 41.948e-3, 216.5806e-3, 8.311337e-3/ c C DATA YGOVTO,YRDTRA,YX17PR,Y811PR/1262.,100.,50.,71./ c c These are arbitrary initial values c c GRQR; For Livestock Data from SPBN 1988 were taken, p.39. c Weigths for conversion to LSU from IDS worksheets,1987. C Belt totals were split according to region totals for Hill, c according to 81/82 values for Terai. c Values for other crops were 1985/86 values scaled to Country c totals in 1986/87 c DATA grqr/ 1 76.2082,64.6783,131.372,189.7788,13.7987,288.1865,0.07222, 2 416.9137,252.192,523.043,239.859,36.96,78.1633, 0.185143, 3 276.840,140.8901,276.822,104.515,30.059,117.7337, 0.085130, 4 189.525,50.464,286.819,164.979,44.209,227.1809, 0.073907, 5 1032.925,322.742,156.4036,32.941,247.167,1108.41,0.0805710, 6 1151.346,309.740,162.078,66.575,147.44,2545.3933,0.063575, 7 944.597,108.020,48.673,50.690,23.103,3009.274, 0.058676/ c C DATA EKURB /4*1.8564/ DATA EKTR /12*1./ C DATA PUPRIN /4*1./ DATA SWAGE / .80187,5.2766,1.20639,.21948,.83026/ C C END C C C C SUBROUTINE EXODATSR C IMPLICIT REAL (A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' C INTEGER I,J REAL VFDR(7),TPV(7) C DTR(12,10) = CBET(1)*DR(1,8,10)+CBET(5)*DR(5,8,10)+ 1 CBET(6)*DR(6,8,10)+CBET(8)*DX(1,8,10)+CBET(15)*DX(8,8,10)+ 2 CBET(17)*DX(10,8,10)+CBET(18)*DX(11,8,10) C DTR(10,9) = CBET(8)*DX(1,6,9)+CBET(10)*DX(3,6,9)+ 1 CBET(11)*DX(4,6,9)+CBET(15)*DX(8,6,9)+CBET(18)*DX(11,6,9) XTR = 0.0 C DO 100 I=1,7 c SLOC(1,I) = 0.15 * GRQR(1,I) c SLOC(2,I) = 0.18 * GRQR(2,I) c SLOC(3,I) = 0.1 * GRQR(3,I) c SLOC(4,I) = 0.1 * GRQR(4,I) c SLOC(5,I) = 0.1 * GRQR(5,I) c 04-Sep-1989 c SLOC(1,I) = 0.05 * GRQR(1,I) SLOC(2,I) = 0.05 * GRQR(2,I) SLOC(3,I) = 0.05 * GRQR(3,I) SLOC(4,I) = 0.05 * GRQR(4,I) SLOC(5,I) = 0.05 * GRQR(5,I) 100 CONTINUE C C RETURN END C SUBROUTINE MODMOJC C IMPLICIT REAL (A-Z) C C INCLUDE'INC.INC' include 'urbblk.for' c COMMON /URBBLK/ CALFUR(4),DLAURB(4),CAURB(4),EKURB(4),SWAGE(5), c 1 IOCO(18,4),UFOODX(11,7),UFOODR(7,7),UXLAB(7),UX17OS(7), c 2 UXDEP(7),DELTA(4),UVDEPR(4),PUPRIN(4),CUPRIN(18,4),UPRINV(4) C C include 'genblk.for' c COMMON /GENBLK/GRQR(7,7),SLOC(5,7),DIMSE(3,7),DCHEM(7),FDR(4,7), c 1 DMANR(7),AREA(7),PT(12),PR(7,9),PX(18,10),YREM(8),YX17PR, c 2 Y811PR,YTRANS(8),NOFHH(8),DX(18,10,10),DR(7,10,10),CBET(25), c 3 SR(7,10,10),SAVE(8),RINV(18,7),CINV(18,7),SX(12),CODEM(22,8), c 4 THETA(8),S1(8),S2(7),MUINV(7),PWAURB,YRDTRA,PVTBUD,CLOSS(5), c 5 DBUD(8),RINVPR(7),DTR(12,10),ST(12),DCONSD(21,8),CVFLAG(8), c 6 rallwd(7,10,10),reserv(100) C C include 'gblk.for' c COMMON /GBLK/GINV(18),HINV(18),GSNV(18),IINV(18),TINV(18), c 1 CONV(18),GOIRUR(7),GOIOTH(7),GOISOC,GOIIND,GOICON,GOITRA, c 2 GCSER(18),TAU(7),AVINTA(18),AVROTA(18),AVLOTA(18),PSI(3,7), c 3 PCH(7),GOIUR1(18),GOIUR2(18),GOVDEM(18),DTPTLO,DTPTFO,GLABCO, c 4 TRSUBS,TROPSS,TRILHH,FORAST,YGOVTO,GAMGOV(8),GOCON(18) C C include 'trblk.for' c COMMON /TRBLK/ CATR(12),CALFTR(12),EKTR(12),DRDTR(12),XTR include 'glblk.for' c COMMON /GLBLK/ GVIRUR,GVISOC,GVIIND,GVITRA,GVICON,GVITOT, c 1 GVCOMM,AGINPT,AVTAX,GOSER,GVBUD,GVSER,IMDUIN,IMDURO, c 2 SAVSPL,PGSVC,LTAX,GOVEMP C C INTEGER I,J REAL VFDR(7),TPV(7),PGNV(7),PHNV(7),GOIROL(7),GOIOOL(7), 1 vioco(18,4),vfoodx(11,7),vxlab(7),vgcser(18),vcprin(18,4), 2 vgsnv(18),viinv(18),vtinv(18),vhinv(18),vconv(18),vglabc, 3 vginv(18),qx(18) C c ----------------------------- C c data vioco/ c 1 7*0.,0.090353932,0.032099423,0.050407983,0.015217504,3*0., c 2 0.051239098,0.076955690,2*0., c 3 6*0.,0.010920369,0.035135101,0.013579242,0.024119772, c 4 0.000474799,3*0.,0.062109967,0.192512795,2*0., c 5 7*0.,0.005902807,0.025147577,0.231422397,0.152987832,3*0., c 6 0.056103865,0.039967798,2*0., c 7 7*0.,0.004660954,0.003015911,0.008499386,0.011515297,3*0., c 8 0.013815174,0.023783084,2*0./ c c coefficients for trade reduced 04-Sep-1989 (except for priv.serv.) c data vioco/ 1 7*0.,0.090353932,0.032099423,0.00,0.015217504,3*0., 2 0.051239098,0.076955690,2*0., 3 6*0.,0.010920369,0.035135101,0.00,0.024119772, 4 0.000474799,3*0.,0.062109967,0.192512795,2*0., 5 7*0.,0.005902807,0.025147577,0.15,0.152987832,3*0., 6 0.056103865,0.039967798,2*0., 7 7*0.,0.004660954,0.003015911,0.008499386,0.011515297,3*0., 8 0.013815174,0.023783084,2*0./ c data vfoodx /77*0./ c c data vginv /7*0.,0.014379572,0.700118419,0.010315780,0.010315780, c 1 5*0.,0.097945011,0.166925440/ data vginv /7*0.,0.014379572,0.700118419,0.0,0.010315780, 2 5*0.,0.097945011,0.166925440/ c data vhinv /7*0.,.0096,.6762,.0115,.0096,5*0., 3 .1437,.1494/ c c c data vcprin / c 1 7*0.,0.099976140,0.411891159,0.019758130,0.021997385,5*0., c 2 0.174292362,0.272084823, c 3 7*0.,0.075016835,0.570333468,0.010276279,0.016544809,5*0., c 4 0.036747288,0.291081322, c 5 7*0.,0.106101175,0.307233179,0.014677536,0.023384550,5*0., c 6 0.125421141,0.423182420, c 7 7*0.,0.066773678,0.890986127,0.009251775,0.014682164,5*0., c 8 0.006973810,0.011332446/ data vcprin / 1 7*0.,0.099976140,0.411891159,0.0,0.021997385,5*0., 2 0.174292362,0.272084823, 3 7*0.,0.075016835,0.570333468,0.0,0.016544809,5*0., 4 0.036747288,0.291081322, 5 7*0.,0.106101175,0.307233179,0.0,0.023384550,5*0., 6 0.125421141,0.423182420, 7 7*0.,0.066773678,0.890986127,0.0,0.014682164,5*0., 8 0.006973810,0.011332446/ c c data viinv / 7*0.,0.008955829,0.635936158,0.047769029,0.047769029, c 1 5*0.,0.097237744,0.162332212/ data viinv / 7*0.,0.008955829,0.635936158,0.0,0.047769029, 2 5*0.,0.097237744,0.162332212/ data vconv / 7*0.,0.000000000,0.645525114,0.000000000,0.107587519, 3 5*0.,0.135751921,0.111135446/ c data vtinv / 7*0.,0.010031444,0.708291435,0.012038159,0.010031444, c 4 5*0.,0.096050593,0.163556924/ data vtinv / 7*0.,0.010031444,0.708291435,0.0,0.010031444, 5 5*0.,0.096050593,0.163556924/ data vgsnv / 7*0.,0.021111243,0.833927045,0.000000000,0.000000000, 6 5*0.,0.078240458,0.066721254/ c c do 71 i=1,11 px(i,3) = px(i,8) + cbet(i+7) * pt(7) px(i,7) = px(i,8) + cbet(i+7) * pt(8) px(i,10) = px(i,8) + cbet(i+7) * pt(12) px(i,4) = px(i,7) + cbet(i+7) * pt(4) px(i,1) = px(i,3) + cbet(i+7) * pt(1) px(i,6) = px(i,3) + cbet(i+7) * pt(3) px(i,5) = px(i,6) + cbet(i+7) * pt(5) px(i,2) = px(i,5) + cbet(i+7) * pt(2) px(i,9) = px(i,6) + cbet(i+7) * pt(10) 71 continue c c vioco(1,1) = (35./113.)*529./(11098.-793.) vioco(2,1) = (63./113.)*529./(11098.-793.) vioco(3,1) = (15./113.)*529./(11098.-793.) vioco(4,1) = 0. vioco(5,1) = 0. vioco(6,1) = (53.3/718.5)*3082./(11098.-793.) vioco(7,1) = (665.2/718.5)*3082./(11098.-793.) c c xxx = ((2834.-23.)/(2834.-23.+752.-8.)) * (3866.-57.) do 1 j=1,4 vfoodx(1,j) = (14./18.)*21. / xxx vfoodx(2,j) = (5./6.)*7. / xxx vfoodx(3,j) = (7./9.)*10. / xxx vfoodx(8,j) = (19./25.)*42. / xxx vfoodx(9,j) = (19./25.)*15. / xxx vxlab(j) = (38./50.)*51. / xxx 1 continue c xxx = ( (752. - 8.)/(2834.-23.+752.-8.) ) * (3866.-57.) vxlab(5) = (12./50.)*51. / xxx vfoodx(1,5) = (4./18.)*21. / xxx vfoodx(2,5) = (1./6.)*7. / xxx vfoodx(3,5) = (2./9.)*10. / xxx vfoodx(8,5) = (6./25.)*42. / xxx vfoodx(9,5) = (6./25.)*15. / xxx c c vgcser(1) = (245./249.)*202. / (4915.-27.) vgcser(2) = 0. vgcser(3) = 0. vgcser(4) = 0. vgcser(5) = (4./249.)*202. / (4915.-27.) vgcser(6) = 0. vgcser(7) = 0. vgcser(8) = 220. / (4915.-27.) vgcser(9) = 37. / (4915.-27.) c vgcser(10) = 137. / (4915.-27.) vgcser(10) = 0. vgcser(11) = 75. / (4915.-27.) vgcser(12) = 0. vgcser(13) = 0. vgcser(14) = 0. vgcser(15) = 100. / (4915.-27.) vgcser(16) = 205. / (4915.-27.) vgcser(17) = 0. vgcser(18) = 0. c c vglabc = 3911. / (4915.-27.) c do 9 i=1,12 9 qx(i) = px(i,8) c qx(13) = px(13,9) qx(15) = px(15,9) qx(17) = px(17,9) qx(14) = px(14,10) qx(16) = px(16,10) qx(18) = px(18,10) c do 2 j=1,4 p = px(j+7,8)*(1.-avlota(j+7))/ 1 (1.+avinta(15)*vioco(15,j)+avrota(16)*vioco(16,j)) do 21 i = 1,7 ioco(i,j) = p * vioco(i,j)/pr(i,8) 21 continue c do 22 i = 8,18 22 ioco(i,j) = p * vioco(i,j) / qx(i) c c 2 continue c c do 3 j=1,5 p = px(j,8)*(1-avlota(j))/ 1 (1.+avinta(15)*vfoodx(8,j)+avrota(16)*vfoodx(9,j)) do 31 i = 1,11 31 ufoodx(i,j) = vfoodx(i,j) * p / qx(i+7) c uxlab(j) = vxlab(j) * p/(pwaurb*swage(1)) c 3 continue c do 4 i=1,18 gcser(i) = vgcser(i) / 1 ( (1+avinta(15)*vgcser(15)+avrota(16)*vgcser(16))*qx(i) ) ginv(i) = vginv(i) / 2 ( (1+avinta(17)*vginv(17)+avrota(18)*vginv(18)) * qx(i) ) gsnv(i) = vgsnv(i) / 3 ( (1+avinta(17)*vgsnv(17)+avrota(18)*vgsnv(18)) * qx(i) ) iinv(i) = viinv(i) / 4 ( (1+avinta(17)*viinv(17)+avrota(18)*viinv(18)) * qx(i) ) tinv(i) = vtinv(i) / 5 ( (1+avinta(17)*vtinv(17)+avrota(18)*vtinv(18)) * qx(i) ) conv(i) = vconv(i) / 6 ( (1+avinta(17)*vconv(17)+avrota(18)*vconv(18)) * qx(i) ) hinv(i) = vhinv(i) / 7 ( (1+avinta(17)*vhinv(17)+avrota(18)*vhinv(18)) * qx(i) ) c 4 continue c c do 5 j = 1,4 p = ( 1 + avinta(17)*vcprin(17,j)+avrota(18)*vcprin(18,j) ) do 51 i = 1,18 51 cuprin(i,j) = p * vcprin(i,j) / qx(i) 5 continue c c glabco = vglabc / 1 ( (1 + avinta(15)*vgcser(15)+avrota(16)*vgcser(16))* 2 pwaurb*swage(5) ) c c c ------------------------------------------- c c DO 1717 I = 1,7 GOIOOL(I) = 0. 1717 CONTINUE C GOIROL(1) = (2.81/490)*2759 GOIROL(2) = (40.72/490)*2759 GOIROL(3) = (68.80/490)*2759 GOIROL(4) = (4.21/490)*2759 GOIROL(5) = (162.86/490)*2759 GOIROL(6) = (103.90/490)*2759 GOIROL(7) = (106.70/490)*2759 C DR(1,8,10) = 0./PR(1,8) DR(2,8,10) = 0./PR(2,8) DR(3,8,10) = 0./PR(3,8) DR(4,8,10) = 0./PR(4,8) DR(5,8,10) = (2.41/189.63)*353/68.576 DR(6,8,10) = (187.22/189.63)*353/3.747 DR(7,8,10) = 0./PR(7,8) C DX(1,6,9) = (17.84671/378.36731)*314/9.935 DX(2,6,9) = 0./PX(1,6) DX(3,6,9) = (248.4906/378.36731)*314/8.250 DX(4,6,9) = (18.03/378.36731)*314/8.202 DX(5,6,9) = (94./378.36731)*314/68.936 DX(6,6,9) = 0./PX(6,6) DX(7,6,9) = 0./PX(7,6) C DX(1,8,10) = (106.93/107.93)*1315/9.575 DX(5,8,10) = (1./107.93)*1315/68.576 C DX( 8,6,9) = 8204./5.198 DX(11,6,9) = 1924./2.972 DX(10,6,9) = 1973./2.345 DX( 8,8,10) = 749./5.028 DX(10,8,10) = 1538./2.275 DX(11,8,10) = 2774./2.981 C DTR(12,10) = CBET(1)*DR(1,8,10)+CBET(5)*DR(5,8,10)+ 1 CBET(6)*DR(6,8,10)+CBET(8)*DX(1,8,10)+CBET(15)*DX(8,8,10)+ 2 CBET(17)*DX(10,8,10)+CBET(18)*DX(11,8,10) C DTR(10,9) = CBET(8)*DX(1,6,9)+CBET(10)*DX(3,6,9)+ 1 CBET(11)*DX(4,6,9)+CBET(15)*DX(8,6,9)+CBET(18)*DX(11,6,9) XTR = 0.0 C DMANR(1) = (36/43.12)*5.256394 /5.395 DMANR(2) = (36/43.12)*11.62070 /5.666 DMANR(3) = (36/43.12)*7.492198 /5.080 DMANR(4) = (36/43.12)*18.75339 /5.398 DMANR(5) = (81/27.87)*9.023821 /5.417 DMANR(6) = (81/27.87)*15.66232 /5.198 DMANR(7) = (81/27.87)*3.191157 /5.179 C C UPRINV(1) = 2954. / PUPRIN(1) UPRINV(2) = 1371./ PUPRIN(2) UPRINV(3) = 2077./ PUPRIN(3) UPRINV(4) = 8287. / PUPRIN(4) C poisoc = 0. poitra = 0. poicon = 0. poiind = 0. c do 135 i=1,7 poisoc = poisoc + pr(i,8) * gsnv(i) poitra = poitra + pr(i,8) * tinv(i) poicon = poicon + pr(i,8) * conv(i) poiind = poiind + pr(i,8) * iinv(i) 135 continue c do 136 i=8,18 poisoc = poisoc + px(i,8) * gsnv(i) poitra = poitra + px(i,8) * tinv(i) poicon = poicon + px(i,8) * conv(i) poiind = poiind + px(i,8) * iinv(i) 136 continue GOISOC = 1271. / poiSOC GOITRA = 2266./ poiTRA GOICON = 90. / poiCON GOIIND = 2193./ poIIND C DO 201 I = 1,7 PGNV(I) = 0. PHNV(I) = 0. DO 202 J = 1,18 PGNV(I) = PGNV(I) + GINV(J)*PX(J,I) 202 CONTINUE GOIRUR(I) = GOIROL(I) / PGNV(I) 201 CONTINUE C c c Food to Cash deliveries distributed over regions according to LSU number c See i-o table 86/87. c Distribution within Food sectors according to gross production value. c tlsu = 0. do 91 i=1,7 tlsu = tlsu + grqr(7,i) 91 continue c do 200 i=1,7 vfdr(i) = ( grqr(7,i) / tlsu ) * 667. tpv(i) = pr(1,i) * grqr(1,i) + pr(2,i) * grqr(2,i) + 1 pr(3,i) * grqr(3,i) + pr(4,i) * grqr(4,i) do 2011 j=1,4 fdr(j,i) = grqr(j,i) * vfdr(i) / tpv(i) 2011 continue 200 continue c c RETURN END C file 27 BLOCK DATA INICOEBD c c c version 28-Aug-1989 c IMPLICIT REAL (A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' C DATA CBET/1.,1.,1.,1.,1.,2.19,20.,1.,1.,1.,1.,1.,2.19,20., 1 .5,.5,0.2,0.,0.,.33,.33,.33,.33,.33,.33 / C DATA CINV/126*0.0/ C c c 0.2586 food c 0.2389 cash c 0.1539 man c 0.0432 mill c c 0.1500 trade c 0.0135 p.svc c c c 0.8581 c 0.1419 c 0.0516 india c 0.0902 row c c 1.0000 c c c DATA CODEM /.1048,.042,.056,.099,10*0.0,5*.95, 0.0, 0.0, 0.0 1 ,.1258,.021,.065,.090,10*0.0,5*.9, 0.0, 0.0, 0.0 2 ,.1258,.021,.065,.090,10*0.0,5*.9, 0.0, 0.0, 0.0 3 ,.1258,.021,.065,.090,10*0.0,5*.9, 0.0, 0.0, 0.0 4 ,.204,.0228,.026,.049,10*0.0,5*.9, 0.0, 0.0, 0.0 5 ,.204,.0228,.026,.049,10*0.0,5*.9, 0.0, 0.0, 0.0 6 ,.204,.0228,.026,.049,10*0.0,5*.9, 0.0, 0.0, 0.0 7 ,.175,.030,.0478,.049,10*0.0,5*.75, 0.0, 0.0, 0.0/ C c DATA CLOSS /.4, .1, .1, .1, 2./ c c no longer used? c c C C DATA UFOODR,UFOODX /49*0. , 77*0./ C DATA UXDEP /.007823,.007823,.007823,.007823,.011111,.0,.0/ C c DATA UX17OS/.270133,.270133,.270133,.270133,.348148,.0,.0/ data ux17os/5*0.15,2*0./ C C DATA CALFUR /0.3463,0.7273,0.6254,0.2140/ c DATA CAURB /108.67468,3.5694555,4.872394,231.79243/ data caurb /88.92, 3.52, 4.58, 226.9/ DATA DELTA /4*0.02/ C C DATA CATR /12*100000./ DATA CALFTR/12*0.33/ C END C C DK INIDAT C SUBROUTINE INICOESR c c c version 28-Aug-1989 c C IMPLICIT REAL (A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' C INTEGER I,J REAL DUM(20) C C DUM(5) = 0.0882 DUM(6) = 0.0 DUM(7) = 0.9118 c C dum(5) to dum(7) are applied to fraction of cash consumption c i.e. .2389 C DUM(8) = 0.15393 DUM(9) = 0.0 DUM(10) = 0.15 DUM(11) = 0.0135 DUM(12) = 0.0 DUM(13) = 0.0516 DUM(14) = 0.0902 C c dum(8) to dum(14) are straight from the i-o table 87 C CINV(8,1) = 1.0 MUINV(1) = 0.1 S1(1) = 0.05 * .1530/.1175 c S2(1) = 0.0852 S2(1) = 0.3 THETA(1) = 0.0274 GAMGOV(1) = 0.056 C DO 100 J=5,7 CODEM(J,1) = DUM(J)*0.2389 100 CONTINUE C DO 101 J=8,14 CODEM(J,1) = DUM(J) 101 CONTINUE C theta(2) = .0763 theta(3) = .034 theta(4) = .0251 c c DO 1 I=2,4 CINV(8,I) = 1.0 MUINV(I) = 0.1 S1(I) = 0.09 * .1530/.1175 c S2(I) = 0.0852 S2(I) = 0.3 GAMGOV(I) = 0.075 C DO 102 J=5,7 CODEM(J,I) = DUM(J)*0.2389 102 CONTINUE C DO 103 J=8,14 CODEM(J,I) = DUM(J) 103 CONTINUE C 1 CONTINUE C theta(5) = .033 theta(6) = .0463 theta(7) = .0386 c c DO 2 I=5,7 CINV(8,I)=0.8 CINV(15,I)=0.2 MUINV(I) = 0.36 S1(I) = 0.14 * .1530/.1175 c S2(I) = 0.067 S2(I) = 0.18 GAMGOV(I) = 0.094 C DO 105 J=5,7 CODEM(J,I) = DUM(J)*0.2389 105 CONTINUE C DO 106 J=8,14 CODEM(J,I) = DUM(J) 106 CONTINUE C 2 CONTINUE C S1(8) = 0.18 THETA(8) = 1. do 8888 j=1,7 8888 theta(8) = theta(8) - theta(j) c c GAMGOV(8)= 0.437 C DO 108 J=5,7 CODEM(J,8) = DUM(J)*0.2389 108 CONTINUE C DO 109 J=8,14 CODEM(J,8) = DUM(J) 109 CONTINUE C UFOODR(1,1) = 1.538461 UFOODR(2,2) = 1.1 UFOODR(3,3) = 1.3 UFOODR(4,4) = 1.1 UFOODR(5,5) = 3.33333 UFOODR(6,6) = 1. UFOODR(7,7) = 1. C C C RETURN END C C BLOCK DATA EXODATBD C DEBUG IMPLICIT REAL(A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' C DATA DR/700*.0/ DATA DX/1800*.0/ DATA DTR/120*.0/ DATA DCONSD/168*0./ DATA PWAURB/0.032210/ DATA PX/180*1./ DATA SR/700*.0/ DATA SX/12*0./ DATA PVTBUD/0./ DATA ST/12*1.E+7/ DATA TAU/7*.0/ C DATA XTR/0./ c c Indian Prices elsewhere initialized C c DATA PT/1., 0.8, 0.375, 0.7, 0.7, 0.5, 0.2, 0.5, 0.1, c 1 0.1, 0.1 ,0.0/ DATA PT/.43,0.34, 0.16, 0.30, 0.30, 0.22, 0.086, 0.22, 0.043, 1 0.043, 0.043 ,0.0/ c c PT: non endogenous in baseyear. These are preliminary values. c c AREA: Old 85/86 data used, scaled to Country total 86/87 c DATA AREA/167607,598563,287952,239184,598035,574598,481061/ C DATA PCH/7*3.990/ c c PCH: price of urea and complex used in 50/50 proportion C DATA PSI/3.69,3.92,4.54,6.15,6.01,6.86,5.80,6.07,5.44, 1 4.71,5.52,8.14,4.61,4.51,5.14,4.34,4.54,4.08, 2 3.53,4.13,6.11/ c c PSI: No data available, used scenario 1 values instead. c C DATA DCHEM/3.067, 1.558, 12.939, 5.753, 12.891, 50.089, 17.602/ c c DCHEM based on 2.3 times nutrient tons in 86/87 (SPBN 1988,p60). c This distributed according to 1984/85 fractions. c Similar procedure for DIMSE (SPBN 88,61) C DATA DIMSE/3.2705e-3, 136.4306e-3, 3.021103e-3, 1 6.1345e-3, 105.8726e-3, 11.09162e-3, 2 15.100e-3, 65.21832e-3, 11.77601e-3, 3 13.739e-3, 427.0336e-3, 19.58784e-3, 4 43.625e-3, 874.8556e-3, 2.113762e-3, 5 17.180e-3, 372.0083e-3, 16.09831e-3, 6 41.948e-3, 216.5806e-3, 8.311337e-3/ c C DATA YGOVTO,YRDTRA,YX17PR,Y811PR/1262.,100.,50.,71./ c c These are arbitrary initial values c c GRQR; For Livestock Data from SPBN 1988 were taken, p.39. c Weigths for conversion to LSU from IDS worksheets,1987. C Belt totals were split according to region totals for Hill, c according to 81/82 values for Terai. c Values for other crops were 1985/86 values scaled to Country c totals in 1986/87 c DATA grqr/ 1 79.2562,67.2652,136.626,197.3694,14.3508,299.7188,0.07511, 2 433.5891,262.279,543.964,249.452,38.435,81.2912, 0.192552, 3 287.913,146.5251,287.894,108.695,31.262,122.4450, 0.088536, 4 197.106,52.482,298.291,171.578,45.977,236.2719, 0.076865, 5 1074.239,335.651,162.6593,34.258,257.058,1152.77,0.0837960, 6 1197.397,322.129,168.561,69.238,153.34,2647.251,0.066119, 7 982.378,112.340,50.619,52.717,24.028,3129.695, 0.061024/ c C DATA EKURB /4*2.44204/ DATA EKTR /12*1./ C DATA PUPRIN /4*1./ DATA SWAGE / .80187,5.2766,1.20639,.21948,.83026/ C C END C C C C SUBROUTINE EXODATSR C IMPLICIT REAL (A-Z) LOGICAL RALLWD C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' C INTEGER I,J REAL VFDR(7),TPV(7) C DTR(12,10) = CBET(1)*DR(1,8,10)+CBET(5)*DR(5,8,10)+ 1 CBET(6)*DR(6,8,10)+CBET(8)*DX(1,8,10)+CBET(15)*DX(8,8,10)+ 2 CBET(17)*DX(10,8,10)+CBET(18)*DX(11,8,10) C DTR(10,9) = CBET(8)*DX(1,6,9)+CBET(10)*DX(3,6,9)+ 1 CBET(11)*DX(4,6,9)+CBET(15)*DX(8,6,9)+CBET(18)*DX(11,6,9) XTR = 0.0 C DO 100 I=1,7 c SLOC(1,I) = 0.15 * GRQR(1,I) c SLOC(2,I) = 0.18 * GRQR(2,I) c SLOC(3,I) = 0.1 * GRQR(3,I) c SLOC(4,I) = 0.1 * GRQR(4,I) c SLOC(5,I) = 0.1 * GRQR(5,I) c 04-Sep-1989 c SLOC(1,I) = 0.05 * GRQR(1,I) SLOC(2,I) = 0.05 * GRQR(2,I) SLOC(3,I) = 0.05 * GRQR(3,I) SLOC(4,I) = 0.05 * GRQR(4,I) SLOC(5,I) = 0.05 * GRQR(5,I) 100 CONTINUE C C RETURN END C SUBROUTINE MODMOJC C IMPLICIT REAL (A-Z) C C INCLUDE'INC.INC' include 'urbblk.for' c COMMON /URBBLK/ CALFUR(4),DLAURB(4),CAURB(4),EKURB(4),SWAGE(5), c 1 IOCO(18,4),UFOODX(11,7),UFOODR(7,7),UXLAB(7),UX17OS(7), c 2 UXDEP(7),DELTA(4),UVDEPR(4),PUPRIN(4),CUPRIN(18,4),UPRINV(4) C C include 'genblk.for' c COMMON /GENBLK/GRQR(7,7),SLOC(5,7),DIMSE(3,7),DCHEM(7),FDR(4,7), c 1 DMANR(7),AREA(7),PT(12),PR(7,9),PX(18,10),YREM(8),YX17PR, c 2 Y811PR,YTRANS(8),NOFHH(8),DX(18,10,10),DR(7,10,10),CBET(25), c 3 SR(7,10,10),SAVE(8),RINV(18,7),CINV(18,7),SX(12),CODEM(22,8), c 4 THETA(8),S1(8),S2(7),MUINV(7),PWAURB,YRDTRA,PVTBUD,CLOSS(5), c 5 DBUD(8),RINVPR(7),DTR(12,10),ST(12),DCONSD(21,8),CVFLAG(8), c 6 rallwd(7,10,10),reserv(100) C C include 'gblk.for' c COMMON /GBLK/GINV(18),HINV(18),GSNV(18),IINV(18),TINV(18), c 1 CONV(18),GOIRUR(7),GOIOTH(7),GOISOC,GOIIND,GOICON,GOITRA, c 2 GCSER(18),TAU(7),AVINTA(18),AVROTA(18),AVLOTA(18),PSI(3,7), c 3 PCH(7),GOIUR1(18),GOIUR2(18),GOVDEM(18),DTPTLO,DTPTFO,GLABCO, c 4 TRSUBS,TROPSS,TRILHH,FORAST,YGOVTO,GAMGOV(8),GOCON(18) C C include 'trblk.for' c COMMON /TRBLK/ CATR(12),CALFTR(12),EKTR(12),DRDTR(12),XTR include 'glblk.for' c COMMON /GLBLK/ GVIRUR,GVISOC,GVIIND,GVITRA,GVICON,GVITOT, c 1 GVCOMM,AGINPT,AVTAX,GOSER,GVBUD,GVSER,IMDUIN,IMDURO, c 2 SAVSPL,PGSVC,LTAX,GOVEMP C C INTEGER I,J REAL VFDR(7),TPV(7),PGNV(7),PHNV(7),GOIROL(7),GOIOOL(7), 1 vioco(18,4),vfoodx(11,7),vxlab(7),vgcser(18),vcprin(18,4), 2 vgsnv(18),viinv(18),vtinv(18),vhinv(18),vconv(18),vglabc, 3 vginv(18),qx(18) C c ----------------------------- C c data vioco/ c 1 7*0.,0.090353932,0.032099423,0.050407983,0.015217504,3*0., c 2 0.051239098,0.076955690,2*0., c 3 6*0.,0.010920369,0.035135101,0.013579242,0.024119772, c 4 0.000474799,3*0.,0.062109967,0.192512795,2*0., c 5 7*0.,0.005902807,0.025147577,0.231422397,0.152987832,3*0., c 6 0.056103865,0.039967798,2*0., c 7 7*0.,0.004660954,0.003015911,0.008499386,0.011515297,3*0., c 8 0.013815174,0.023783084,2*0./ c c coefficients for trade reduced 04-Sep-1989 (except for priv.serv.) c data vioco/ 1 7*0.,0.090353932,0.032099423,0.00,0.015217504,3*0., 2 0.051239098,0.076955690,2*0., 3 6*0.,0.010920369,0.035135101,0.00,0.024119772, 4 0.000474799,3*0.,0.062109967,0.192512795,2*0., 5 7*0.,0.005902807,0.025147577,0.15,0.152987832,3*0., 6 0.056103865,0.039967798,2*0., 7 7*0.,0.004660954,0.003015911,0.008499386,0.011515297,3*0., 8 0.013815174,0.023783084,2*0./ c data vfoodx /77*0./ c c data vginv /7*0.,0.014379572,0.700118419,0.010315780,0.010315780, c 1 5*0.,0.097945011,0.166925440/ data vginv /7*0.,0.014379572,0.700118419,0.0,0.010315780, 2 5*0.,0.097945011,0.166925440/ c data vhinv /7*0.,.0096,.6762,.0115,.0096,5*0., 3 .1437,.1494/ c c c data vcprin / c 1 7*0.,0.099976140,0.411891159,0.019758130,0.021997385,5*0., c 2 0.174292362,0.272084823, c 3 7*0.,0.075016835,0.570333468,0.010276279,0.016544809,5*0., c 4 0.036747288,0.291081322, c 5 7*0.,0.106101175,0.307233179,0.014677536,0.023384550,5*0., c 6 0.125421141,0.423182420, c 7 7*0.,0.066773678,0.890986127,0.009251775,0.014682164,5*0., c 8 0.006973810,0.011332446/ data vcprin / 1 7*0.,0.099976140,0.411891159,0.0,0.021997385,5*0., 2 0.174292362,0.272084823, 3 7*0.,0.075016835,0.570333468,0.0,0.016544809,5*0., 4 0.036747288,0.291081322, 5 7*0.,0.106101175,0.307233179,0.0,0.023384550,5*0., 6 0.125421141,0.423182420, 7 7*0.,0.066773678,0.890986127,0.0,0.014682164,5*0., 8 0.006973810,0.011332446/ c c data viinv / 7*0.,0.008955829,0.635936158,0.047769029,0.047769029, c 1 5*0.,0.097237744,0.162332212/ data viinv / 7*0.,0.008955829,0.635936158,0.0,0.047769029, 2 5*0.,0.097237744,0.162332212/ data vconv / 7*0.,0.000000000,0.645525114,0.000000000,0.107587519, 3 5*0.,0.135751921,0.111135446/ c data vtinv / 7*0.,0.010031444,0.708291435,0.012038159,0.010031444, c 4 5*0.,0.096050593,0.163556924/ data vtinv / 7*0.,0.010031444,0.708291435,0.0,0.010031444, 5 5*0.,0.096050593,0.163556924/ data vgsnv / 7*0.,0.021111243,0.833927045,0.000000000,0.000000000, 6 5*0.,0.078240458,0.066721254/ c c do 71 i=1,11 px(i,3) = px(i,8) + cbet(i+7) * pt(7) px(i,7) = px(i,8) + cbet(i+7) * pt(8) px(i,10) = px(i,8) + cbet(i+7) * pt(12) px(i,4) = px(i,7) + cbet(i+7) * pt(4) px(i,1) = px(i,3) + cbet(i+7) * pt(1) px(i,6) = px(i,3) + cbet(i+7) * pt(3) px(i,5) = px(i,6) + cbet(i+7) * pt(5) px(i,2) = px(i,5) + cbet(i+7) * pt(2) px(i,9) = px(i,6) + cbet(i+7) * pt(10) 71 continue c c vioco(1,1) = (35./113.)*529./(11098.-793.) vioco(2,1) = (63./113.)*529./(11098.-793.) vioco(3,1) = (15./113.)*529./(11098.-793.) vioco(4,1) = 0. vioco(5,1) = 0. vioco(6,1) = (53.3/718.5)*3082./(11098.-793.) vioco(7,1) = (665.2/718.5)*3082./(11098.-793.) c c xxx = ((2834.-23.)/(2834.-23.+752.-8.)) * (3866.-57.) do 1 j=1,4 vfoodx(1,j) = (14./18.)*21. / xxx vfoodx(2,j) = (5./6.)*7. / xxx vfoodx(3,j) = (7./9.)*10. / xxx vfoodx(8,j) = (19./25.)*42. / xxx vfoodx(9,j) = (19./25.)*15. / xxx vxlab(j) = (38./50.)*51. / xxx 1 continue c xxx = ( (752. - 8.)/(2834.-23.+752.-8.) ) * (3866.-57.) vxlab(5) = (12./50.)*51. / xxx vfoodx(1,5) = (4./18.)*21. / xxx vfoodx(2,5) = (1./6.)*7. / xxx vfoodx(3,5) = (2./9.)*10. / xxx vfoodx(8,5) = (6./25.)*42. / xxx vfoodx(9,5) = (6./25.)*15. / xxx c c vgcser(1) = (245./249.)*202. / (4915.-27.) vgcser(2) = 0. vgcser(3) = 0. vgcser(4) = 0. vgcser(5) = (4./249.)*202. / (4915.-27.) vgcser(6) = 0. vgcser(7) = 0. vgcser(8) = 220. / (4915.-27.) vgcser(9) = 37. / (4915.-27.) c vgcser(10) = 137. / (4915.-27.) vgcser(10) = 0. vgcser(11) = 75. / (4915.-27.) vgcser(12) = 0. vgcser(13) = 0. vgcser(14) = 0. vgcser(15) = 100. / (4915.-27.) vgcser(16) = 205. / (4915.-27.) vgcser(17) = 0. vgcser(18) = 0. c c vglabc = 3911. / (4915.-27.) c do 9 i=1,12 9 qx(i) = px(i,8) c qx(13) = px(13,9) qx(15) = px(15,9) qx(17) = px(17,9) qx(14) = px(14,10) qx(16) = px(16,10) qx(18) = px(18,10) c do 2 j=1,4 p = px(j+7,8)*(1.-avlota(j+7))/ 1 (1.+avinta(15)*vioco(15,j)+avrota(16)*vioco(16,j)) do 21 i = 1,7 ioco(i,j) = p * vioco(i,j)/pr(i,8) 21 continue c do 22 i = 8,18 22 ioco(i,j) = p * vioco(i,j) / qx(i) c c 2 continue c c do 3 j=1,5 p = px(j,8)*(1-avlota(j))/ 1 (1.+avinta(15)*vfoodx(8,j)+avrota(16)*vfoodx(9,j)) do 31 i = 1,11 31 ufoodx(i,j) = vfoodx(i,j) * p / qx(i+7) c uxlab(j) = vxlab(j) * p/(pwaurb*swage(1)) c 3 continue c do 4 i=1,18 gcser(i) = vgcser(i) / 1 ( (1+avinta(15)*vgcser(15)+avrota(16)*vgcser(16))*qx(i) ) ginv(i) = vginv(i) / 2 ( (1+avinta(17)*vginv(17)+avrota(18)*vginv(18)) * qx(i) ) gsnv(i) = vgsnv(i) / 3 ( (1+avinta(17)*vgsnv(17)+avrota(18)*vgsnv(18)) * qx(i) ) iinv(i) = viinv(i) / 4 ( (1+avinta(17)*viinv(17)+avrota(18)*viinv(18)) * qx(i) ) tinv(i) = vtinv(i) / 5 ( (1+avinta(17)*vtinv(17)+avrota(18)*vtinv(18)) * qx(i) ) conv(i) = vconv(i) / 6 ( (1+avinta(17)*vconv(17)+avrota(18)*vconv(18)) * qx(i) ) hinv(i) = vhinv(i) / 7 ( (1+avinta(17)*vhinv(17)+avrota(18)*vhinv(18)) * qx(i) ) c 4 continue c c do 5 j = 1,4 p = ( 1 + avinta(17)*vcprin(17,j)+avrota(18)*vcprin(18,j) ) do 51 i = 1,18 51 cuprin(i,j) = p * vcprin(i,j) / qx(i) 5 continue c c glabco = vglabc / 1 ( (1 + avinta(15)*vgcser(15)+avrota(16)*vgcser(16))* 2 pwaurb*swage(5) ) c c c ------------------------------------------- c c DO 1717 I = 1,7 GOIOOL(I) = 0. 1717 CONTINUE C GOIROL(1) = (2.81/490)*2759 GOIROL(2) = (40.72/490)*2759 GOIROL(3) = (68.80/490)*2759 GOIROL(4) = (4.21/490)*2759 GOIROL(5) = (162.86/490)*2759 GOIROL(6) = (103.90/490)*2759 GOIROL(7) = (106.70/490)*2759 C DR(1,8,10) = 0./PR(1,8) DR(2,8,10) = 0./PR(2,8) DR(3,8,10) = 0./PR(3,8) DR(4,8,10) = 0./PR(4,8) DR(5,8,10) = (2.41/189.63)*353/75.433 DR(6,8,10) = (187.22/189.63)*353/4.121 DR(7,8,10) = 0./PR(7,8) C DX(1,6,9) = (17.84671/378.36731)*314/10.929 DX(2,6,9) = 0./PX(1,6) DX(3,6,9) = (248.4906/378.36731)*314/9.075 DX(4,6,9) = (18.03/378.36731)*314/9.022 DX(5,6,9) = (94./378.36731)*314/75.829 DX(6,6,9) = 0./PX(6,6) DX(7,6,9) = 0./PX(7,6) C DX(1,8,10) = (106.93/107.93)*1315/10.533 DX(5,8,10) = (1./107.93)*1315/75.433 C DX( 8,6,9) = 10177./5.717 DX(11,6,9) = 1959./3.269 DX(10,6,9) = 2009./2.580 DX( 8,8,10) = 930./5.530 DX(10,8,10) = 1568./2.503 DX(11,8,10) = 2825./3.279 C DTR(12,10) = CBET(1)*DR(1,8,10)+CBET(5)*DR(5,8,10)+ 1 CBET(6)*DR(6,8,10)+CBET(8)*DX(1,8,10)+CBET(15)*DX(8,8,10)+ 2 CBET(17)*DX(10,8,10)+CBET(18)*DX(11,8,10) C DTR(10,9) = CBET(8)*DX(1,6,9)+CBET(10)*DX(3,6,9)+ 1 CBET(11)*DX(4,6,9)+CBET(15)*DX(8,6,9)+CBET(18)*DX(11,6,9) XTR = 0.0 C DMANR(1) = (36/43.12)*5.256394 /5.935 DMANR(2) = (36/43.12)*11.62070 /6.233 DMANR(3) = (36/43.12)*7.492198 /5.588 DMANR(4) = (36/43.12)*18.75339 /5.938 DMANR(5) = (81/27.87)*9.023821 /5.959 DMANR(6) = (81/27.87)*15.66232 /5.717 DMANR(7) = (81/27.87)*3.191157 /5.696 C C UPRINV(1) = 3179. / PUPRIN(1) UPRINV(2) = 1475./ PUPRIN(2) UPRINV(3) = 2236./ PUPRIN(3) UPRINV(4) = 8919. / PUPRIN(4) C poisoc = 0. poitra = 0. poicon = 0. poiind = 0. c do 135 i=1,7 poisoc = poisoc + pr(i,8) * gsnv(i) poitra = poitra + pr(i,8) * tinv(i) poicon = poicon + pr(i,8) * conv(i) poiind = poiind + pr(i,8) * iinv(i) 135 continue c do 136 i=8,18 poisoc = poisoc + px(i,8) * gsnv(i) poitra = poitra + px(i,8) * tinv(i) poicon = poicon + px(i,8) * conv(i) poiind = poiind + px(i,8) * iinv(i) 136 continue GOISOC = 1368. / poiSOC GOITRA = 2546./ poiTRA GOICON = 97. / poiCON GOIIND = 2360./ poIIND C DO 201 I = 1,7 PGNV(I) = 0. PHNV(I) = 0. DO 202 J = 1,18 PGNV(I) = PGNV(I) + GINV(J)*PX(J,I) 202 CONTINUE GOIRUR(I) = GOIROL(I) / PGNV(I) 201 CONTINUE C c c Food to Cash deliveries distributed over regions according to LSU number c See i-o table 86/87. c Distribution within Food sectors according to gross production value. c tlsu = 0. do 91 i=1,7 tlsu = tlsu + grqr(7,i) 91 continue c do 200 i=1,7 vfdr(i) = ( grqr(7,i) / tlsu ) * 667. tpv(i) = pr(1,i) * grqr(1,i) + pr(2,i) * grqr(2,i) + 1 pr(3,i) * grqr(3,i) + pr(4,i) * grqr(4,i) do 2011 j=1,4 fdr(j,i) = grqr(j,i) * vfdr(i) / tpv(i) 2011 continue 200 continue c c RETURN END C file 28 SUBROUTINE SHADJS(IREG) C IMPLICIT REAL (A-Z) C C include 'urbblk.for' c COMMON /URBBLK/ CALFUR(4),DLAURB(4),CAURB(4),EKURB(4),SWAGE(5), c 1 IOCO(18,4),UFOODX(11,7),UFOODR(7,7),UXLAB(7),UX17OS(7), c 2 UXDEP(7),DELTA(4),UVDEPR(4),PUPRIN(4),CUPRIN(18,4),UPRINV(4) C C include 'genblk.for' c COMMON /GENBLK/GRQR(7,7),SLOC(5,7),DIMSE(3,7),DCHEM(7),FDR(4,7), c 1 DMANR(7),AREA(7),PT(12),PR(7,9),PX(18,10),YREM(8),YX17PR, c 2 Y811PR,YTRANS(8),NOFHH(8),DX(18,10,10),DR(7,10,10),CBET(25), c 3 SR(7,10,10),SAVE(8),RINV(18,7),CINV(18,7),SX(12),CODEM(22,8), c 4 THETA(8),S1(8),S2(7),MUINV(7),PWAURB,YRDTRA,PVTBUD,CLOSS(5), c 5 DBUD(8),RINVPR(7),DTR(12,10),ST(12),DCONSD(21,8),CVFLAG(8) c 6 ,RALLWD(7,10,10),RESERV(100) C C include 'gblk.for' c COMMON /GBLK/GINV(18),HINV(18),GSNV(18),IINV(18),TINV(18), c 1 CONV(18),GOIRUR(7),GOIOTH(7),GOISOC,GOIIND,GOICON,GOITRA, c 2 GCSER(18),TAU(7),AVINTA(18),AVROTA(18),AVLOTA(18),PSI(3,7), c 3 PCH(7),GOIUR1(18),GOIUR2(18),GOVDEM(18),DTPTLO,DTPTFO,GLABCO, c 4 TRSUBS,TROPSS,TRILHH,FORAST,YGOVTO,GAMGOV(8),GOCON(18) C include 'trblk.for' c COMMON /TRBLK/ CATR(12),CALFTR(12),EKTR(12),DRDTR(12),XTR include 'glblk.for' c COMMON /GLBLK/ GVIRUR,GVISOC,GVIIND,GVITRA,GVICON,GVITOT, c 1 GVCOMM,AGINPT,AVTAX,GOSER,GVBUD,GVSER,IMDUIN,IMDURO, c 2 SAVSPL,PGSVC,LTAX,GOVEMP C C include 'blnblk.for' c COMMON XPRCN,SLAURB,IPRSVC,IPRTRA,SHRSR(7,10,10),SHRDR(7,10,10), c 1 SHRDX(18,10,10) C C INTEGER I,J,K,IREG C REAL P1,P2,P3,PHULP,SH1,SH2,SH3,SHULP,FRC,SHFT,SHFTX C SHFTX = 0.6 C IF (IREG.EQ.3) THEN C DO 1 I=1,7 C C C ADJUST SHRDR C P1 = PR(I,6)+CBET(I)*PT(3) P2 = PR(I,8)+CBET(I)*PT(7) SHFT = MAX(1.,P1,P2) * SHFTX SH1 = SHRDR(I,6,3) SH2 = SHRDR(I,8,3) FRC = ABS(P1-P2)/(SHFT+ABS(P1-P2)) IF (P1.LT.P2) THEN SH1 = (1-FRC) * SH1 + FRC ELSE SH1 = (1-FRC) * SH1 ENDIF SH2 = 1 - SH1 SHRDR(I,6,3) = SH1 SHRDR(I,8,3) = SH2 c C C ADJUST SHRSR C P1 = MAX(PR(I,6)-CBET(I)*PT(3),0.) P2 = MAX(PR(I,8)-CBET(I)*PT(7),0.) SHFT = MAX(1.,P1,P2) * SHFTX SH1 = SHRSR(I,3,6) SH2 = SHRSR(I,3,8) FRC = ABS(P1-P2)/(SHFT+ABS(P1-P2)) IF (P1.GT.P2) THEN SH1 = (1-FRC) * SH1 + FRC ELSE SH1 = (1-FRC) * SH1 ENDIF SH2 = 1 - SH1 SHRSR(I,3,6) = SH1 SHRSR(I,3,8) = SH2 C C 1 CONTINUE C C ADJUST SHRDX C C DO 2 I=1,18 C P1 = PX(I,6)+CBET(I+7)*PT(3) P2 = PX(I,8)+CBET(I+7)*PT(7) SHFT = MAX(1.,P1,P2) * SHFTX SH1 = SHRDX(I,6,3) SH2 = SHRDX(I,8,3) FRC = ABS(P1-P2)/(SHFT+ABS(P1-P2)) IF (P1.LT.P2) THEN SH1 = (1-FRC) * SH1 + FRC ELSE SH1 = (1-FRC) * SH1 ENDIF SH2 = 1 - SH1 SHRDX(I,6,3) = SH1 SHRDX(I,8,3) = SH2 C 2 CONTINUE C ELSE IF (IREG .EQ. 8) THEN C DO 3 I=1,7 C C C ADJUST SHRDR C P1 = PR(I,7)+CBET(I)*PT(8) P2 = PR(I,3)+CBET(I)*PT(7) SHFT = MAX(1.,P1,P2) * SHFTX SH1 = SHRDR(I,7,8) SH2 = SHRDR(I,3,8) FRC = ABS(P1-P2)/(SHFT+ABS(P1-P2)) IF (P1.LT.P2) THEN SH1 = (1-FRC) * SH1 + FRC ELSE SH1 = (1-FRC) * SH1 ENDIF SH2 = 1 - SH1 SHRDR(I,7,8) = SH1 SHRDR(I,3,8) = SH2 C C C ADJUST SHRSR C P1 = MAX(PR(I,7)-CBET(I)*PT(8),0.) P2 = MAX(PR(I,3)-CBET(I)*PT(7),0.) SHFT = MAX(1.,P1,P2) * SHFTX SH1 = SHRSR(I,8,7) SH2 = SHRSR(I,8,3) FRC = ABS(P1-P2)/(SHFT+ABS(P1-P2)) IF (P1.GT.P2) THEN SH1 = (1-FRC) * SH1 + FRC ELSE SH1 = (1-FRC) * SH1 ENDIF SH2 = 1 - SH1 SHRSR(I,8,7) = SH1 SHRSR(I,8,3) = SH2 C C 3 CONTINUE C C ADJUST SHRDX C C DO 4 I=13,17,2 C P1 = PX(I,7)+CBET(I+7)*PT(8) P2 = PX(I,3)+CBET(I+7)*PT(7) SHFT = MAX(1.,P1,P2) * SHFTX SH1 = SHRDX(I,7,8) SH2 = SHRDX(I,3,8) FRC = ABS(P1-P2)/(SHFT+ABS(P1-P2)) IF (P1.LT.P2) THEN SH1 = (1-FRC) * SH1 + FRC ELSE SH1 = (1-FRC) * SH1 ENDIF SH2 = 1 - SH1 SHRDX(I,7,8) = SH1 SHRDX(I,3,8) = SH2 C 4 CONTINUE C C ELSE IF (IREG.EQ.6) THEN C DO 5 I=1,7 C C C ADJUST SHRDR C P1 = PR(I,3)+CBET(I)*PT(3) P3 = PR(I,9)+CBET(I)*PT(10) SHFT = MAX(1.,P1,P3) * SHFTX SH1 = SHRDR(I,3,6) SH3 = SHRDR(I,9,6) PHULP = P1 FRC = ABS(P3-PHULP)/(SHFT+ABS(P3-PHULP)) IF (P3.LT.PHULP) THEN SH3 = (1-FRC) * SH3 + FRC ELSE SH3 = (1-FRC) * SH3 ENDIF sh1 = 1 - SH3 SHRDR(I,9,6) = SH3 SHRDR(I,3,6) = SH1 C C C ADJUST SHRSR C P1 = MAX(PR(I,3)-CBET(I)*PT(3),0.) P3 = MAX(PR(I,9)-CBET(I)*PT(10),0.) SHFT = MAX(1.,P1,P3) * SHFTX SH1 = SHRSR(I,6,3) SH3 = SHRSR(I,6,9) FRC = ABS(P3-p1)/(SHFT+ABS(P3-P1)) IF (P3.GT.P1) THEN SH3 = (1-FRC) * SH3 + FRC ELSE SH3 = (1-FRC) * SH3 ENDIF sh1 = 1 - SH3 SHRSR(I,6,9) = SH3 SHRsR(I,6,3) = SH1 C 5 CONTINUE C C ADJUST SHRDX C C C ELSE IF (IREG.EQ.7) THEN C DO 7 I=1,7 C C C ADJUST SHRDR C P1 = PR(I,8)+CBET(I)*PT(8) P3 = PR(I,9)+CBET(I)*PT(11) SHFT = MAX(1.,P1,P2,P3) * SHFTX SH1 = SHRDR(I,8,7) SH3 = SHRDR(I,9,7) FRC = ABS(P3-P1)/(SHFT+ABS(P3-P1)) IF (P3.LT.P1) THEN SH3 = (1-FRC) * SH3 + FRC ELSE SH3 = (1-FRC) * SH3 ENDIF sh1 = 1 - SH3 SHRDR(I,9,7) = SH3 SHRDR(I,8,7) = SH1 C C C ADJUST SHRSR C P1 = MAX(PR(I,8)-CBET(I)*PT(8),0.) P3 = MAX(PR(I,9)-CBET(I)*PT(11),0.) SHFT = MAX(1.,P1,P3) * SHFTX SH1 = SHRSR(I,7,8) SH3 = SHRSR(I,7,9) FRC = ABS(P3-P1)/(SHFT+ABS(P3-P1)) IF (P3.GT.P1) THEN SH3 = (1-FRC) * SH3 + FRC ELSE SH3 = (1-FRC) * SH3 ENDIF sh1 = 1 - SH3 SHRSR(I,7,9) = SH3 SHRsR(I,7,8) = SH1 C 7 CONTINUE C ELSE IF (IREG.EQ.5) THEN C DO 9 I=1,7 C C C ADJUST SHRDR C P1 = PR(I,6)+CBET(I)*PT(5) P2 = PR(I,9)+CBET(I)*PT(9) SHFT = MAX(1.,P1,P2) * SHFTX SH1 = SHRDR(I,6,5) SH2 = SHRDR(I,9,5) FRC = ABS(P1-P2)/(SHFT+ABS(P1-P2)) IF (P1.LT.P2) THEN SH1 = (1-FRC) * SH1 + FRC ELSE SH1 = (1-FRC) * SH1 ENDIF SH2 = 1 - SH1 SHRDR(I,6,5) = SH1 SHRDR(I,9,5) = SH2 C C C ADJUST SHRSR C P1 = MAX(PR(I,6)-CBET(I)*PT(5),0.) P2 = MAX(PR(I,9)-CBET(I)*PT(9),0.) SHFT = MAX(1.,P1,P2) * SHFTX SH1 = SHRSR(I,5,6) SH2 = SHRSR(I,5,9) FRC = ABS(P1-P2)/(SHFT+ABS(P1-P2)) IF (P1.GT.P2) THEN SH1 = (1-FRC) * SH1 + FRC ELSE SH1 = (1-FRC) * SH1 ENDIF SH2 = 1 - SH1 SHRSR(I,5,6) = SH1 SHRSR(I,5,9) = SH2 C C 9 CONTINUE C C ENDIF C RETURN END C file 29 PROGRAM STATS IMPLICIT REAL (A-Z) C C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' include 'glblk.for' include 'blnblk.for' include 'stsblk.for' C REAL BLKURB(328),BLKGEN(5169),BLKG(321),BLKGL(18),BLKTR(49), 1 BLKBLN(4),BLKSTS(4100) C C EQUIVALENCE (CATR(1),BLKTR(1)),(GRQR(1,1),BLKGEN(1)), 1 (GINV(1),BLKG(1)),(GVIRUR,BLKGL(1)),(CALFUR(1),BLKURB(1)), 2 (XPRCN,BLKBLN(1)),(ZPRMAT(1,1,1),BLKSTS(1)) C C C C THIS PROGRAM COMPUTES A NUMBER OF STATISTICS C FROM A SERIES OF SOLUTIONS C C C---------------- C---------------- C C CHARACTER REGEL*80,YTL*2,TEEP*10 REAL ODCNS(21,8),OPX(18,10),OPR(7,10),OSX(12),OGRQR(7,7), 1 ONFHH(8),GRIX(7),BGRIX(7),PRIX(7),BPRIX(7),COCIX(8), 2 BCOCIX(8),V1(30),V2(30),V3(30),V4(30),V5(30),OGOVMP, 3 OPSI(3,7),OPCH(7),OAVTX(18),OPWA,OPT(12) C INTEGER I,J,ITEL,K,N1,N2,IREG,IYRTL,NYR C DO 6116 I=1,4100 6116 BLKSTS(I) = 0. C WRITE(*,*) ' HOW MANY YEARS (1-9) ' READ(*,*) NYR C IYRTL = 1 C CALL UNFRWN(87) C C C DO 99 I=1,8 DO 99 J=1,21 99 ODCNS(J,I) = DCONSD(J,I) C C DO 98 I=1,10 DO 98 J=1,18 98 OPX(J,I) = PX(J,I) C C DO 97 I=1,10 DO 97 J=1,7 97 OPR(J,I) = PR(J,I) C C DO 96 I=1,12 96 OSX(I) = SX(I) C C DO 95 I=1,7 DO 95 J=1,7 95 OGRQR(J,I) = GRQR(J,I) C C DO 94 I=1,8 94 ONFHH(I) = NOFHH(I) C DO 57 I=1,7 DO 57 J=1,3 57 OPSI(J,I) = PSI(J,I) C DO 58 I=1,7 58 OPCH(I) = PCH(I) C DO 59 I=1,18 59 OAVTX(I) = AVLOTA(I) C DO 60 I=1,11 60 OPT(I) = PT(I) C OPWA = PWAURB C WRITE(*,*) ' "BASE YEAR PR-PRICES ' C DO 93 I=1,9 93 WRITE(*,'(7F10.3)') (PR(J,I),J=1,7) WRITE(*,*) C DO 153 J=1,9 DO 153 I=1,7 ZPRMAT(I,J,IYRTL) = PR(I,J) 153 CONTINUE C DO 154 J=1,10 DO 154 I=1,18 ZPXMAT (I,J,IYRTL) = PX(I,J) 154 CONTINUE C C WRITE(*,*) ' "BASE YEAR PX-PRICES ' DO 92 I=1,10 92 WRITE(*,'(3(6F10.3,/))') (PX(J,I),J=1,18) C C CALL BUDGTS(OPX,IYRTL) CALL RLGDP(OPX,OPR,OPCH,OPSI,OAVTX,OPWA,OPT,IYRTL) C WRITE(*,*) ' "SOME BASE YEAR STATISTICS ' WRITE(*,*) ' "URBAN LABOUR AND WAGE' WRITE(*,'(5F13.2,F13.5)') (DLAURB(I),I=1,4),GOVEMP,PWAURB WRITE(*,*) ' "URBAN CAPITAL' WRITE(*,'(4G17.5)') (EKURB(I),I=1,4) C C DO 282 I = 1,4 ZUCAP (I,IYRTL) = EKURB(I) ZEMPL (I,IYRTL) = DLAURB(I) 282 CONTINUE C ZEMPL(5,IYRTL) = GOVEMP ZEMPL(6,IYRTL) = 0. C DO 312 I=1,5 312 ZEMPL(6,IYRTL) = ZEMPL(6,IYRTL) + ZEMPL(I,IYRTL) C ZWAG(1,IYRTL) = PWAURB C DO 291 I=1,4 DO 2911 J=1,7 2911 ZRQUIX(I,J,IYRTL) = 1. ZUQUIX(I,IYRTL) = 1. ZUPIX(I,IYRTL) = 1. ZUCUIX(I,IYRTL) = 1. 291 CONTINUE C C DO 999 ITEL = 88,87+NYR-1 C C IYRTL = IYRTL+1 CALL UNFRWN(ITEL) C WRITE(*,*) ' "YEAR ',ITEL WRITE(*,*) ' "REGION NO , Q , P , C , PC ' C DO 953 J=1,9 DO 953 I=1,7 ZPRMAT(I,J,IYRTL) = PR(I,J) 953 CONTINUE C DO 954 J=1,10 DO 954 I=1,18 ZPXMAT(I,J,IYRTL) = PX(I,J) 954 CONTINUE C DO 11 IREG=1,7 C C CALL CVECTK(7,10,PR,IREG,1,7,V1) CALL CVECTK(7,7,GRQR,IREG,1,7,V2) CALL CVECTK(7,10,OPR,IREG,1,7,V3) CALL CVECTK(7,7,OGRQR,IREG,1,7,V4) C CALL VECVEC(7,V1,V2,QXT) CALL VECVEC(7,V1,V4,QXN) CALL VECVEC(7,V1,V4,PXT) CALL VECVEC(7,V3,V4,PXN) C DO 111 I=1,7 V1(I) = PR(I,IREG) V2(I) = DCONSD(I,IREG) V3(I) = OPR(I,IREG) V4(I) = ODCNS(I,IREG) 111 CONTINUE C DO 112 I=1,14 V1(I+7) = PX(I,IREG) V2(I+7) = DCONSD(I+7,IREG) V3(I+7) = OPX(I,IREG) V4(I+7) = ODCNS(I+7,IREG) 112 CONTINUE C C CALL VECVEC(21,V1,V2,CXT) CALL VECVEC(21,V1,V4,CXN) CALL VECVEC(21,V1,V4,PCT) CALL VECVEC(21,V3,V4,PCN) C ZRQUIX(1,IREG,IYRTL) = QXT/QXN ZRQUIX(2,IREG,IYRTL) = PXT/PXN ZRQUIX(3,IREG,IYRTL) = CXT/CXN ZRQUIX(4,IREG,IYRTL) = PCT/PCN C WRITE(*,'(3X,I4,4F10.4)') 1 IREG,QXT/QXN,PXT/PXN,CXT/CXN,PCT/PCN C 11 CONTINUE C C WRITE(*,*) WRITE(*,*) C C DO 272 I = 1,4 ZUCAP(I,IYRTL) = EKURB(I) ZEMPL(I,IYRTL) = DLAURB(I) 272 CONTINUE C ZEMPL(5,IYRTL) = GOVEMP ZEMPL(6,IYRTL) = 0. C DO 322 I=1,5 322 ZEMPL(6,IYRTL) = ZEMPL(6,IYRTL) + ZEMPL(I,IYRTL) C ZWAG(1,IYRTL) = PWAURB C WRITE(*,*) ' " URBAN REGION ' C WRITE(*,*) ' "URBAN LABOUR AND WAGE' WRITE(*,'(6G15.5)') (DLAURB(I),I=1,4),GOVEMP,PWAURB WRITE(*,*) ' "URBAN CAPITAL' WRITE(*,'(4G17.5,/)') (EKURB(I),I=1,4) C CALL CVECTK(18,10,PX,8,1,14,V1) CALL CVECTK(18,10,OPX,8,1,14,V3) CALL VECVEC(8,V1,SX,QXMT) CALL VECVEC(8,V1,OSX,QXMN) CALL VECVEC(8,V1,OSX,PXMT) CALL VECVEC(8,V3,OSX,PXMN) C CALL VECVEC(11,V1,SX,QURT) CALL VECVEC(11,V1,OSX,QURN) CALL VECVEC(11,V1,OSX,PURT) CALL VECVEC(11,V3,OSX,PURN) C WRITE(*,*) ' " SECTORAL OUTPUT ' C ZUQUIX(1,IYRTL) = QXMT/QXMN ZUQUIX(2,IYRTL) = SX(9)/OSX(9) ZUQUIX(3,IYRTL) = SX(10)/OSX(10) ZUQUIX(4,IYRTL) = SX(11)/OSX(11) ZUPIX(1,IYRTL) = PXMT/PXMN ZUPIX(2,IYRTL) = PX(9,8)/OPX(9,8) ZUPIX(3,IYRTL) = PX(10,8)/OPX(10,8) ZUPIX(4,IYRTL) = PX(11,8)/OPX(11,8) C WRITE(*,'(4G15.4)') QXMT/QXMN,(SX(I)/OSX(I),I=9,11) WRITE(*,*) ' " SECTORAL PRICES ' WRITE(*,'(4G15.4)') PXMT/PXMN,(PX(I,8)/OPX(I,8),I=9,11) C C C DO 211 I=1,7 V1(I) = PR(I,IREG) V2(I) = DCONSD(I,IREG) V3(I) = OPR(I,IREG) V4(I) = ODCNS(I,IREG) 211 CONTINUE C DO 212 I=1,14 V1(I+7) = PX(I,IREG) V2(I+7) = DCONSD(I+7,IREG) V3(I+7) = OPX(I,IREG) V4(I+7) = ODCNS(I+7,IREG) 212 CONTINUE C C CALL VECVEC(21,V1,V2,CXT) CALL VECVEC(21,V1,V4,CXN) CALL VECVEC(21,V1,V4,PCT) CALL VECVEC(21,V3,V4,PCN) WRITE(*,*) ' " URBAN OUTPUT AND PRICES, CONSM AND PRICES ' ZUCUIX(1,IYRTL) = QURT/QURN ZUCUIX(2,IYRTL) = PURT/PURN ZUCUIX(3,IYRTL) = CXT/CXN ZUCUIX(4,IYRTL) = PCT/PCN WRITE(*,'(4G15.4,/)') QURT/QURN,PURT/PURN,CXT/CXN,PCT/PCN C WRITE(*,*) ' "YEAR PR-PRICES ' C DO 193 I=1,9 193 WRITE(*,'(7F10.3)') (PR(J,I),J=1,7) WRITE(*,*) C WRITE(*,*) ' "YEAR PX-PRICES ' DO 192 I=1,10 192 WRITE(*,'(3(6F10.3,/))') (PX(J,I),J=1,18) C C WRITE(*,*) C CALL BUDGTS(OPX,IYRTL) CALL RLGDP(OPX,OPR,OPCH,OPSI,OAVTX,OPWA,OPT,IYRTL) C 999 CONTINUE C OPEN(31,STATUS='NEW') 17 FORMAT(1X,I4,9F10.3) 18 FORMAT(1X,I4,9F10.1) 7 FORMAT(1X,9F10.3) 8 FORMAT(1X,9F10.1) 19 FORMAT(1X,A10,9F10.1) C C WRITE(31,*) 'REGIONAL PRICES PR HOR=YEARS, VER=REGION, GOODS' WRITE(31,*) WRITE(31,*) 'MOUNTAIN REGION' WRITE(31,17) (I,(ZPRMAT(I,1,K),K=1,9),I=1,7) WRITE(31,*) WRITE(31,*) ' HILL-WST REGION ' WRITE(31,17) (I,(ZPRMAT(I,2,K),K=1,9),I=1,7) WRITE(31,*) WRITE(31,*) ' HILL-CNT REGION ' WRITE(31,17) (I,(ZPRMAT(I,3,K),K=1,9),I=1,7) WRITE(31,*) WRITE(31,*) ' HILL-EAST REGION ' WRITE(31,17) (I,(ZPRMAT(I,4,K),K=1,9),I=1,7) WRITE(31,*) WRITE(31,*) ' TERAI WEST REGION' WRITE(31,17) (I,(ZPRMAT(I,5,K),K=1,9),I=1,7) WRITE(31,*) WRITE(31,*) ' TERAI CNT REGION' WRITE(31,17) (I,(ZPRMAT(I,6,K),K=1,9),I=1,7) WRITE(31,*) WRITE(31,*) ' TERAI EAST REGION' WRITE(31,17) (I,(ZPRMAT(I,7,K),K=1,9),I=1,7) WRITE(31,*) WRITE(31,*) ' URBAN REGION' WRITE(31,17) (I,(ZPRMAT(I,8,K),K=1,9),I=1,7) WRITE(31,*) WRITE(31,*) ' INDIA' WRITE(31,17) (I,(ZPRMAT(I,9,K),K=1,9),I=1,7) WRITE(31,*) WRITE(31,*) ' REGIONAL PRICES PX HOR=YEARS, VER=REGION, GOODS' WRITE(31,*) WRITE(31,*) WRITE(31,*) ' MOUNTAIN REGION' WRITE(31,17) (I,(ZPXMAT(I,1,K),K=1,9),I=1,18) WRITE(31,*) WRITE(31,*) ' HILL-WST REGION' WRITE(31,17) (I,(ZPXMAT(I,2,K),K=1,9),I=1,18) WRITE(31,*) WRITE(31,*) ' HILL-CNT REGION' WRITE(31,17) (I,(ZPXMAT(I,3,K),K=1,9),I=1,18) WRITE(31,*) WRITE(31,*) ' HILL-EAST REGION' WRITE(31,17) (I,(ZPXMAT(I,4,K),K=1,9),I=1,18) WRITE(31,*) WRITE(31,*) ' TERAI WEST REGION' WRITE(31,17) (I,(ZPXMAT(I,5,K),K=1,9),I=1,18) WRITE(31,*) WRITE(31,*) ' TERAI CNT REGION' WRITE(31,17) (I,(ZPXMAT(I,6,K),K=1,9),I=1,18) WRITE(31,*) WRITE(31,*) ' TERAI EAST REGION' WRITE(31,17) (I,(ZPXMAT(I,7,K),K=1,9),I=1,18) WRITE(31,*) WRITE(31,*) ' URBAN REGION' WRITE(31,17) (I,(ZPXMAT(I,8,K),K=1,9),I=1,18) WRITE(31,*) WRITE(31,*) ' INDIA' WRITE(31,17) (I,(ZPXMAT(I,9,K),K=1,9),I=1,18) WRITE(31,*) WRITE(31,*) WRITE(31,*) ' GOVERNMENT ACCOUNTS EXPENDITURES' WRITE(31,19) ' GVIRUR ',(ZGEXPM(1,J),J=1,9) WRITE(31,19) ' GVISOC ',(ZGEXPM(2,J),J=1,9) WRITE(31,19) ' GVIIND ',(ZGEXPM(3,J),J=1,9) WRITE(31,19) ' GVITRA ',(ZGEXPM(4,J),J=1,9) WRITE(31,19) ' GVICON ',(ZGEXPM(5,J),J=1,9) WRITE(31,19) ' TRILHH ',(ZGEXPM(6,J),J=1,9) WRITE(31,19) ' TROPSS ',(ZGEXPM(7,J),J=1,9) WRITE(31,19) ' DTPTLO ',(ZGEXPM(8,J),J=1,9) WRITE(31,19) ' DTPTFO ',(ZGEXPM(9,J),J=1,9) WRITE(31,19) ' GVSER ',(ZGEXPM(10,J),J=1,9) WRITE(31,19) ' TTL.EX. ',(ZGEXPM(11,J),J=1,9) WRITE(31,*) WRITE(31,*) 'GOVERNMENT ACCOUNTS RECEIPTS' WRITE(31,19) ' LTAX ', (ZGRECM(1,J),J=1,9) WRITE(31,19) ' IMDUIN ', (ZGRECM(2,J),J=1,9) WRITE(31,19) ' IMDURO ', (ZGRECM(3,J),J=1,9) WRITE(31,19) ' AVTAX ', (ZGRECM(4,J),J=1,9) WRITE(31,19) ' AGINPT ', (ZGRECM(5,J),J=1,9) WRITE(31,19) ' FORAST ', (ZGRECM(6,J),J=1,9) WRITE(31,19) ' NTXREV ', (ZGRECM(7,J),J=1,9) WRITE(31,19) ' SAVSPL ', (ZGRECM(8,J),J=1,9) WRITE(31,19) ' TTL.REC. ', (ZGRECM(9,J),J=1,9) WRITE(31,*) WRITE(31,*) WRITE(31,*) 'REGIONAL SAVINGS, INVESTMENT, NET' DO 31180 I=1,8 WRITE(31,18) (I,(ZRSAV(I,J,K),K=1,9),J=1,3) 31180 WRITE(31,*) C WRITE(31,18) (2,(ZRSAV(2,J,K),K=1,9),J=1,3) C WRITE(31,*) C WRITE(31,18) (3,(ZRSAV(3,J,K),K=1,9),J=1,3) C WRITE(31,*) C WRITE(31,18) (4,(ZRSAV(4,J,K),K=1,9),J=1,3) C WRITE(31,*) C WRITE(31,18) (5,(ZRSAV(5,J,K),K=1,9),J=1,3) C WRITE(31,*) C WRITE(31,18) (6,(ZRSAV(6,J,K),K=1,9),J=1,3) C WRITE(31,*) C WRITE(31,18) (7,(ZRSAV(7,J,K),K=1,9),J=1,3) C WRITE(31,*) C WRITE(31,18) (8,(ZRSAV(8,J,K),K=1,9),J=1,3) C WRITE(31,*) WRITE(31,*) ' REGIONAL INVESTMENTS' WRITE(31,*) ' PRIV/CUR, GOV/CUR, PRIV/CON, GOV/CON' DO 3118 I=1,8 WRITE(31,18) (I,(ZRUINV(I,J,K),K=1,9),J=1,4) 3118 WRITE(31,*) C WRITE(31,18) (2,(ZRUINV(2,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,18) (3,(ZRUINV(3,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,18) (4,(ZRUINV(4,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,18) (5,(ZRUINV(5,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,18) (6,(ZRUINV(6,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,18) (7,(ZRUINV(7,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,18) (8,(ZRUINV(8,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,*) WRITE(31,*) ' URBAN INVESTMENTS BY SECTOR' WRITE(31,*) ' PRIV/CUR, GOV/CUR, PRIV/CON, GOV/CON' WRITE(31,18) (1,(ZURINV(1,J,K),K=1,9),J=1,4) WRITE(31,*) WRITE(31,18) (2,(ZURINV(2,J,K),K=1,9),J=1,4) WRITE(31,*) WRITE(31,18) (3,(ZURINV(3,J,K),K=1,9),J=1,4) WRITE(31,*) WRITE(31,18) (4,(ZURINV(4,J,K),K=1,9),J=1,4) WRITE(31,*) WRITE(31,18) (5,(ZURINV(5,J,K),K=1,9),J=1,4) WRITE(31,*) C WRITE(31,*) WRITE(31,*) ' ROADS NUMBER, CAPACITY, SUPPL, DEMAND, PT' DO 3117 I=1,11 3117 WRITE(31,17) (I,(ZRCAP(I,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,17) (2,(ZRCAP(2,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,17) (3,(ZRCAP(3,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,17) (4,(ZRCAP(4,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,17) (5,(ZRCAP(5,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,17) (6,(ZRCAP(6,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,17) (7,(ZRCAP(7,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,17) (8,(ZRCAP(8,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,17) (9,(ZRCAP(9,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,17) (10,(ZRCAP(10,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,17) (11,(ZRCAP(11,J,K),K=1,9),J=1,4) WRITE(31,*) WRITE(31,*) WRITE(31,*) ' REGIONAL GDP, FACTOR COST, CONSTANT PRICES' WRITE(31,17) (J,(ZRGDP(J,K),K=1,9),J=1,8) WRITE(31,*) WRITE(31,*) WRITE(31,*) ' URBAN GDP BY SECTOR, FACTOR COST, CONST.PRC.' WRITE(31,17) (J,(ZUGDP(J,K),K=1,9),J=1,8) WRITE(31,*) WRITE(31,*) ' GDP AT FACTOR COST, CONSTANT PRICES ' WRITE(31,'(1X,9F10.1)') (ZGDPFC(1,K),K=1,9) WRITE(31,*) WRITE(31,*) WRITE(31,*) ' URBAN EMPLOYMENT BY SECTOR ' WRITE(31,18) (J+7,(ZEMPL(J,K),K=1,9),J=1,5) WRITE(31,18) 0,(ZEMPL(6,K),K=1,9) WRITE(31,*) WRITE(31,*) ' URBAN WAGES' WRITE(31,7) ((ZWAG(J,K),K=1,9),J=1,1) WRITE(31,*) WRITE(31,*) ' URBAN CAPITAL' WRITE(31,17) (J+7,(ZUCAP(J,K),K=1,9),J=1,4) WRITE(31,*) WRITE(31,*) WRITE(31,*) ' INDEXNUMBER OF RURAL' WRITE(31,*) ' 1-OUTP,2-OUT.PRC,3-CONS,4-CONS.PRIC' WRITE(31,17) ((J,(ZRQUIX(J,I,K),K=1,9),J=1,4),I=1,7) WRITE(31,*) WRITE(31,*) ' INDEXNUMBER OF URBAN OUTPUT' WRITE(31,17) (J+7,(ZUQUIX(J,K),K=1,9),J=1,4) WRITE(31,*) WRITE(31,*) ' INDEXNUMBER OF URBAN PRICES ' WRITE(31,17) (J+7,(ZUPIX(J,K),K=1,9),J=1,4 ) WRITE(31,*) WRITE(31,*) ' INDEXNUMBER OF URBAN ' WRITE(31,*) ' 1-OUTP,2-OUT.PRC,3-CONS,4-CONS.PRIC' WRITE(31,17) (J,(ZUCUIX(J,K),K=1,9),J=1,4) WRITE(31,*) CLOSE(31) C STOP ' END OF STATISTICS PROGRAM ' END C file 30 c SUBROUTINE RLGDP(OPX,OPR,OPCH,OPSI,OAVTX,OPWA,OPT,IYRTL) C C GOVERNMENT EXPENDITURE AND RECEIPTS C PRIVATE DOMESTIC INVESTMENT AND SAVING C IMPLICIT REAL (A-Z) C C C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' include 'glblk.for' include 'blnblk.for' include 'stsblk.for' C C REAL YAGR(7),YCOST,DUM(50),OPX(18,10),OPR(7,9), 1 OPCH(7),OPSI(3,7),OAVTX(18),YGOV,YRDTR,YRURAL,YURBAN, 2 FMVADD,CMVADD,SCVADD(4),OPWA,OPT(12) C INTEGER I,J,IYRTL CHARACTER*10 COL1(30),COL2(30) C DATA DUM/50*0./ C YAGR(1) = 27 YAGR(2) = 33 YAGR(3) = 33 YAGR(4) = 33 YAGR(5) = 33 YAGR(6) = 33 YAGR(7) = 34 C C C THIS IS INVESTMENT IN LIVESTOCK PRODUCTS. C IT IS KEPT AT 227 THROUGH ALL THE SIMULATIONS. C C DO 100 I=1,7 C DO 101 J=1,4 101 YAGR(I) = YAGR(I) + OPR(J,I)*(GRQR(J,I)-SLOC(J,I)-FDR(J,I)) C YAGR(I) = YAGR(I) - OPR(5,I) * SLOC(5,I) C DO 102 J=5,7 102 YAGR(I) = YAGR(I) + OPR(J,I)*GRQR(J,I) C YCOST = OPCH(I)*DCHEM(I)+OPX(8,I)*DMANR(I) DO 103 J=1,3 103 YCOST = YCOST + OPSI(J,I)*DIMSE(J,I) C YAGR(I) = YAGR(I) - YCOST C 100 CONTINUE C C C C COMPUTATION OF GDP BY SECTOR C C FMVADD = 0. DO 200 I=1,4 XHLP = OPX(I,8)*(1.-OAVTX(I)) DO 201 J=1,7 201 XHLP = XHLP-OPR(J,8)*UFOODR(J,I)-OPX(J+7,8)*UFOODX(J,I) C DO 202 J=8,11 202 XHLP = XHLP - OPX(J+7,8)*UFOODX(J,I) C FMVADD = FMVADD + SX(I)*XHLP C 200 CONTINUE C CMVADD = 0. DO 300 I=5,7 XHLP = OPX(I,8)*(1.-OAVTX(I)) DO 301 J=1,7 301 XHLP = XHLP-OPR(J,8)*UFOODR(J,I)-OPX(J+7,8)*UFOODX(J,I) C DO 302 J=8,11 302 XHLP = XHLP - OPX(J+7,8)*UFOODX(J,I) C CMVADD = CMVADD + SX(I)*XHLP C 300 CONTINUE C C DO 400 I=1,4 XHLP = OPX(I+7,8)*(1.-OAVTX(I+7)) C DO 401 J=1,7 401 XHLP = XHLP - OPR(J,8)*IOCO(J,I) C DO 402 J=8,18 402 XHLP = XHLP - OPX(J,8)*IOCO(J,I) C SCVADD(I) = XHLP * SX(I+7) C 400 CONTINUE C YRDTRA = 0. DO 500 I=1,11 500 if (i.ne.6) YRDTRA = YRDTRA + OPT(I) * DRDTR(I) C YRDTRA = YRDTRA - OPX(10,8) * XTR C YRURAL = 0. DO 600 I=1,7 600 YRURAL = YRURAL + YAGR(I) C YGOV = SWAGE(5) * OPWA * GOVEMP C YURBAN = FMVADD+CMVADD+YRDTRA+YGOV C DO 356 I=1,7 356 ZRGDP(I,IYRTL) = YAGR(I) C ZRGDP(8,IYRTL) = YRURAL C DO 601 I=1,4 601 YURBAN = YURBAN + SCVADD(I) C WRITE(*,*) ' "RURAL GDP, CONSTANT PRICES ' WRITE(*,'(1X,A10,F10.2)') '"TOTAL ',YRURAL C COL1(1 ) = '"MOUNTN ' COL1(2 ) = '"HILL-W ' COL1(3 ) = '"HILL-C ' COL1(4 ) = '"HILL-E ' COL1(5 ) = '"TERAI-W ' COL1(6 ) = '"TERAI-C ' COL1(7 ) = '"TERAI-E ' C COL1(8 ) = '"URBAN ' C WRITE(*,*) WRITE(*,'(1X,A10,F10.2)') (COL1(I),YAGR(I),I=1,7) WRITE(*,*) WRITE(*,*) ' "URBAN GDP, CONSTANT PRICES' WRITE(*,'(1X,A10,F10.2)') '"TOTAL ',YURBAN WRITE(*,*) COL1(1 ) = '"FOODMILL.' COL1(2 ) = '"CASHMILL.' COL1(3 ) = '"MANUFACT.' COL1(4 ) = '"CONSTR. ' COL1(5 ) = '"TRADE. ' COL1(6 ) = '"PRIV.SVC.' COL1(7 ) = '"GOV.SVC. ' C SCVADD(3) = SCVADD(3) + YRDTRA C WRITE(*,7) COL1(1),FMVADD,COL1(2),CMVADD WRITE(*,7) (COL1(I+2),SCVADD(I),I=1,4) WRITE(*,7) COL1(7),YGOV WRITE(*,*) WRITE(*,7) '"TTL GDP ',YURBAN+YRURAL ZUGDP(1,IYRTL) = FMVADD ZUGDP(2,IYRTL) = CMVADD C 7 FORMAT(1X,A10,F10.2) C DO 338 I=1,4 338 ZUGDP(2+I,IYRTL) = SCVADD(I) C ZUGDP(7,IYRTL) = YGOV ZUGDP(8,IYRTL) = YURBAN ZGDPFC(1,IYRTL) = YURBAN + YRURAL RETURN END c SUBROUTINE VECVEC(N,A,B,C) C C C DOTPRODUCT ROUTINE. THE INNER PRODUCT OF A AND B IS DELIVERED IN C C INTEGER I,N REAL A,B,C DIMENSION A(N),B(N) C C = 0.0 DO 1 I=1,N C = C + A(I) * B(I) 1 CONTINUE RETURN END c SUBROUTINE CVECTK(M1,M2,MAT,COLNO,I1,I2,VEC) C C C C THIS SUBROUTINE TAKES A COLUMN VECTOR OUT OF C A MATRIX. THE DIMENSION OF THE MATRIX IS C (M1,M2), COLNO IS THE COLUMN NUMBER TO BE C TAKEN, I1 BEGINNING INDEX, I2 FINAL INDEX C C INTEGER M1,M2,I1,I2,COLNO,I C REAL MAT(M1,M2),VEC(*) C DO 1 I = I1,I2 VEC(I-I1+1) = MAT(I,COLNO) 1 CONTINUE C RETURN END C file 31 c SUBROUTINE BUDGTS(OPX,IYRTL) C C GOVERNMENT EXPENDITURE AND RECEIPTS C PRIVATE DOMESTIC INVESTMENT AND SAVING C IMPLICIT REAL (A-Z) C C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' include 'glblk.for' include 'blnblk.for' include 'stsblk.for' C C C C REAL SSURPL,VIPR,TOTEXP,TOTREC,DUM(50),OPX(18,10), 1 VEC1(25),OPUPRI(4),OGISOC,OGITRA,OGIIND,OGICON INTEGER I,J,IYRTL CHARACTER*10 COL1(30),COL2(30) C DO 999 I=1,50 999 DUM(I) = 0. C CALL CVECTK(18,10,OPX,8,1,18,VEC1) CALL MGM(1,18,4,VEC1,0,CUPRIN,0,OPUPRI,0) CALL VECVEC(18,VEC1,GSNV,OGISOC) CALL VECVEC(18,VEC1,IINV,OGIIND) CALL VECVEC(18,VEC1,TINV,OGITRA) CALL VECVEC(18,VEC1,CONV,OGICON) C OGISOC=OGISOC*GOISOC OGITRA=OGITRA*GOITRA OGIIND=OGIIND*GOIIND OGICON=OGICON*GOICON C COL1(1) = '"EXPENDITR' COL1(2 ) = '"GVIRUR ' COL1(3 ) = '"GVISOC ' COL1(4 ) = '"GVIIND ' COL1(5 ) = '"GVITRA ' COL1(6 ) = '"GVICON ' COL1(7 ) = '"TRILHH ' COL1(8 ) = '"TROPSS ' COL1(9 ) = '"DTPTLO ' COL1(10) = '"DTPTFO ' COL1(11) = '"GVSER ' COL1(12) = '"TTL.EXP. ' C COL2(1 ) = '"RECEIPTS ' COL2(2 ) = '"LTAX ' COL2(3 ) = '"IMDUIN ' COL2(4 ) = '"IMDURO ' COL2(5 ) = '"AVTAX ' COL2(6 ) = '"AGINPT ' COL2(7 ) = '"FORAST ' COL2(8 ) = '"NTXREV ' COL2(9 ) = '"SAVSPL ' COL2(10) = '"TTL.REC. ' C SSURPL = SAVE(8) DO 8 I =1,7 SSURPL = SSURPL + SAVE(I) DO 9 J = 1,18 SSURPL = SSURPL - PX(J,I) * RINV(J,I) 9 CONTINUE 8 CONTINUE C CALL VECVEC(4,PUPRIN,UPRINV,VIPR) SSURPL = SSURPL - VIPR C TOTEXP = GVIRUR + GVISOC + GVIIND + GVITRA + GVICON + TRILHH + 1 TROPSS + DTPTLO + DTPTFO + GVSER C TOTREC = LTAX + IMDUIN + IMDURO + AVTAX + AGINPT + FORAST + 1 RESERV(20) + SSURPL C WRITE(*,*) ' "GOVERNMENT ACCOUNT ' WRITE(*,*) C 1 FORMAT(1X,A10,F10.1,7X,A10,F10.1) WRITE(*,'(1X,A10,17X,A10)') COL1(1),COL2(1) C WRITE(*,1) COL1(2),GVIRUR,COL2(2),LTAX WRITE(*,1) COL1(3),GVISOC,COL2(3),IMDUIN WRITE(*,1) COL1(4),GVIIND,COL2(4),IMDURO WRITE(*,1) COL1(5),GVITRA,COL2(5),AVTAX WRITE(*,1) COL1(6),GVICON,COL2(6),AGINPT WRITE(*,1) COL1(7),TRILHH,COL2(7),FORAST WRITE(*,1) COL1(8),TROPSS,COL2(8),RESERV(20) WRITE(*,1) COL1(9),DTPTLO,COL2(9),SSURPL WRITE(*,1) COL1(10),DTPTFO WRITE(*,1) COL1(11),GVSER C ZGEXPM(1,IYRTL) = GVIRUR ZGEXPM(2,IYRTL) = GVISOC ZGEXPM(3,IYRTL) = GVIIND ZGEXPM(4,IYRTL) = GVITRA ZGEXPM(5,IYRTL) = GVICON ZGEXPM(6,IYRTL) = TRILHH ZGEXPM(7,IYRTL) = TROPSS ZGEXPM(8,IYRTL) = DTPTLO ZGEXPM(9,IYRTL) = DTPTFO ZGEXPM(10,IYRTL) = GVSER ZGEXPM(11,IYRTL) = TOTEXP C ZGRECM(1,IYRTL) = LTAX ZGRECM(2,IYRTL) = IMDUIN ZGRECM(3,IYRTL) = IMDURO ZGRECM(4,IYRTL) = AVTAX ZGRECM(5,IYRTL) = AGINPT ZGRECM(6,IYRTL) = FORAST ZGRECM(7,IYRTL) = RESERV(20) ZGRECM(8,IYRTL) = SSURPL ZGRECM(9,IYRTL) = TOTREC C WRITE(*,*) C WRITE(*,1) COL1(12),TOTEXP,COL2(10),TOTREC C C C NOW PRIVATE INVESTMENTS AND SAVINGS, FIRST BY DESTINATION REGION C COL1(1 ) = '"MOUNTN ' COL1(2 ) = '"HILL-W ' COL1(3 ) = '"HILL-C ' COL1(4 ) = '"HILL-E ' COL1(5 ) = '"TERAI-W ' COL1(6 ) = '"TERAI-C ' COL1(7 ) = '"TERAI-C ' COL1(8 ) = '"URBAN ' C DO 11 I=1,7 DO 11 J=1,18 DUM(I) = DUM(I) + PX(J,I) * RINV(J,I) DUM(10+I) = DUM(10+I)+PX(J,I)* 1 (GINV(J)*GOIRUR(I)+HINV(J)*GOIOTH(I)) DUM(20+I) = DUM(20+I) + OPX(J,I) * RINV(J,I) DUM(30+I) = DUM(30+I) + OPX(J,I)* 1 (GINV(J)*GOIRUR(I)+HINV(J)*GOIOTH(I)) 11 CONTINUE C WRITE(*,*) '"REGION ,SAVINGS ,INVESTMT , NET (CURRENT PRC)' WRITE(*,*) WRITE(*,'(A10,3F10.2)') 1 (COL1(I),SAVE(I),DUM(I),SAVE(I)-DUM(I),I=1,7), 2 COL1(8),SAVE(8),VIPR,SAVE(8)-VIPR C C DO 145 I=1,7 ZRSAV(I,1,IYRTL) = SAVE(I) ZRSAV(I,2,IYRTL) = DUM(I) ZRSAV(I,3,IYRTL) = SAVE(I) - DUM(I) 145 CONTINUE C ZRSAV(8,1,IYRTL) = SAVE(8) ZRSAV(8,2,IYRTL) = VIPR ZRSAV(8,3,IYRTL) = SAVE(8) - VIPR C WRITE(*,*) DUMA=SAVE(8) DUMB=VIPR DUMC=SAVE(8)-VIPR DO 1234 I=1,7 DUMA=DUMA + SAVE(I) DUMB=DUMB + DUM(I) DUMC=DUMC+SAVE(I)-DUM(I) 1234 CONTINUE C C WRITE(*,'(A10,3F10.2)') ' "TOTAL ',DUMA,DUMB,DUMC C C C INVESTMENT BY SECTOR OF DESTINATION C COL1(1 ) = '"MOUNTN ' COL1(2 ) = '"HILL-W ' COL1(3 ) = '"HILL-C ' COL1(4 ) = '"HILL-E ' COL1(5 ) = '"TERAI-W ' COL1(6 ) = '"TERAI-C ' COL1(7 ) = '"TERAI-C ' COL1(8 ) = '"TOT AGR. ' COL1(9 ) = '"INDUSTRY ' COL1(10) = '"CONSTR ' COL1(11) = '"TRADE ' COL1(12) = '"PRV.SVC ' C DO 13 I=1,7 DUM(40) = DUM(40) + DUM(I) DUM(41) = DUM(41) + DUM(10+I) DUM(42) = DUM(42) + DUM(20+I) DUM(43) = DUM(43) + DUM(30+I) 13 CONTINUE C WRITE(*,*) '"RURAL INVESTMENTS ' WRITE(*,*)' REGION ,PRINV/CUR ,GOINV/CUR ,PRINV/CON ,GOINV/CON' WRITE(*,*) WRITE(*,'(A10,4F10.2)') (COL1(I),DUM(I),DUM(10+I),DUM(20+I), 1 DUM(30+I),I=1,7) WRITE(*,'(A10,4F10.2)') COL1(8),DUM(40),DUM(41),DUM(42),DUM(43) C DO 446 I = 1,7 ZRUINV(I,1,IYRTL) = DUM(I) ZRUINV(I,2,IYRTL) = DUM(I+10) ZRUINV(I,3,IYRTL) = DUM(20+I) ZRUINV(I,4,IYRTL) = DUM(I+30) 446 CONTINUE C ZRUINV(8,1,IYRTL) = DUM(40) ZRUINV(8,2,IYRTL) = DUM(41) ZRUINV(8,3,IYRTL) = DUM(42) ZRUINV(8,4,IYRTL) = DUM(43) C WRITE(*,*) C WRITE(*,*) '"URBAN INVESTMENTS ' WRITE(*,*)' SECTOR ,PRINV/CUR ,GOINV/CUR ,PRINV/CON ,GOINV/CON' WRITE(*,'(A10,4F10.2)')COL1(9),UPRINV(1)*PUPRIN(1),GVIIND, 1 UPRINV(1)*OPUPRI(1),OGIIND WRITE(*,'(A10,4F10.2)')COL1(10),UPRINV(2)*PUPRIN(2),GVICON, 1 UPRINV(2)*OPUPRI(2),OGICON WRITE(*,'(A10,4F10.2)')COL1(11),UPRINV(3)*PUPRIN(3),GVITRA, 1 UPRINV(3)*OPUPRI(3),OGITRA WRITE(*,'(A10,4F10.2)')COL1(12),UPRINV(4)*PUPRIN(4),0., 1 UPRINV(4)*OPUPRI(4),0. C DUMB=GVIIND+GVICON+GVITRA DUMD=OGIIND+OGICON+OGITRA DUMA=0. DUMC=0. DO 2345 I=1,4 DUMA = DUMA + UPRINV(I)*PUPRIN(I) DUMC = DUMC + UPRINV(I)*OPUPRI(I) 2345 CONTINUE C WRITE(*,'(A10,4F10.2,/)')' "TOTAL ',DUMA,DUMB,DUMC,DUMD C DO 173 I=1,4 ZURINV(I,1,IYRTL) = UPRINV(I) *PUPRIN(I) ZURINV(I,3,IYRTL) = UPRINV(I) *OPUPRI(I) 173 CONTINUE C ZURINV(1,2,IYRTL) = GVIIND ZURINV(2,2,IYRTL) = GVICON ZURINV(3,2,IYRTL) = GVITRA ZURINV(4,2,IYRTL) = 0. ZURINV(1,4,IYRTL) = OGIIND ZURINV(2,4,IYRTL) = OGICON ZURINV(3,4,IYRTL) = OGITRA ZURINV(4,4,IYRTL) = 0. C DO 174 J= 1,4 ZURINV(5,J,IYRTL) = 0. DO 1741 I=1,4 ZURINV (5,J,IYRTL) = ZURINV (5,J,IYRTL)+ZURINV(I,J,IYRTL) 1741 CONTINUE 174 CONTINUE C C WRITE(*,*) '" TRANSPORTATION OVER ROADS ' WRITE(*,*) DO 181 I=1,11 ZRCAP(I,1,IYRTL) = EKTR(I) ZRCAP(I,2,IYRTL) = ST(I) ZRCAP(I,3,IYRTL) = DRDTR(I) ZRCAP(I,4,IYRTL) = PT(I) 181 CONTINUE C zrcap(6,2,iyrtl)=0. zrcap(6,3,iyrtl)=0. drdtr(6) = 0. st(6) = 0. WRITE(*,*) '"ROADNUMBER, CAPACITY, SUPPLY, DEMAND , UNIT COST' WRITE(*,'(I10,3F10.2,F10.4)') (I,EKTR(I),ST(I),DRDTR(I), 1 PT(I),I=1,11) C C RETURN END c SUBROUTINE UNFRWN(IYR) IMPLICIT REAL (A-Z) LOGICAL RALLWD,ERIS CHARACTER BAND*5,BND(5),TEEP*5,TAPE(5) C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' include 'glblk.for' include 'blnblk.for' c REAL BLKURB(328),BLKGEN(5269),BLKG(321),BLKGL(18),BLKTR(49), 1 BLKBLN(4) C EQUIVALENCE (CATR(1),BLKTR(1)),(GRQR(1,1),BLKGEN(1)), 1 (GINV(1),BLKG(1)),(GVIRUR,BLKGL(1)),(CALFUR(1),BLKURB(1)), 1 (IPRCON,BLKBLN(1)),(BAND,BND),(TEEP,TAPE) C C INTEGER IUNIT,IRW,J,I,IYR C IF IRW=0 READ C IF IRW=1 WRITE C C TEEP='SOL81' C WRITE(*,*) TEEP TAPE(5)= CHAR(MOD(IYR,10)+ICHAR('0')) WRITE(*,*) TEEP OPEN(3,FILE=TEEP,FORM='UNFORMATTED',STATUS='OLD') IUNIT=3 REWIND(IUNIT) C C C READING OF THE ARRAYS IN PARTS OF 256 ELEMENTS READ(IUNIT)(BLKURB(I),I=1,256) READ(IUNIT)(BLKURB(I),I=257,328) J=0 1 READ(IUNIT)(BLKGEN(I+J*256),I=1,256) J=J+1 IF(J.LE.19)THEN GOTO 1 ELSE READ(IUNIT)(BLKGEN(I+5120),I=1,149) ENDIF READ(IUNIT)(BLKG(I),I=1,256) READ(IUNIT)(BLKG(I),I=257,321) READ(IUNIT) BLKGL READ(IUNIT) BLKTR READ(IUNIT) BLKBLN C WRITING OF THE ARRAYS IN PARTS OF 256 ELEMENTS CLOSE(IUNIT) RETURN END c SUBROUTINE MGM(D1,D2,D3,A1,T1,A2,T2,A3,T3) C C C THIS SUBROUTINE SUPPLIES A GENERAL MATRIX MULTIPLICATION PROCEDURE C THE PARAMETERS ARE AS FOLLOWS C D1,D2 IS THE DIMENSION OF THE LEFTMOST MULTIPLICANT A1, TAKING INTO C CONSIDERATION TRANSPOSITION. D2,D3 IS THE DIMENSION OF THE SECOND C MULTIPLIER A2 ALSO AFTER TAKING ACCOUNT OF TRANSPOSING THE MATRIX. C THE RESULT IS OF DIMENSION D1,D3 AND STORED INTO POSSIBLY TRANSPOSED A C T1,T2 AND T3 ARE TRANSPOSITION INDICATORS. IF 0 NO TRANSPOSITION, IF 1 C THE CORRESPONDING A IS TRANSPOSED. C EXAMPLE A_(3,4),B_(5,4),C_(5,3). TO GET INTO C THE PRODUCT OF C B AND A-TRANSPOSED THE CALL SHOULD BE C CALL MGM(5,4,3,B,0,A,1,C,0) C C ANOTHER CALL WITH THE SAME RESULT WOULD BE C CALL MGM(3,4,5,A,0,B,1,C,1) C C C NOTE THE ACTUAL PARAMETERS SHOULD BE CHOSEN VERY CAREFULLY C SINCE THERE IS NOT CHECKING ON ARRAY BOUNDS WHATEVER. C INTEGER D1,D2,D3,T1,T2,T3,I,J,K,I1,I2,I3 REAL A1(*),A2(*),A3(*) C DO 1 I=1,D1 DO 2 J=1,D3 C I3=(1-T3)*(I+(J-1)*D1)+T3*(J+(I-1)*D3) A3(I3) = 0.0 C DO 3 K=1,D2 I1=(1-T1)*(I+(K-1)*D1)+T1*(K+(I-1)*D2) I2=(1-T2)*(K+(J-1)*D2)+T2*(J+(K-1)*D3) A3(I3)=A3(I3)+A1(I1)*A2(I2) C 3 CONTINUE 2 CONTINUE 1 CONTINUE RETURN END C file 32 PROGRAM STATS IMPLICIT REAL (A-Z) C C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' include 'glblk.for' include 'blnblk.for' include 'stsblk.for' C REAL BLKURB(328),BLKGEN(5169),BLKG(321),BLKGL(18),BLKTR(49), 1 BLKBLN(4),BLKSTS(4100) C C EQUIVALENCE (CATR(1),BLKTR(1)),(GRQR(1,1),BLKGEN(1)), 1 (GINV(1),BLKG(1)),(GVIRUR,BLKGL(1)),(CALFUR(1),BLKURB(1)), 2 (XPRCN,BLKBLN(1)),(ZPRMAT(1,1,1),BLKSTS(1)) C C C C THIS PROGRAM COMPUTES A NUMBER OF STATISTICS C FROM A SERIES OF SOLUTIONS C C C---------------- C---------------- C C CHARACTER REGEL*80,YTL*2,TEEP*10 REAL ODCNS(21,8),OPX(18,10),OPR(7,10),OSX(12),OGRQR(7,7), 1 ONFHH(8),GRIX(7),BGRIX(7),PRIX(7),BPRIX(7),COCIX(8), 2 BCOCIX(8),V1(30),V2(30),V3(30),V4(30),V5(30),OGOVMP, 3 OPSI(3,7),OPCH(7),OAVTX(18),OPWA,OPT(12) C INTEGER I,J,ITEL,K,N1,N2,IREG,IYRTL,NYR C DO 6116 I=1,4100 6116 BLKSTS(I) = 0. C WRITE(*,*) ' HOW MANY YEARS (1-9) ' READ(*,*) NYR C IYRTL = 1 C CALL UNFRWN(87) C C C DO 99 I=1,8 DO 99 J=1,21 99 ODCNS(J,I) = DCONSD(J,I) C C DO 98 I=1,10 DO 98 J=1,18 98 OPX(J,I) = PX(J,I) C C DO 97 I=1,10 DO 97 J=1,7 97 OPR(J,I) = PR(J,I) C C DO 96 I=1,12 96 OSX(I) = SX(I) C C DO 95 I=1,7 DO 95 J=1,7 95 OGRQR(J,I) = GRQR(J,I) C C DO 94 I=1,8 94 ONFHH(I) = NOFHH(I) C DO 57 I=1,7 DO 57 J=1,3 57 OPSI(J,I) = PSI(J,I) C DO 58 I=1,7 58 OPCH(I) = PCH(I) C DO 59 I=1,18 59 OAVTX(I) = AVLOTA(I) C DO 60 I=1,11 60 OPT(I) = PT(I) C OPWA = PWAURB C WRITE(*,*) ' "BASE YEAR PR-PRICES ' C DO 93 I=1,9 93 WRITE(*,'(7F10.3)') (PR(J,I),J=1,7) WRITE(*,*) C DO 153 J=1,9 DO 153 I=1,7 ZPRMAT(I,J,IYRTL) = PR(I,J) 153 CONTINUE C DO 154 J=1,10 DO 154 I=1,18 ZPXMAT (I,J,IYRTL) = PX(I,J) 154 CONTINUE C C WRITE(*,*) ' "BASE YEAR PX-PRICES ' DO 92 I=1,10 92 WRITE(*,'(3(6F10.3,/))') (PX(J,I),J=1,18) C C CALL BUDGTS(OPX,IYRTL) CALL RLGDP(OPX,OPR,OPCH,OPSI,OAVTX,OPWA,OPT,IYRTL) C WRITE(*,*) ' "SOME BASE YEAR STATISTICS ' WRITE(*,*) ' "URBAN LABOUR AND WAGE' WRITE(*,'(5F13.2,F13.5)') (DLAURB(I),I=1,4),GOVEMP,PWAURB WRITE(*,*) ' "URBAN CAPITAL' WRITE(*,'(4G17.5)') (EKURB(I),I=1,4) C C DO 282 I = 1,4 ZUCAP (I,IYRTL) = EKURB(I) ZEMPL (I,IYRTL) = DLAURB(I) 282 CONTINUE C ZEMPL(5,IYRTL) = GOVEMP ZEMPL(6,IYRTL) = 0. C DO 312 I=1,5 312 ZEMPL(6,IYRTL) = ZEMPL(6,IYRTL) + ZEMPL(I,IYRTL) C ZWAG(1,IYRTL) = PWAURB C DO 291 I=1,4 DO 2911 J=1,7 2911 ZRQUIX(I,J,IYRTL) = 1. ZUQUIX(I,IYRTL) = 1. ZUPIX(I,IYRTL) = 1. ZUCUIX(I,IYRTL) = 1. 291 CONTINUE C C DO 999 ITEL = 88,87+NYR-1 C C IYRTL = IYRTL+1 CALL UNFRWN(ITEL) C WRITE(*,*) ' "YEAR ',ITEL WRITE(*,*) ' "REGION NO , Q , P , C , PC ' C DO 953 J=1,9 DO 953 I=1,7 ZPRMAT(I,J,IYRTL) = PR(I,J) 953 CONTINUE C DO 954 J=1,10 DO 954 I=1,18 ZPXMAT(I,J,IYRTL) = PX(I,J) 954 CONTINUE C DO 11 IREG=1,7 C C CALL CVECTK(7,10,PR,IREG,1,7,V1) CALL CVECTK(7,7,GRQR,IREG,1,7,V2) CALL CVECTK(7,10,OPR,IREG,1,7,V3) CALL CVECTK(7,7,OGRQR,IREG,1,7,V4) C CALL VECVEC(7,V1,V2,QXT) CALL VECVEC(7,V1,V4,QXN) CALL VECVEC(7,V1,V4,PXT) CALL VECVEC(7,V3,V4,PXN) C DO 111 I=1,7 V1(I) = PR(I,IREG) V2(I) = DCONSD(I,IREG) V3(I) = OPR(I,IREG) V4(I) = ODCNS(I,IREG) 111 CONTINUE C DO 112 I=1,14 V1(I+7) = PX(I,IREG) V2(I+7) = DCONSD(I+7,IREG) V3(I+7) = OPX(I,IREG) V4(I+7) = ODCNS(I+7,IREG) 112 CONTINUE C C CALL VECVEC(21,V1,V2,CXT) CALL VECVEC(21,V1,V4,CXN) CALL VECVEC(21,V1,V4,PCT) CALL VECVEC(21,V3,V4,PCN) C ZRQUIX(1,IREG,IYRTL) = QXT/QXN ZRQUIX(2,IREG,IYRTL) = PXT/PXN ZRQUIX(3,IREG,IYRTL) = CXT/CXN ZRQUIX(4,IREG,IYRTL) = PCT/PCN C WRITE(*,'(3X,I4,4F10.4)') 1 IREG,QXT/QXN,PXT/PXN,CXT/CXN,PCT/PCN C 11 CONTINUE C C WRITE(*,*) WRITE(*,*) C C DO 272 I = 1,4 ZUCAP(I,IYRTL) = EKURB(I) ZEMPL(I,IYRTL) = DLAURB(I) 272 CONTINUE C ZEMPL(5,IYRTL) = GOVEMP ZEMPL(6,IYRTL) = 0. C DO 322 I=1,5 322 ZEMPL(6,IYRTL) = ZEMPL(6,IYRTL) + ZEMPL(I,IYRTL) C ZWAG(1,IYRTL) = PWAURB C WRITE(*,*) ' " URBAN REGION ' C WRITE(*,*) ' "URBAN LABOUR AND WAGE' WRITE(*,'(6G15.5)') (DLAURB(I),I=1,4),GOVEMP,PWAURB WRITE(*,*) ' "URBAN CAPITAL' WRITE(*,'(4G17.5,/)') (EKURB(I),I=1,4) C CALL CVECTK(18,10,PX,8,1,14,V1) CALL CVECTK(18,10,OPX,8,1,14,V3) CALL VECVEC(8,V1,SX,QXMT) CALL VECVEC(8,V1,OSX,QXMN) CALL VECVEC(8,V1,OSX,PXMT) CALL VECVEC(8,V3,OSX,PXMN) C CALL VECVEC(11,V1,SX,QURT) CALL VECVEC(11,V1,OSX,QURN) CALL VECVEC(11,V1,OSX,PURT) CALL VECVEC(11,V3,OSX,PURN) C WRITE(*,*) ' " SECTORAL OUTPUT ' C ZUQUIX(1,IYRTL) = QXMT/QXMN ZUQUIX(2,IYRTL) = SX(9)/OSX(9) ZUQUIX(3,IYRTL) = SX(10)/OSX(10) ZUQUIX(4,IYRTL) = SX(11)/OSX(11) ZUPIX(1,IYRTL) = PXMT/PXMN ZUPIX(2,IYRTL) = PX(9,8)/OPX(9,8) ZUPIX(3,IYRTL) = PX(10,8)/OPX(10,8) ZUPIX(4,IYRTL) = PX(11,8)/OPX(11,8) C WRITE(*,'(4G15.4)') QXMT/QXMN,(SX(I)/OSX(I),I=9,11) WRITE(*,*) ' " SECTORAL PRICES ' WRITE(*,'(4G15.4)') PXMT/PXMN,(PX(I,8)/OPX(I,8),I=9,11) C C C DO 211 I=1,7 V1(I) = PR(I,IREG) V2(I) = DCONSD(I,IREG) V3(I) = OPR(I,IREG) V4(I) = ODCNS(I,IREG) 211 CONTINUE C DO 212 I=1,14 V1(I+7) = PX(I,IREG) V2(I+7) = DCONSD(I+7,IREG) V3(I+7) = OPX(I,IREG) V4(I+7) = ODCNS(I+7,IREG) 212 CONTINUE C C CALL VECVEC(21,V1,V2,CXT) CALL VECVEC(21,V1,V4,CXN) CALL VECVEC(21,V1,V4,PCT) CALL VECVEC(21,V3,V4,PCN) WRITE(*,*) ' " URBAN OUTPUT AND PRICES, CONSM AND PRICES ' ZUCUIX(1,IYRTL) = QURT/QURN ZUCUIX(2,IYRTL) = PURT/PURN ZUCUIX(3,IYRTL) = CXT/CXN ZUCUIX(4,IYRTL) = PCT/PCN WRITE(*,'(4G15.4,/)') QURT/QURN,PURT/PURN,CXT/CXN,PCT/PCN C WRITE(*,*) ' "YEAR PR-PRICES ' C DO 193 I=1,9 193 WRITE(*,'(7F10.3)') (PR(J,I),J=1,7) WRITE(*,*) C WRITE(*,*) ' " YEAR PX-PRICES ' DO 192 I=1,10 192 WRITE(*,'(3(6F10.3,/))') (PX(J,I),J=1,18) C C WRITE(*,*) C CALL BUDGTS(OPX,IYRTL) CALL RLGDP(OPX,OPR,OPCH,OPSI,OAVTX,OPWA,OPT,IYRTL) C 999 CONTINUE C 17 FORMAT(1X,I4,9F10.3) 18 FORMAT(1X,I4,9F10.1) 7 FORMAT(1X,9F10.3) 8 FORMAT(1X,9F10.1) 19 FORMAT(1X,A10,9F10.1) C C WRITE(31,*) 'REGIONAL PRICES PR HOR=YEARS, VER=REGION, GOODS' WRITE(31,*) WRITE(31,*) 'MOUNTAIN REGION' WRITE(31,17) (I,(ZPRMAT(I,1,K),K=1,9),I=1,7) WRITE(31,*) WRITE(31,*) ' HILL-WST REGION ' WRITE(31,17) (I,(ZPRMAT(I,2,K),K=1,9),I=1,7) WRITE(31,*) WRITE(31,*) ' HILL-CNT REGION ' WRITE(31,17) (I,(ZPRMAT(I,3,K),K=1,9),I=1,7) WRITE(31,*) WRITE(31,*) ' HILL-EAST REGION ' WRITE(31,17) (I,(ZPRMAT(I,4,K),K=1,9),I=1,7) WRITE(31,*) WRITE(31,*) ' TERAI WEST REGION' WRITE(31,17) (I,(ZPRMAT(I,5,K),K=1,9),I=1,7) WRITE(31,*) WRITE(31,*) ' TERAI CNT REGION' WRITE(31,17) (I,(ZPRMAT(I,6,K),K=1,9),I=1,7) WRITE(31,*) WRITE(31,*) ' TERAI EAST REGION' WRITE(31,17) (I,(ZPRMAT(I,7,K),K=1,9),I=1,7) WRITE(31,*) WRITE(31,*) ' URBAN REGION' WRITE(31,17) (I,(ZPRMAT(I,8,K),K=1,9),I=1,7) WRITE(31,*) WRITE(31,*) ' INDIA' WRITE(31,17) (I,(ZPRMAT(I,9,K),K=1,9),I=1,7) WRITE(31,*) WRITE(31,*) ' REGIONAL PRICES PX HOR=YEARS, VER=REGION, GOODS' WRITE(31,*) WRITE(31,*) WRITE(31,*) ' MOUNTAIN REGION' WRITE(31,17) (I,(ZPXMAT(I,1,K),K=1,9),I=1,18) WRITE(31,*) WRITE(31,*) ' HILL-WST REGION' WRITE(31,17) (I,(ZPXMAT(I,2,K),K=1,9),I=1,18) WRITE(31,*) WRITE(31,*) ' HILL-CNT REGION' WRITE(31,17) (I,(ZPXMAT(I,3,K),K=1,9),I=1,18) WRITE(31,*) WRITE(31,*) ' HILL-EAST REGION' WRITE(31,17) (I,(ZPXMAT(I,4,K),K=1,9),I=1,18) WRITE(31,*) WRITE(31,*) ' TERAI WEST REGION' WRITE(31,17) (I,(ZPXMAT(I,5,K),K=1,9),I=1,18) WRITE(31,*) WRITE(31,*) ' TERAI CNT REGION' WRITE(31,17) (I,(ZPXMAT(I,6,K),K=1,9),I=1,18) WRITE(31,*) WRITE(31,*) ' TERAI EAST REGION' WRITE(31,17) (I,(ZPXMAT(I,7,K),K=1,9),I=1,18) WRITE(31,*) WRITE(31,*) ' URBAN REGION' WRITE(31,17) (I,(ZPXMAT(I,8,K),K=1,9),I=1,18) WRITE(31,*) WRITE(31,*) ' INDIA' WRITE(31,17) (I,(ZPXMAT(I,9,K),K=1,9),I=1,18) WRITE(31,*) WRITE(31,*) WRITE(31,*) ' GOVERNMENT ACCOUNTS EXPENDITURES' WRITE(31,19) ' GVIRUR ',(ZGEXPM(1,J),J=1,9) WRITE(31,19) ' GVISOC ',(ZGEXPM(2,J),J=1,9) WRITE(31,19) ' GVIIND ',(ZGEXPM(3,J),J=1,9) WRITE(31,19) ' GVITRA ',(ZGEXPM(4,J),J=1,9) WRITE(31,19) ' GVICON ',(ZGEXPM(5,J),J=1,9) WRITE(31,19) ' TRILHH ',(ZGEXPM(6,J),J=1,9) WRITE(31,19) ' TROPSS ',(ZGEXPM(7,J),J=1,9) WRITE(31,19) ' DTPTLO ',(ZGEXPM(8,J),J=1,9) WRITE(31,19) ' DTPTFO ',(ZGEXPM(9,J),J=1,9) WRITE(31,19) ' GVSER ',(ZGEXPM(10,J),J=1,9) WRITE(31,19) ' TTL.EX. ',(ZGEXPM(11,J),J=1,9) WRITE(31,*) WRITE(31,*) 'GOVERNMENT ACCOUNTS RECEIPTS' WRITE(31,19) ' LTAX ', (ZGRECM(1,J),J=1,9) WRITE(31,19) ' IMDUIN ', (ZGRECM(2,J),J=1,9) WRITE(31,19) ' IMDURO ', (ZGRECM(3,J),J=1,9) WRITE(31,19) ' AVTAX ', (ZGRECM(4,J),J=1,9) WRITE(31,19) ' AGINPT ', (ZGRECM(5,J),J=1,9) WRITE(31,19) ' FORAST ', (ZGRECM(6,J),J=1,9) WRITE(31,19) ' NTXREV ', (ZGRECM(7,J),J=1,9) WRITE(31,19) ' SAVSPL ', (ZGRECM(8,J),J=1,9) WRITE(31,19) ' TTL.REC. ', (ZGRECM(9,J),J=1,9) WRITE(31,*) WRITE(31,*) WRITE(31,*) 'REGIONAL SAVINGS, INVESTMENT, NET' DO 31180 I=1,8 WRITE(31,18) (I,(ZRSAV(I,J,K),K=1,9),J=1,3) 31180 WRITE(31,*) C WRITE(31,18) (2,(ZRSAV(2,J,K),K=1,9),J=1,3) C WRITE(31,*) C WRITE(31,18) (3,(ZRSAV(3,J,K),K=1,9),J=1,3) C WRITE(31,*) C WRITE(31,18) (4,(ZRSAV(4,J,K),K=1,9),J=1,3) C WRITE(31,*) C WRITE(31,18) (5,(ZRSAV(5,J,K),K=1,9),J=1,3) C WRITE(31,*) C WRITE(31,18) (6,(ZRSAV(6,J,K),K=1,9),J=1,3) C WRITE(31,*) C WRITE(31,18) (7,(ZRSAV(7,J,K),K=1,9),J=1,3) C WRITE(31,*) C WRITE(31,18) (8,(ZRSAV(8,J,K),K=1,9),J=1,3) C WRITE(31,*) WRITE(31,*) ' REGIONAL INVESTMENTS' WRITE(31,*) ' PRIV/CUR, GOV/CUR, PRIV/CON, GOV/CON' DO 3118 I=1,8 WRITE(31,18) (I,(ZRUINV(I,J,K),K=1,9),J=1,4) 3118 WRITE(31,*) C WRITE(31,18) (2,(ZRUINV(2,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,18) (3,(ZRUINV(3,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,18) (4,(ZRUINV(4,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,18) (5,(ZRUINV(5,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,18) (6,(ZRUINV(6,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,18) (7,(ZRUINV(7,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,18) (8,(ZRUINV(8,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,*) WRITE(31,*) ' URBAN INVESTMENTS BY SECTOR' WRITE(31,*) ' PRIV/CUR, GOV/CUR, PRIV/CON, GOV/CON' WRITE(31,18) (1,(ZURINV(1,J,K),K=1,9),J=1,4) WRITE(31,*) WRITE(31,18) (2,(ZURINV(2,J,K),K=1,9),J=1,4) WRITE(31,*) WRITE(31,18) (3,(ZURINV(3,J,K),K=1,9),J=1,4) WRITE(31,*) WRITE(31,18) (4,(ZURINV(4,J,K),K=1,9),J=1,4) WRITE(31,*) WRITE(31,18) (5,(ZURINV(5,J,K),K=1,9),J=1,4) WRITE(31,*) C WRITE(31,*) WRITE(31,*) ' ROADS NUMBER, CAPACITY, SUPPL, DEMAND, PT' DO 3117 I=1,11 3117 WRITE(31,17) (I,(ZRCAP(I,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,17) (2,(ZRCAP(2,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,17) (3,(ZRCAP(3,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,17) (4,(ZRCAP(4,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,17) (5,(ZRCAP(5,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,17) (6,(ZRCAP(6,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,17) (7,(ZRCAP(7,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,17) (8,(ZRCAP(8,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,17) (9,(ZRCAP(9,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,17) (10,(ZRCAP(10,J,K),K=1,9),J=1,4) C WRITE(31,*) C WRITE(31,17) (11,(ZRCAP(11,J,K),K=1,9),J=1,4) WRITE(31,*) WRITE(31,*) WRITE(31,*) ' REGIONAL GDP, FACTOR COST, CONSTANT PRICES' WRITE(31,17) (J,(ZRGDP(J,K),K=1,9),J=1,8) WRITE(31,*) WRITE(31,*) WRITE(31,*) ' URBAN GDP BY SECTOR, FACTOR COST, CONST.PRC.' WRITE(31,17) (J,(ZUGDP(J,K),K=1,9),J=1,8) WRITE(31,*) WRITE(31,*) ' GDP AT FACTOR COST, CONSTANT PRICES ' WRITE(31,'(1X,9F10.1)') (ZGDPFC(1,K),K=1,9) WRITE(31,*) WRITE(31,*) WRITE(31,*) ' URBAN EMPLOYMENT BY SECTOR ' WRITE(31,18) (J+7,(ZEMPL(J,K),K=1,9),J=1,5) WRITE(31,18) 0,(ZEMPL(6,K),K=1,9) WRITE(31,*) WRITE(31,*) ' URBAN WAGES' WRITE(31,7) ((ZWAG(J,K),K=1,9),J=1,1) WRITE(31,*) WRITE(31,*) ' URBAN CAPITAL' WRITE(31,17) (J+7,(ZUCAP(J,K),K=1,9),J=1,4) WRITE(31,*) WRITE(31,*) WRITE(31,*) ' INDEXNUMBER OF RURAL' WRITE(31,*) ' 1-OUTP,2-OUT.PRC,3-CONS,4-CONS.PRIC' WRITE(31,17) ((J,(ZRQUIX(J,I,K),K=1,9),J=1,4),I=1,7) WRITE(31,*) WRITE(31,*) ' INDEXNUMBER OF URBAN OUTPUT' WRITE(31,17) (J+7,(ZUQUIX(J,K),K=1,9),J=1,4) WRITE(31,*) WRITE(31,*) ' INDEXNUMBER OF URBAN PRICES ' WRITE(31,17) (J+7,(ZUPIX(J,K),K=1,9),J=1,4 ) WRITE(31,*) WRITE(31,*) ' INDEXNUMBER OF URBAN ' WRITE(31,*) ' 1-OUTP,2-OUT.PRC,3-CONS,4-CONS.PRIC' WRITE(31,17) (J,(ZUCUIX(J,K),K=1,9),J=1,4) WRITE(31,*) C STOP ' END OF STATISTICS PROGRAM ' END c SUBROUTINE RLGDP(OPX,OPR,OPCH,OPSI,OAVTX,OPWA,OPT,IYRTL) C C GOVERNMENT EXPENDITURE AND RECEIPTS C PRIVATE DOMESTIC INVESTMENT AND SAVING C IMPLICIT REAL (A-Z) C C C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' include 'glblk.for' include 'blnblk.for' include 'stsblk.for' C C REAL YAGR(7),YCOST,DUM(50),OPX(18,10),OPR(7,9), 1 OPCH(7),OPSI(3,7),OAVTX(18),YGOV,YRDTR,YRURAL,YURBAN, 2 FMVADD,CMVADD,SCVADD(4),OPWA,OPT(12) C INTEGER I,J,IYRTL CHARACTER*10 COL1(30),COL2(30) C DATA DUM/50*0./ C YAGR(1) = 27 YAGR(2) = 33 YAGR(3) = 33 YAGR(4) = 33 YAGR(5) = 33 YAGR(6) = 33 YAGR(7) = 34 C C C THIS IS INVESTMENT IN LIVESTOCK PRODUCTS. C IT IS KEPT AT 227 THROUGH ALL THE SIMULATIONS. C C DO 100 I=1,7 C DO 101 J=1,4 101 YAGR(I) = YAGR(I) + OPR(J,I)*(GRQR(J,I)-SLOC(J,I)-FDR(J,I)) C YAGR(I) = YAGR(I) - OPR(5,I) * SLOC(5,I) C DO 102 J=5,7 102 YAGR(I) = YAGR(I) + OPR(J,I)*GRQR(J,I) C YCOST = OPCH(I)*DCHEM(I)+OPX(8,I)*DMANR(I) DO 103 J=1,3 103 YCOST = YCOST + OPSI(J,I)*DIMSE(J,I) C YAGR(I) = YAGR(I) - YCOST C 100 CONTINUE C C C C COMPUTATION OF GDP BY SECTOR C C FMVADD = 0. DO 200 I=1,4 XHLP = OPX(I,8)*(1.-OAVTX(I)) DO 201 J=1,7 201 XHLP = XHLP-OPR(J,8)*UFOODR(J,I)-OPX(J+7,8)*UFOODX(J,I) C DO 202 J=8,11 202 XHLP = XHLP - OPX(J+7,8)*UFOODX(J,I) C FMVADD = FMVADD + SX(I)*XHLP C 200 CONTINUE C CMVADD = 0. DO 300 I=5,7 XHLP = OPX(I,8)*(1.-OAVTX(I)) DO 301 J=1,7 301 XHLP = XHLP-OPR(J,8)*UFOODR(J,I)-OPX(J+7,8)*UFOODX(J,I) C DO 302 J=8,11 302 XHLP = XHLP - OPX(J+7,8)*UFOODX(J,I) C CMVADD = CMVADD + SX(I)*XHLP C 300 CONTINUE C C DO 400 I=1,4 XHLP = OPX(I+7,8)*(1.-OAVTX(I+7)) C DO 401 J=1,7 401 XHLP = XHLP - OPR(J,8)*IOCO(J,I) C DO 402 J=8,18 402 XHLP = XHLP - OPX(J,8)*IOCO(J,I) C SCVADD(I) = XHLP * SX(I+7) C 400 CONTINUE C YRDTRA = 0. DO 500 I=1,11 500 if (i.ne.6) YRDTRA = YRDTRA + OPT(I) * DRDTR(I) C YRDTRA = YRDTRA - OPX(10,8) * XTR C YRURAL = 0. DO 600 I=1,7 600 YRURAL = YRURAL + YAGR(I) C YGOV = SWAGE(5) * OPWA * GOVEMP C YURBAN = FMVADD+CMVADD+YRDTRA+YGOV C DO 356 I=1,7 356 ZRGDP(I,IYRTL) = YAGR(I) C ZRGDP(8,IYRTL) = YRURAL C DO 601 I=1,4 601 YURBAN = YURBAN + SCVADD(I) C WRITE(*,*) ' "RURAL GDP, CONSTANT PRICES ' WRITE(*,'(1X,A10,F10.2)') '"TOTAL ',YRURAL C COL1(1 ) = '"MOUNTN ' COL1(2 ) = '"HILL-W ' COL1(3 ) = '"HILL-C ' COL1(4 ) = '"HILL-E ' COL1(5 ) = '"TERAI-W ' COL1(6 ) = '"TERAI-C ' COL1(7 ) = '"TERAI-E ' C COL1(8 ) = '"URBAN ' C WRITE(*,*) WRITE(*,'(1X,A10,F10.2)') (COL1(I),YAGR(I),I=1,7) WRITE(*,*) WRITE(*,*) ' "URBAN GDP, CONSTANT PRICES' WRITE(*,'(1X,A10,F10.2)') '"TOTAL ',YURBAN WRITE(*,*) COL1(1 ) = '"FOODMILL.' COL1(2 ) = '"CASHMILL.' COL1(3 ) = '"MANUFACT.' COL1(4 ) = '"CONSTR. ' COL1(5 ) = '"TRADE. ' COL1(6 ) = '"PRIV.SVC.' COL1(7 ) = '"GOV.SVC. ' C SCVADD(3) = SCVADD(3) + YRDTRA C WRITE(*,7) COL1(1),FMVADD,COL1(2),CMVADD WRITE(*,7) (COL1(I+2),SCVADD(I),I=1,4) WRITE(*,7) COL1(7),YGOV WRITE(*,*) WRITE(*,7) '"TTL GDP ',YURBAN+YRURAL ZUGDP(1,IYRTL) = FMVADD ZUGDP(2,IYRTL) = CMVADD C 7 FORMAT(1X,A10,F10.2) C DO 338 I=1,4 338 ZUGDP(2+I,IYRTL) = SCVADD(I) C ZUGDP(7,IYRTL) = YGOV ZUGDP(8,IYRTL) = YURBAN ZGDPFC(1,IYRTL) = YURBAN + YRURAL RETURN END c SUBROUTINE VECVEC(N,A,B,C) C C C DOTPRODUCT ROUTINE. THE INNER PRODUCT OF A AND B IS DELIVERED IN C C INTEGER I,N REAL A,B,C DIMENSION A(N),B(N) C C = 0.0 DO 1 I=1,N C = C + A(I) * B(I) 1 CONTINUE RETURN END c SUBROUTINE CVECTK(M1,M2,MAT,COLNO,I1,I2,VEC) C C C C THIS SUBROUTINE TAKES A COLUMN VECTOR OUT OF C A MATRIX. THE DIMENSION OF THE MATRIX IS C (M1,M2), COLNO IS THE COLUMN NUMBER TO BE C TAKEN, I1 BEGINNING INDEX, I2 FINAL INDEX C C INTEGER M1,M2,I1,I2,COLNO,I C REAL MAT(M1,M2),VEC(*) C DO 1 I = I1,I2 VEC(I-I1+1) = MAT(I,COLNO) 1 CONTINUE C RETURN END c SUBROUTINE BUDGTS(OPX,IYRTL) C C GOVERNMENT EXPENDITURE AND RECEIPTS C PRIVATE DOMESTIC INVESTMENT AND SAVING C IMPLICIT REAL (A-Z) C C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' include 'glblk.for' include 'blnblk.for' include 'stsblk.for' C C C C REAL SSURPL,VIPR,TOTEXP,TOTREC,DUM(50),OPX(18,10), 1 VEC1(25),OPUPRI(4),OGISOC,OGITRA,OGIIND,OGICON INTEGER I,J,IYRTL CHARACTER*10 COL1(30),COL2(30) C DO 999 I=1,50 999 DUM(I) = 0. C CALL CVECTK(18,10,OPX,8,1,18,VEC1) CALL MGM(1,18,4,VEC1,0,CUPRIN,0,OPUPRI,0) CALL VECVEC(18,VEC1,GSNV,OGISOC) CALL VECVEC(18,VEC1,IINV,OGIIND) CALL VECVEC(18,VEC1,TINV,OGITRA) CALL VECVEC(18,VEC1,CONV,OGICON) C OGISOC=OGISOC*GOISOC OGITRA=OGITRA*GOITRA OGIIND=OGIIND*GOIIND OGICON=OGICON*GOICON C COL1(1) = '"EXPENDITR' COL1(2 ) = '"GVIRUR ' COL1(3 ) = '"GVISOC ' COL1(4 ) = '"GVIIND ' COL1(5 ) = '"GVITRA ' COL1(6 ) = '"GVICON ' COL1(7 ) = '"TRILHH ' COL1(8 ) = '"TROPSS ' COL1(9 ) = '"DTPTLO ' COL1(10) = '"DTPTFO ' COL1(11) = '"GVSER ' COL1(12) = '"TTL.EXP. ' C COL2(1 ) = '"RECEIPTS ' COL2(2 ) = '"LTAX ' COL2(3 ) = '"IMDUIN ' COL2(4 ) = '"IMDURO ' COL2(5 ) = '"AVTAX ' COL2(6 ) = '"AGINPT ' COL2(7 ) = '"FORAST ' COL2(8 ) = '"NTXREV ' COL2(9 ) = '"SAVSPL ' COL2(10) = '"TTL.REC. ' C SSURPL = SAVE(8) DO 8 I =1,7 SSURPL = SSURPL + SAVE(I) DO 9 J = 1,18 SSURPL = SSURPL - PX(J,I) * RINV(J,I) 9 CONTINUE 8 CONTINUE C CALL VECVEC(4,PUPRIN,UPRINV,VIPR) SSURPL = SSURPL - VIPR C TOTEXP = GVIRUR + GVISOC + GVIIND + GVITRA + GVICON + TRILHH + 1 TROPSS + DTPTLO + DTPTFO + GVSER C TOTREC = LTAX + IMDUIN + IMDURO + AVTAX + AGINPT + FORAST + 1 RESERV(20) + SSURPL C WRITE(*,*) ' "GOVERNMENT ACCOUNT ' WRITE(*,*) C 1 FORMAT(1X,A10,F10.1,7X,A10,F10.1) WRITE(*,'(1X,A10,17X,A10)') COL1(1),COL2(1) C WRITE(*,1) COL1(2),GVIRUR,COL2(2),LTAX WRITE(*,1) COL1(3),GVISOC,COL2(3),IMDUIN WRITE(*,1) COL1(4),GVIIND,COL2(4),IMDURO WRITE(*,1) COL1(5),GVITRA,COL2(5),AVTAX WRITE(*,1) COL1(6),GVICON,COL2(6),AGINPT WRITE(*,1) COL1(7),TRILHH,COL2(7),FORAST WRITE(*,1) COL1(8),TROPSS,COL2(8),RESERV(20) WRITE(*,1) COL1(9),DTPTLO,COL2(9),SSURPL WRITE(*,1) COL1(10),DTPTFO WRITE(*,1) COL1(11),GVSER C ZGEXPM(1,IYRTL) = GVIRUR ZGEXPM(2,IYRTL) = GVISOC ZGEXPM(3,IYRTL) = GVIIND ZGEXPM(4,IYRTL) = GVITRA ZGEXPM(5,IYRTL) = GVICON ZGEXPM(6,IYRTL) = TRILHH ZGEXPM(7,IYRTL) = TROPSS ZGEXPM(8,IYRTL) = DTPTLO ZGEXPM(9,IYRTL) = DTPTFO ZGEXPM(10,IYRTL) = GVSER ZGEXPM(11,IYRTL) = TOTEXP C ZGRECM(1,IYRTL) = LTAX ZGRECM(2,IYRTL) = IMDUIN ZGRECM(3,IYRTL) = IMDURO ZGRECM(4,IYRTL) = AVTAX ZGRECM(5,IYRTL) = AGINPT ZGRECM(6,IYRTL) = FORAST ZGRECM(7,IYRTL) = RESERV(20) ZGRECM(8,IYRTL) = SSURPL ZGRECM(9,IYRTL) = TOTREC C WRITE(*,*) C WRITE(*,1) COL1(12),TOTEXP,COL2(10),TOTREC C C C NOW PRIVATE INVESTMENTS AND SAVINGS, FIRST BY DESTINATION REGION C COL1(1 ) = '"MOUNTN ' COL1(2 ) = '"HILL-W ' COL1(3 ) = '"HILL-C ' COL1(4 ) = '"HILL-E ' COL1(5 ) = '"TERAI-W ' COL1(6 ) = '"TERAI-C ' COL1(7 ) = '"TERAI-C ' COL1(8 ) = '"URBAN ' C DO 11 I=1,7 DO 11 J=1,18 DUM(I) = DUM(I) + PX(J,I) * RINV(J,I) DUM(10+I) = DUM(10+I)+PX(J,I)* 1 (GINV(J)*GOIRUR(I)+HINV(J)*GOIOTH(I)) DUM(20+I) = DUM(20+I) + OPX(J,I) * RINV(J,I) DUM(30+I) = DUM(30+I) + OPX(J,I)* 1 (GINV(J)*GOIRUR(I)+HINV(J)*GOIOTH(I)) 11 CONTINUE C WRITE(*,*) '"REGION ,SAVINGS ,INVESTMT , NET (CURRENT PRC)' WRITE(*,*) WRITE(*,'(A10,3F10.2)') 1 (COL1(I),SAVE(I),DUM(I),SAVE(I)-DUM(I),I=1,7), 2 COL1(8),SAVE(8),VIPR,SAVE(8)-VIPR C C DO 145 I=1,7 ZRSAV(I,1,IYRTL) = SAVE(I) ZRSAV(I,2,IYRTL) = DUM(I) ZRSAV(I,3,IYRTL) = SAVE(I) - DUM(I) 145 CONTINUE C ZRSAV(8,1,IYRTL) = SAVE(8) ZRSAV(8,2,IYRTL) = VIPR ZRSAV(8,3,IYRTL) = SAVE(8) - VIPR C WRITE(*,*) DUMA=SAVE(8) DUMB=VIPR DUMC=SAVE(8)-VIPR DO 1234 I=1,7 DUMA=DUMA + SAVE(I) DUMB=DUMB + DUM(I) DUMC=DUMC+SAVE(I)-DUM(I) 1234 CONTINUE C C WRITE(*,'(A10,3F10.2)') ' "TOTAL ',DUMA,DUMB,DUMC C C C INVESTMENT BY SECTOR OF DESTINATION C COL1(1 ) = '"MOUNTN ' COL1(2 ) = '"HILL-W ' COL1(3 ) = '"HILL-C ' COL1(4 ) = '"HILL-E ' COL1(5 ) = '"TERAI-W ' COL1(6 ) = '"TERAI-C ' COL1(7 ) = '"TERAI-C ' COL1(8 ) = '"TOT AGR. ' COL1(9 ) = '"INDUSTRY ' COL1(10) = '"CONSTR ' COL1(11) = '"TRADE ' COL1(12) = '"PRV.SVC ' C DO 13 I=1,7 DUM(40) = DUM(40) + DUM(I) DUM(41) = DUM(41) + DUM(10+I) DUM(42) = DUM(42) + DUM(20+I) DUM(43) = DUM(43) + DUM(30+I) 13 CONTINUE C WRITE(*,*) '"RURAL INVESTMENTS ' WRITE(*,*)' REGION ,PRINV/CUR ,GOINV/CUR ,PRINV/CON ,GOINV/CON' WRITE(*,*) WRITE(*,'(A10,4F10.2)') (COL1(I),DUM(I),DUM(10+I),DUM(20+I), 1 DUM(30+I),I=1,7) WRITE(*,'(A10,4F10.2)') COL1(8),DUM(40),DUM(41),DUM(42),DUM(43) C DO 446 I = 1,7 ZRUINV(I,1,IYRTL) = DUM(I) ZRUINV(I,2,IYRTL) = DUM(I+10) ZRUINV(I,3,IYRTL) = DUM(20+I) ZRUINV(I,4,IYRTL) = DUM(I+30) 446 CONTINUE C ZRUINV(8,1,IYRTL) = DUM(40) ZRUINV(8,2,IYRTL) = DUM(41) ZRUINV(8,3,IYRTL) = DUM(42) ZRUINV(8,4,IYRTL) = DUM(43) C WRITE(*,*) C WRITE(*,*) '"URBAN INVESTMENTS ' WRITE(*,*)' SECTOR ,PRINV/CUR ,GOINV/CUR ,PRINV/CON ,GOINV/CON' WRITE(*,'(A10,4F10.2)')COL1(9),UPRINV(1)*PUPRIN(1),GVIIND, 1 UPRINV(1)*OPUPRI(1),OGIIND WRITE(*,'(A10,4F10.2)')COL1(10),UPRINV(2)*PUPRIN(2),GVICON, 1 UPRINV(2)*OPUPRI(2),OGICON WRITE(*,'(A10,4F10.2)')COL1(11),UPRINV(3)*PUPRIN(3),GVITRA, 1 UPRINV(3)*OPUPRI(3),OGITRA WRITE(*,'(A10,4F10.2)')COL1(12),UPRINV(4)*PUPRIN(4),0., 1 UPRINV(4)*OPUPRI(4),0. C DUMB=GVIIND+GVICON+GVITRA DUMD=OGIIND+OGICON+OGITRA DUMA=0. DUMC=0. DO 2345 I=1,4 DUMA = DUMA + UPRINV(I)*PUPRIN(I) DUMC = DUMC + UPRINV(I)*OPUPRI(I) 2345 CONTINUE C WRITE(*,'(A10,4F10.2,/)')' "TOTAL ',DUMA,DUMB,DUMC,DUMD C DO 173 I=1,4 ZURINV(I,1,IYRTL) = UPRINV(I) *PUPRIN(I) ZURINV(I,3,IYRTL) = UPRINV(I) *OPUPRI(I) 173 CONTINUE C ZURINV(1,2,IYRTL) = GVIIND ZURINV(2,2,IYRTL) = GVICON ZURINV(3,2,IYRTL) = GVITRA ZURINV(4,2,IYRTL) = 0. ZURINV(1,4,IYRTL) = OGIIND ZURINV(2,4,IYRTL) = OGICON ZURINV(3,4,IYRTL) = OGITRA ZURINV(4,4,IYRTL) = 0. C DO 174 J= 1,4 ZURINV(5,J,IYRTL) = 0. DO 1741 I=1,4 ZURINV (5,J,IYRTL) = ZURINV (5,J,IYRTL)+ZURINV(I,J,IYRTL) 1741 CONTINUE 174 CONTINUE C C WRITE(*,*) '" TRANSPORTATION OVER ROADS ' WRITE(*,*) DO 181 I=1,11 ZRCAP(I,1,IYRTL) = EKTR(I) ZRCAP(I,2,IYRTL) = ST(I) ZRCAP(I,3,IYRTL) = DRDTR(I) ZRCAP(I,4,IYRTL) = PT(I) 181 CONTINUE C zrcap(6,2,iyrtl)=0. zrcap(6,3,iyrtl)=0. drdtr(6) = 0. st(6) = 0. WRITE(*,*) '"ROADNUMBER, CAPACITY, SUPPLY, DEMAND , UNIT COST' WRITE(*,'(I10,3F10.2,F10.4)') (I,EKTR(I),ST(I),DRDTR(I), 1 PT(I),I=1,11) C C RETURN END c SUBROUTINE UNFRWN(IYR) IMPLICIT REAL (A-Z) LOGICAL RALLWD,ERIS CHARACTER BAND*5,BND(5),TEEP*5,TAPE(5) C include 'urbblk.for' include 'genblk.for' include 'gblk.for' include 'trblk.for' include 'glblk.for' include 'blnblk.for' c REAL BLKURB(328),BLKGEN(5269),BLKG(321),BLKGL(18),BLKTR(49), 1 BLKBLN(4) C EQUIVALENCE (CATR(1),BLKTR(1)),(GRQR(1,1),BLKGEN(1)), 1 (GINV(1),BLKG(1)),(GVIRUR,BLKGL(1)),(CALFUR(1),BLKURB(1)), 1 (IPRCON,BLKBLN(1)),(BAND,BND),(TEEP,TAPE) C C INTEGER IUNIT,IRW,J,I,IYR C IF IRW=0 READ C IF IRW=1 WRITE C C TEEP='SOL81' C WRITE(*,*) TEEP TAPE(5)= CHAR(MOD(IYR,10)+ICHAR('0')) WRITE(*,*) TEEP OPEN(3,FILE=TEEP,FORM='UNFORMATTED',STATUS='OLD') IUNIT=3 REWIND(IUNIT) C C C READING OF THE ARRAYS IN PARTS OF 256 ELEMENTS READ(IUNIT)(BLKURB(I),I=1,256) READ(IUNIT)(BLKURB(I),I=257,328) J=0 1 READ(IUNIT)(BLKGEN(I+J*256),I=1,256) J=J+1 IF(J.LE.19)THEN GOTO 1 ELSE READ(IUNIT)(BLKGEN(I+5120),I=1,149) ENDIF READ(IUNIT)(BLKG(I),I=1,256) READ(IUNIT)(BLKG(I),I=257,321) READ(IUNIT) BLKGL READ(IUNIT) BLKTR READ(IUNIT) BLKBLN C WRITING OF THE ARRAYS IN PARTS OF 256 ELEMENTS CLOSE(IUNIT) RETURN END c SUBROUTINE MGM(D1,D2,D3,A1,T1,A2,T2,A3,T3) C C C THIS SUBROUTINE SUPPLIES A GENERAL MATRIX MULTIPLICATION PROCEDURE C THE PARAMETERS ARE AS FOLLOWS C D1,D2 IS THE DIMENSION OF THE LEFTMOST MULTIPLICANT A1, TAKING INTO C CONSIDERATION TRANSPOSITION. D2,D3 IS THE DIMENSION OF THE SECOND C MULTIPLIER A2 ALSO AFTER TAKING ACCOUNT OF TRANSPOSING THE MATRIX. C THE RESULT IS OF DIMENSION D1,D3 AND STORED INTO POSSIBLY TRANSPOSED A C T1,T2 AND T3 ARE TRANSPOSITION INDICATORS. IF 0 NO TRANSPOSITION, IF 1 C THE CORRESPONDING A IS TRANSPOSED. C EXAMPLE A_(3,4),B_(5,4),C_(5,3). TO GET INTO C THE PRODUCT OF C B AND A-TRANSPOSED THE CALL SHOULD BE C CALL MGM(5,4,3,B,0,A,1,C,0) C C ANOTHER CALL WITH THE SAME RESULT WOULD BE C CALL MGM(3,4,5,A,0,B,1,C,1) C C C NOTE THE ACTUAL PARAMETERS SHOULD BE CHOSEN VERY CAREFULLY C SINCE THERE IS NOT CHECKING ON ARRAY BOUNDS WHATEVER. C INTEGER D1,D2,D3,T1,T2,T3,I,J,K,I1,I2,I3 REAL A1(*),A2(*),A3(*) C DO 1 I=1,D1 DO 2 J=1,D3 C I3=(1-T3)*(I+(J-1)*D1)+T3*(J+(I-1)*D3) A3(I3) = 0.0 C DO 3 K=1,D2 I1=(1-T1)*(I+(K-1)*D1)+T1*(K+(I-1)*D2) I2=(1-T2)*(K+(J-1)*D2)+T2*(J+(K-1)*D3) A3(I3)=A3(I3)+A1(I1)*A2(I2) C 3 CONTINUE 2 CONTINUE 1 CONTINUE RETURN END C file 33 COMMON/STSBLK/ZPRMAT(7,9,9),ZPXMAT(18,10,9),ZGEXPM(11,9), +ZGRECM(9,9),ZRSAV(8,3,9),ZRUINV(8,4,9),ZURINV(5,4,9), +ZRCAP(11,4,9), ZRGDP(8,9), ZUGDP(8,9), ZGDPFC(1,9), ZEMPL(6,9), +ZWAG(1,9), ZUCAP(4,9), ZRQUIX(8,7,9) ,ZUQUIX(4,9),ZUPIX(4,9), +ZUCUIX(4,9) C file 34 COMMON /TRBLK/ CATR(12),CALFTR(12),EKTR(12),DRDTR(12),XTR C file 35 COMMON /URBBLK/ CALFUR(4),DLAURB(4),CAURB(4),EKURB(4),SWAGE(5), 1 IOCO(18,4),UFOODX(11,7),UFOODR(7,7),UXLAB(7),UX17OS(7), 2 UXDEP(7),DELTA(4),UVDEPR(4),PUPRIN(4),CUPRIN(18,4),UPRINV(4) C file C file C file