lq.f 2.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120
  1. SUBROUTINE LOCQ(METHOD,EMPLOC,EMPGEN,NOBS,NLD,DELTA,MATLQ,LQ,
  2. + DEBUG)
  3. IMPLICIT NONE
  4. C
  5. C Author: Moez Kilani
  6. C Date: March 2012
  7. C Contact: moez [dot] kilani [at] univ-lille3.fr
  8. C
  9. C
  10. C INPUT
  11. C METHOD: the method used to compute the coefficient
  12. C matrix. There are four methods accepted :
  13. C SLQ, CILQ, RLQ, FLQ
  14. C EMPLOC: local employment data, an vector of NOBS
  15. C elements
  16. C EMPGEN: global employment data (at nation level, in general)
  17. C NOBS: number of sectors considered.
  18. C OUTPUT
  19. C MATLQ: the coefficient matrix
  20. C
  21. INTEGER NOBS,NLD,DEBUG
  22. REAL*8 EMPLOC(*),EMPGEN(*),MATLQ(NLD,*)
  23. CHARACTER*5 METHOD,METHODS(5)
  24. REAL*8 TOTLOC,TOTGEN,LQ(*),DELTA,LAMBDA
  25. CHARACTER*10 FMT
  26. INTEGER I,J
  27. DATA METHODS /'SLQ','CILQ','RLQ','FLQ','NAT'/
  28. TOTLOC=0.D0
  29. TOTGEN=0.D0
  30. DO I=1,NOBS
  31. TOTLOC=TOTLOC+EMPLOC(I)
  32. TOTGEN=TOTGEN+EMPGEN(I)
  33. ENDDO
  34. DO I=1,NOBS
  35. LQ(I)=(EMPLOC(I)/TOTLOC)/(EMPGEN(I)/TOTGEN)
  36. ENDDO
  37. IF(METHOD.EQ.METHODS(1)) THEN
  38. GOTO 1 ! method SLQ
  39. ELSEIF(METHOD.EQ.METHODS(2)) THEN
  40. GOTO 2 ! method CILQ
  41. ELSEIF(METHOD.EQ.METHODS(3)) THEN
  42. GOTO 3 ! method RLQ
  43. ELSEIF(METHOD.EQ.METHODS(4)) THEN
  44. GOTO 4 ! method FLQ
  45. ELSEIF(METHOD.EQ.METHODS(5)) THEN
  46. GOTO 5 ! method NAT
  47. ENDIF
  48. C If none of the methods is matched then print
  49. C an error message here and go to the end
  50. PRINT*, 'ERROR: Method ', METHOD, ' is not implemented'
  51. GOTO 100
  52. 1 CONTINUE
  53. C METHOD 1: SLQ
  54. DO I=1,NOBS
  55. DO J=1,NOBS
  56. MATLQ(I,J)=MIN(1.D0,LQ(I))
  57. ENDDO
  58. ENDDO
  59. GOTO 100
  60. 2 CONTINUE
  61. C METHOD 2: CILQ
  62. DO I=1,NOBS
  63. DO J=1,NOBS
  64. MATLQ(I,J)=MIN(1.D0,LQ(I)/LQ(J))
  65. ENDDO
  66. ENDDO
  67. GOTO 100
  68. 3 CONTINUE
  69. C METHOD 3: RLQ
  70. DO I=1,NOBS
  71. DO J=1,NOBS
  72. MATLQ(I,J)=MIN(1.D0,LQ(I)/(LOG(1.D0+LQ(J))/LOG(2.D0)))
  73. ENDDO
  74. ENDDO
  75. GOTO 100
  76. 4 CONTINUE
  77. C METHOD 4: FLQ
  78. LAMBDA=(LOG(1.D0+TOTLOC/TOTGEN)/LOG(2.D0))**DELTA
  79. DO I=1,NOBS
  80. DO J=1,NOBS
  81. MATLQ(I,J)=MIN(1.D0,LAMBDA*LQ(I)/LQ(J))
  82. ENDDO
  83. ENDDO
  84. DO I=1,NOBS
  85. MATLQ(I,I)=MIN(1.D0,LAMBDA*LQ(I))
  86. ENDDO
  87. GOTO 100
  88. 5 CONTINUE
  89. C METHOD 5: NAT
  90. DO I=1,NOBS
  91. DO J=1,NOBS
  92. MATLQ(I,J)=1.0D0
  93. ENDDO
  94. ENDDO
  95. GOTO 100
  96. 100 CONTINUE
  97. IF(DEBUG.EQ.1)THEN
  98. WRITE(FMT,'("("I0,"F9.3)")') NOBS
  99. PRINT*,'LOCATION QUOTIENT MATRIX'
  100. DO I=1,NOBS
  101. WRITE(*,FMT),(MATLQ(I,J),J=1,NOBS)
  102. ENDDO
  103. ENDIF
  104. RETURN
  105. ENDSUBROUTINE