regional.f 1.5 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768
  1. SUBROUTINE REGIONAL(NLD,NOBS,COEF,MATLQ,LEONTIEF,MULTIPLIERS,
  2. + DEBUG)
  3. C -------------------
  4. C TAKES A MATRIX "A" AND PRODUCES A LEONTIEF MATRIX
  5. C AND COMPUTES MULTIPLIERS
  6. IMPLICIT NONE
  7. INTEGER NOBS,NLD,DEBUG
  8. REAL*8 COEF(NLD,*),MATLQ(NLD,*),LEONTIEF(NLD,*)
  9. REAL*8 MULTIPLIERS(NOBS)
  10. CHARACTER*10 FMT
  11. C LOCAL DATA
  12. INTEGER I,J
  13. REAL*8 MATID(NOBS,NOBS), MATTMP(NOBS,NOBS)
  14. DO I=1,NOBS
  15. DO J=1,NOBS
  16. MATID(I,J)=0.D0
  17. ENDDO
  18. ENDDO
  19. DO I=1,NOBS
  20. MATID(I,I)=1.D0
  21. ENDDO
  22. DO 10 I=1,NOBS
  23. DO 10 J=1,NOBS
  24. COEF(I,J)=COEF(I,J)*MATLQ(I,J)
  25. LEONTIEF(I,J)=MATID(I,J)-COEF(I,J)
  26. 10 CONTINUE
  27. IF(DEBUG.EQ.1)THEN
  28. WRITE(FMT,'("("I0,"F9.3)")') NOBS
  29. PRINT*,'MATRIX A'
  30. DO I=1,NOBS
  31. WRITE(*,FMT),(COEF(I,J),J=1,NOBS)
  32. ENDDO
  33. PRINT*,'MATRIX I-A'
  34. DO I=1,NOBS
  35. WRITE(*,FMT),(LEONTIEF(I,J),J=1,NOBS)
  36. ENDDO
  37. ENDIF
  38. CALL MATINV(LEONTIEF,NLD,NOBS)
  39. IF(DEBUG.EQ.1)THEN
  40. WRITE(FMT,'("("I0,"F9.3)")') NOBS
  41. PRINT*,'LEONTIEF MATRIX (I-A)^(-1)'
  42. DO I=1,NOBS
  43. WRITE(*,FMT),(LEONTIEF(I,J),J=1,NOBS)
  44. ENDDO
  45. ENDIF
  46. MULTIPLIERS=0.D0
  47. DO J=1,NOBS
  48. DO I=1,NOBS
  49. MULTIPLIERS(J)=MULTIPLIERS(J)+LEONTIEF(I,J)
  50. ENDDO
  51. ENDDO
  52. RETURN
  53. ENDSUBROUTINE