123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187 |
- PROGRAM REGIONTES
- IMPLICIT NONE
- INTEGER N,NOBS,NARGS,NLQ
- PARAMETER(N=1000)
- REAL*8 EMPL(N),EMPG(N),PROD(N),PRODL(N)
- REAL*8 TES(N,N),COEF(N,N),LQ(N)
- REAL*8 MATLQ(N,N),LEONTIEF(N,N),MULTIPLIERS(N)
- REAL*8 DELTA,BMULT,BEMPL
- INTEGER ORDM(N),DEBUG,LMAT
- CHARACTER*25 FILENAME
- CHARACTER*20 REGIONAME
- CHARACTER*40 LABELS(N)
- CHARACTER*5 CODES(N)
- CHARACTER*5 METHOD
- CHARACTER*6 SORT
- CHARACTER*10 ARGS
- CHARACTER*10 FMT
- REAL*8 EMPL09(N),EMPL30(9),EMPL1(N),EMPL2(N)
- REAL*8 PRODL09(N),PRODL30(N),PRODL1(N),PRODL2(N)
- REAL*8 F09(N),F30(N),F1(N),F2(N)
- INTEGER I,J
- ********************************
- REAL*8 F(N),Y(N),WORK(N),Z(N),RCOND,LL(N,N),L(N,N)
- REAL*8 DET, NEWPRODL(N)
- INTEGER IPVT(N)
- NARGS=IARGC()
- IF(NARGS.LT.1) THEN
- PRINT*,'YOU SHOULD PROVIDE THE INPUT FILE NAME'
- STOP
- ENDIF
- CALL GETARG(1,FILENAME)
- NOBS=N
- CALL INPUTDATA(FILENAME,NOBS,TES,EMPL,EMPG,PROD,
- & REGIONAME,DEBUG,METHOD,DELTA,LABELS,CODES,SORT)
- C PRINT*,'step 1'
- C WRITE(*,'(36F9.2)') TES(25,1:NOBS)
- C The command line options overwrite those
- C given in the input file
- IF(NARGS.GT.1) THEN
- DO 10 I=1,NARGS
- CALL GETARG(I,ARGS)
- IF(ARGS.EQ.'-L=YES') THEN
- LMAT=1
- ELSEIF(ARGS.EQ.'-L=NO') THEN
- LMAT=0
- ELSEIF(ARGS.EQ.'-d=YES') THEN
- DEBUG=1
- ELSEIF(ARGS.EQ.'-d=NO') THEN
- DEBUG=0
- ELSEIF(ARGS.EQ.'-s=LQ') THEN
- SORT='LQ'
- ELSEIF(ARGS.EQ.'-s=MULT') THEN
- SORT='METHOD'
- ELSEIF(ARGS.EQ.'-s=NONE') THEN
- SORT='NONE'
- ELSEIF(ARGS.EQ.'-m=SLQ') THEN
- METHOD='SLQ'
- ELSEIF(ARGS.EQ.'-m=CILQ') THEN
- METHOD='CILQ'
- ELSEIF(ARGS.EQ.'-m=RLQ') THEN
- METHOD='RLQ'
- ELSEIF(ARGS.EQ.'-m=CILQ') THEN
- METHOD='CILQ'
- ELSEIF(ARGS.EQ.'-m=FLQ') THEN
- METHOD='FLQ'
- ELSEIF(ARGS.EQ.'-m=NAT') THEN
- METHOD='NAT'
- ENDIF
- 10 CONTINUE
- ENDIF
- CALL MATCOEF(TES,PROD,COEF,NOBS,N,DEBUG)
- CALL LOCQ(METHOD,EMPL,EMPG,NOBS,N,DELTA,MATLQ,LQ,DEBUG)
- C PRINT*,'step 3'
- CALL REGIONAL(N,NOBS,COEF,MATLQ,LEONTIEF,MULTIPLIERS,DEBUG)
- C PRINT*,COEF(25,1:NOBS)
- C PRINT*,'step 4'
- NLQ=0
- DO I=1,NOBS
- IF(LQ(I).GT.1.D0) THEN
- NLQ=NLQ+1
- BEMPL=BEMPL+EMPL(I)
- ENDIF
- ENDDO
- BMULT=SUM(EMPL(1:NOBS))/BEMPL
- PRINT*, '======================================'
- PRINT*, 'REGION/CITY NAME: ', REGIONAME
- PRINT*, '--------------------------------------'
- PRINT '(X,A31,I3)', 'NUMBER OF SECTORS WITH LQ > 1 :', NLQ
- PRINT*, '--------------------------------------'
- PRINT '(X,A31,F7.3)', 'BASE MULTIPLIER :', BMULT
- PRINT*, '--------------------------------------'
- IF(SORT.EQ.'LQ') THEN
- CALL SORTRX(NOBS,LQ,ORDM)
- ELSEIF(SORT.EQ.'METHOD')THEN
- CALL SORTRX(NOBS,MULTIPLIERS,ORDM)
- ELSE
- DO I=1,NOBS
- ORDM(I)=NOBS-I+1
- ENDDO
- ENDIF
- PRINT'(18X,A6)',METHOD
- PRINT*,' CODES LQ MULTIP. DESCR.'
- PRINT*,'======================================'
- DO I=1,NOBS
- J=ORDM(NOBS-I+1)
- PRINT '((5X)(A4)(f6.3)(3X)(F6.3)(5X)(A35))',
- & CODES(J), LQ(J),MULTIPLIERS(J),LABELS(J)
- ENDDO
- PRINT*,'======================================'
- PRINT*
- IF(LMAT.EQ.1) THEN
- WRITE(FMT,'("("I0,"F9.3)")') NOBS
- PRINT*,'LEONTIEF MATRIX (I-A)^(-1)'
- DO I=1,NOBS
- WRITE(*,FMT),(LEONTIEF(I,J),J=1,NOBS)
- ENDDO
- ENDIF
- PRINT*
- ************************************************
- ************************************************
- * This part is added for computations to the
- * case of IDF.
- ************************************************
- ************************************************
- C DO I=1,NOBS
- C PRODL(I)=PROD(I)/EMPG(I)*EMPL(I)
- * PRINT '(A2,3F15.3)', CODES(I),PRODL(I),PROD(I),PROD(I)/EMPG(I)
- C ENDDO
- * LL = (I-A) and
- * LEONTIEF = (I-A)^-1
- * PRODL : the initial production
- * EMPL : the initial employment
- * NEWPRODL : the new production
- * NEWEMPL : the new employment
- *
- C LL=LEONTIEF
- C CALL DGECO(LL,N,NOBS,IPVT,RCOND,Z)
- C CALL DGEDI(LL,N,NOBS,IPVT,DET,WORK,01)
- * Now LL is the inverse of LEONTIEF
- CALL DGEMV('N',NOBS,NOBS,1.0D0,LL,N,PRODL,1,0.0D0,Y,1)
- * Y contains the final consumption
-
- * PRINT*, 'Emploi final à l échelle locale (M€)'
- * DO I=1,NOBS
- * PRINT '(F12.3)', Y(I)
- * ENDDO
- * here a test of whether the computation of
- * the inverse matrix are correct
- * CALL DGEMM('N','N',NOBS,NOBS,NOBS,1.D0,LL,N,LEONTIEF,N,0.D0,L,N)
- * the transport sector has an increase of 10% in final demand
- * PRINT '(F12.3)',Y(20)
- C Y(20)=1.1D0*Y(20)
- * PRINT '(F12.3)',Y(20)
- * the induced change in production is
- C CALL DGEMV('N',NOBS,NOBS,1.D0,LEONTIEF,N,Y,1,0.0D0,NEWPRODL,1)
- C DO I=1,NOBS
- C PRINT '(A2,",",F12.3,",",F12.3)', CODES(I),LQ(I),
- C & (NEWPRODL(I)-PRODL(I))/(PROD(I)/EMPG(I))
- C ENDDO
- * PRINT*, LEONTIEF(1,1:NOBS)
- * DO I=1,5
- * PRINT '(5F12.3)', LL(I,1:5)
- * ENDDO
- * PRINT*
- * DO I=1,5
- * PRINT '(5F12.3)', LEONTIEF(I,1:5)
- * ENDDO
- * PRINT*
- * DO I=1,5
- * PRINT '(5F12.3)', L(I,1:5)
- * ENDDO
- * Y(20)=Y(20)*1.1D0
- END
|