C
C     **********************************************
C     **                                          **
C     **            経済前提の読み込み            **
C     **                                          **
C     **********************************************
C
C
      SUBROUTINE     ECON
C
C
      IMPLICIT INTEGER(A-Z)
      INCLUDE 'seps.inc'
C
      COMMON /INECON/JH_KAITE,KOUJOR
      REAL*8 JH_KAITE(5:ECEDY),KOUJOR(5:ECEDY)
C
      REAL*8 DUM,DUM2
C
      REAL*8 CI_KIJUN,TAMARI_CI
      REAL*8 HHD,CID
C
      REAL*8 KAITE_HH,KAITE_HP,KAITE_CI
      REAL*8 KAITE_HHRD,KAITE_HPRD,KAITE_CIRD
C
      REAL*8 ID_HH_JUZEN(ECSTY:ECEDY),ID_HH_HON0(ECSTY:ECEDY,63:115)
      REAL*8 ID_HH_HONJU8W(ECSTY:ECEDY,63:115)
      REAL*8 ID_HH_TOKU(ECSTY:ECEDY,63:115)
      REAL*8 ID_HH_SIKU(ECSTY:ECEDY,63:115)
      REAL*8 ARV_HH(ECSTY:ECEDY,63:115)
C
      REAL*8 IDR_HP_HON(ECSTY:ECEDY,63:115)
      REAL*8 IDG_HP_HON8W(ECSTY:ECEDY,63:115)
      REAL*8 IDR_HP_TOKU(ECSTY:ECEDY,63:115)
      REAL*8 IDG_HP_TOKU(ECSTY:ECEDY,63:115)
      REAL*8 IDG_HP_SIKU(ECSTY:ECEDY,63:115)
      REAL*8 ARV_HP(ECSTY:ECEDY,63:115)
C
      REAL*8 RV(ECSTY:ECEDY,23)
      DIMENSION SAME(15:23)
      DATA SAME / 14, 14, 14,  6,  4,  5,  5, 13,  4 /
C
      REAL*8 MARUME_YR
C
      MARUME_YR = 19
C
      DO K=ECSTY,ECEDY
        ID_HH_JUZEN(K)=0.0D0
        CI0(K)=0.0D0
        DO X=63,115
          ID_HH_HON0(K,X)=0.0D0
          ID_HH_HONJU8W(K,X)=0.0D0
          ID_HH_TOKU(K,X)=0.0D0
          ID_HH_SIKU(K,X)=0.0D0
          ARV_HH(K,X)=0.0D0
C
          IDR_HP_HON(K,X)=0.0D0
          IDG_HP_HON8W(K,X)=0.0D0
          IDR_HP_TOKU(K,X)=0.0D0
          IDG_HP_TOKU(K,X)=0.0D0
          IDG_HP_SIKU(K,X)=0.0D0
          ARV_HP(K,X)=0.0D0
        END DO
      END DO
C
C     ファイルの読み込み
C
      DO 1000 K=1,KE
C
        READ(20,*,END=9999) KK,RI(K),DUM,DUM,DUM,H(K),CI0(K)
        IF(K.NE.KK) THEN
          WRITE(6,*) '経済前提ファイルの読込み年度が違います(econ.f)'
          STOP
        END IF
C
        RI(K) =RI(K) /1.0D2
        H(K)  =H(K)  /1.0D2
        CI0(K)=CI0(K)/1.0D2
        
C
        GO TO 1100
C
 9999   CONTINUE
        RI(K) =RI(K-1)
        H(K)  =H(K-1)
        CI0(K)=CI0(K-1)
C
 1100 CONTINUE
C
        IF(K.EQ.1) CI0(K)=-0.70D-2
C
 1000 CONTINUE
C
      DUM2 = DUM
      DUM  = DUM2
C
      WRITE(6,8000) RI(KE)*1.0D2,H(KE)*1.0D2,CI0(KE)*1.0D2
C
C     K=4(H16)の指数を初期化
      TAMARI_CI = -1.7D-2
C
      ID_HH_JUZEN(4)=0.986D0
C
      ID_HH_HON0(4,67)=0.990D0
      ID_HH_HON0(4,68)=0.982D0
      ID_HH_HON0(4,69)=0.975D0
      ID_HH_HON0(4,70)=0.971D0
      ID_HH_HON0(4,71)=0.971D0
      ID_HH_HON0(4,72)=0.971D0
      ID_HH_HON0(4,73)=0.971D0*1.064D0/1.069D0
      ID_HH_HON0(4,74)=0.971D0*1.041D0/1.069D0
      ID_HH_HON0(4,75)=0.971D0*1.031D0/1.069D0
C
      ID_HH_HONJU8W(4,67)=MAX(MAX(ID_HH_JUZEN(4),ID_HH_HON0(4,67)),
     &                        ID_HH_HON0(4,67)*0.8D0               )
C
      ID_HH_TOKU(4,67)=1.003D0
      ID_HH_SIKU(4,67)=MAX(ID_HH_HONJU8W(4,67),ID_HH_TOKU(4,67))
C
C
      IDR_HP_HON(4,67)=1.000D0
C
      IDG_HP_HON8W(4,67)=7809D0
C
      IDR_HP_TOKU(4,67)=0.988D0
      IDG_HP_TOKU(4,67)=ANINT(IDR_HP_TOKU(4,67)*8042D0)
C
      IDG_HP_SIKU(4,67)=MAX(IDG_HP_HON8W(4,67),IDG_HP_TOKU(4,67))
C
      DO 2000 X=68,115
        IF(X.GE.76) ID_HH_HON0(4,X)=ID_HH_HON0(4,75)
        ID_HH_HONJU8W(4,X)=MAX(MAX(ID_HH_JUZEN(4),ID_HH_HON0(4,X)),
     &                         ID_HH_HON0(4,67)*0.8D0              )
        ID_HH_TOKU(4,X)=ID_HH_TOKU(4,67)
        ID_HH_SIKU(4,X)=MAX(ID_HH_HONJU8W(4,X),ID_HH_TOKU(4,X))
C
        IDR_HP_HON(4,X)=IDR_HP_HON(4,67)
        IDG_HP_HON8W(4,X)=IDG_HP_HON8W(4,67)
        IDR_HP_TOKU(4,X)=IDR_HP_TOKU(4,67)
        IDG_HP_TOKU(4,X)=IDG_HP_TOKU(4,67)
        IDG_HP_SIKU(4,X)=IDG_HP_SIKU(4,67)
 2000 CONTINUE
C
      JZ_SHK(4)=ANINT( 0.917D0 / 0.990D0 *1.0D3 ) / 1.0D3
C
      DIR(4)=0.980D0
C
C     K=5(H17)以降の処理
C
      CI_KIJUN=1.0D0
C     実質賃金と可処分所得割合変化率の設定
      CALL JITSUCHIN_KASHOBUN
C
      DO 2100 K=5,KE
        KAITE_CI=CI0(K-1)
        KAITE_HH=(1.0D0+KAITE_CI)*JH_KAITE(K)*KOUJOR(K)-1.0D0
C
        KAITE_CIRD=ANINT(CI0(K-1)*1.0D3)/1.0D3
        KAITE_HHRD=(1.0D0+KAITE_CIRD)*ANINT(JH_KAITE(K)*1.0D3)/1.0D3
     &            *ANINT(KOUJOR(K)*1.0D3)/1.0D3-1.0D0
        KAITE_HHRD=ANINT(KAITE_HHRD*1.0D3)/1.0D3
C
        HHD = KAITE_HH
        CID = KAITE_CI
        IF(CHINSURA.EQ.1) THEN
          IF(K.LT.21) THEN
            IF(HHD.LT.CID .AND. HHD.LT.0.0D0) THEN
              KAITE_HH=MIN(CID,0.0D0)
            END IF
            IF(HHD.LT.CID .AND. CID.GT.0.0D0) THEN
              KAITE_CI=MAX(HHD,0.0D0)
            END IF
          ELSE IF(HHD.LT.CID) THEN
            KAITE_CI=HHD
          END IF
        ELSE
          IF(HHD.LT.CID .AND. HHD.LT.0.0D0) KAITE_HH=MIN(CID,0.0D0)
          IF(HHD.LT.CID .AND. CID.GT.0.0D0) KAITE_CI=MAX(HHD,0.0D0)
        END IF
C
        IF(TAMARI_CI.GE.0.0D0 .AND. K.GT.MARUME_YR) THEN
          IF(CHINSURA.EQ.1) THEN
            IF(K.GE.21) THEN
              JZ_SHK(K)=JZ_SHK(K-1)/(1.0D0+CI0(K-1))/JH_KAITE(K)
            ELSE
              IF(HHD.LT.CID) THEN
                IF(HHD.LT.0.0D0 .AND. CID.LT.0.0D0) THEN
                  JZ_SHK(K)=JZ_SHK(K-1)/(1.0D0+CI0(K-1))
                ELSE IF (HHD.LT.0.0D0 .AND. CID.GE.0.0D0) THEN
                  JZ_SHK(K)=JZ_SHK(K-1)
                ELSE
                  JZ_SHK(K)=JZ_SHK(K-1)/(1.0D0+CI0(K-1))/JH_KAITE(K)
                END IF
              ELSE
                JZ_SHK(K)=JZ_SHK(K-1)/(1.0D0+CI0(K-1))/JH_KAITE(K)
              END IF
            END IF
          ELSE
            IF(HHD.LT.CID) THEN
              IF(HHD.LT.0.0D0 .AND. CID.LT.0.0D0) THEN
                JZ_SHK(K)=JZ_SHK(K-1)/(1.0D0+CI0(K-1))
              ELSE IF (HHD.LT.0.0D0 .AND. CID.GE.0.0D0) THEN
                JZ_SHK(K)=JZ_SHK(K-1)
              ELSE
                JZ_SHK(K)=JZ_SHK(K-1)/(1.0D0+CI0(K-1))/JH_KAITE(K)
              END IF
            ELSE
              JZ_SHK(K)=JZ_SHK(K-1)/(1.0D0+CI0(K-1))/JH_KAITE(K)
            END IF
          END IF
        END IF 
C
        HHD = KAITE_HHRD
        CID = KAITE_CIRD
        IF(CHINSURA.EQ.1) THEN
          IF(K.LT.21) THEN
            IF(HHD.LT.CID .AND. HHD.LT.0.0D0) THEN
              KAITE_HHRD=MIN(CID,0.0D0)
            END IF
            IF(HHD.LT.CID .AND. CID.GT.0.0D0) THEN
              KAITE_CIRD=MAX(HHD,0.0D0)
            END IF
          ELSE IF(HHD.LT.CID) THEN
            KAITE_CIRD=HHD
          END IF
        ELSE 
          IF(HHD.LT.CID .AND. HHD.LT.0.0D0) KAITE_HHRD=MIN(CID,0.0D0)
          IF(HHD.LT.CID .AND. CID.GT.0.0D0) KAITE_CIRD=MAX(HHD,0.0D0)
        END IF
C
        IF(TAMARI_CI.LT.0.0D0 .OR. K.LE.MARUME_YR) THEN
          IF(CHINSURA.EQ.1) THEN
            IF(K.GE.21) THEN
              JZ_SHK(K)=ANINT( JZ_SHK(K-1)/(1.0D0+CI0(K-1))
     &                      /(ANINT(JH_KAITE(K)*1.0D3 )/1.0D3) *1.0D3 )
     &                                                           /1.0D3
            ELSE
              IF(HHD.LT.CID) THEN
                IF(HHD.LT.0.0D0 .AND. CID.LT.0.0D0) THEN
                  JZ_SHK(K)=ANINT( JZ_SHK(K-1)/(1.0D0+CI0(K-1)) *1.0D3 )
     &                                                          /1.0D3
                ELSE IF (HHD.LT.0.0D0 .AND. CID.GE.0.0D0) THEN
                  JZ_SHK(K)=JZ_SHK(K-1)
                ELSE
                  JZ_SHK(K)=ANINT( JZ_SHK(K-1)/(1.0D0+CI0(K-1))
     &                      /(ANINT(JH_KAITE(K)*1.0D3 )/1.0D3) *1.0D3 )
     &                                                           /1.0D3
                END IF
              ELSE
                JZ_SHK(K)=ANINT( JZ_SHK(K-1)/(1.0D0+CI0(K-1))
     &                      /(ANINT(JH_KAITE(K)*1.0D3 )/1.0D3) *1.0D3 )
     &                                                           /1.0D3
              END IF
            END IF
          ELSE
            IF(HHD.LT.CID) THEN
              IF(HHD.LT.0.0D0 .AND. CID.LT.0.0D0) THEN
                JZ_SHK(K)=ANINT( JZ_SHK(K-1)/(1.0D0+CI0(K-1)) *1.0D3 )
     &                                                          /1.0D3
              ELSE IF (HHD.LT.0.0D0 .AND. CID.GE.0.0D0) THEN
               JZ_SHK(K)=JZ_SHK(K-1)
              ELSE
               JZ_SHK(K)=ANINT( JZ_SHK(K-1)/(1.0D0+CI0(K-1))
     &                      /(ANINT(JH_KAITE(K)*1.0D3 )/1.0D3) *1.0D3 )
     &                                                           /1.0D3
              END IF
            ELSE
             JZ_SHK(K)=ANINT( JZ_SHK(K-1)/(1.0D0+CI0(K-1))
     &                      /(ANINT(JH_KAITE(K)*1.0D3 )/1.0D3) *1.0D3 )
     &                                                           /1.0D3
            END IF
          END IF
        END IF
C
        IF(K.GE.7) THEN
          KAITE_HP  =KAITE_HH
          KAITE_HPRD=KAITE_HHRD
        ELSE
          KAITE_HP  =KAITE_CI
          KAITE_HPRD=KAITE_CIRD
        END IF
C
        CI_KIJUN=ANINT(CI_KIJUN*(1.0D0+CI0(K-1))*1.0D3)/1.0D3
C
        IF(CI_KIJUN.LT.1.0D0) THEN
          CID=CI_KIJUN-1.0D0
          CI_KIJUN=1.0D0
        ELSE
          CID=0.0D0
        END IF
        HHD=CID
        IF(FLG_KAISHO.EQ.2) THEN
          IF(K.EQ.13 .OR. K.EQ.14) THEN
            IF(K.EQ.13 .AND.
     &         (CID.NE.KAITE_HHRD .OR. CID.NE.KAITE_CIRD)) THEN
              WRITE(6,*) 'H25.10の特例解消幅が△1.0％ではありません。'
              STOP
            END IF
            HHD=MIN(1.0D0,ANINT((1.0D0+KAITE_HHRD)*0.99D0*1.0D3)/1.0D3)
     &          -1.0D0
            CID=MIN(1.0D0,ANINT((1.0D0+KAITE_CIRD)*0.99D0*1.0D3)/1.0D3)
     &          -1.0D0
          ELSE IF(K.GE.15) THEN
            HHD=-1.0D0
            CID=-1.0D0
          END IF
        END IF
C
        IF(TAMARI_CI.LT.0.0D0 .OR. K.LE.MARUME_YR) THEN 
C
          ID_HH_JUZEN(K)=ANINT( ID_HH_JUZEN(K-1)
     &                         *(1.0D0+KAITE_CIRD)*1.0D4 )/1.0D4
C
          ID_HH_HON0(K,67)=ANINT( ID_HH_HON0(K-1,67)
     &                           *(1.0D0+KAITE_HHRD)*1.0D4 )/1.0D4
          DO 2110 X=68,115
            ID_HH_HON0(K,X)=ANINT( ID_HH_HON0(K-1,X-1)
     &                            *(1.0D0+KAITE_CIRD)*1.0D4 )/1.0D4
 2110     CONTINUE
C
          DIR(K)=ANINT( DIR(K-1)*ANINT(KOUJOR(K)*1.0D3)/1.0D3
     &                                                *1.0D3 ) / 1.0D3
        ELSE
C
          ID_HH_JUZEN(K)=ID_HH_JUZEN(K-1)*(1.0D0+KAITE_CI)
C
          ID_HH_HON0(K,67)=ID_HH_HON0(K-1,67)*(1.0D0+KAITE_HH)
          DO 2120 X=68,115
            ID_HH_HON0(K,X)=ID_HH_HON0(K-1,X-1)*(1.0D0+KAITE_CI)
 2120     CONTINUE
          DIR(K)=DIR(K-1)*KOUJOR(K)
        END IF
C
C
        ID_HH_HONJU8W(K,67)=MAX(MAX(ID_HH_JUZEN(K),ID_HH_HON0(K,67)),
     &                          ID_HH_HON0(K,67)*0.8D0               )
C
        ID_HH_TOKU(K,67)=ANINT( ID_HH_TOKU(K-1,67)*(1.0D0+HHD)
     &                                                 *1.0D4 )/1.0D4
        IF(K.EQ.6) ID_HH_TOKU(K,67)=0.9999D0
C
C
        ID_HH_SIKU(K,67)=MAX(ID_HH_HONJU8W(K,67),ID_HH_TOKU(K,67))
        IF(ID_HH_HONJU8W(K,67).LT.ID_HH_TOKU(K,67)) THEN
          ARV_HH(K,67)=1.0D0+HHD
        ELSE IF(K .LE. MARUME_YR .AND.
     &          ID_HH_HONJU8W(K-1,67).GE.ID_HH_TOKU(K-1,67))THEN
          ARV_HH(K,67)=ANINT(ID_HH_SIKU(K,67)/ID_HH_SIKU(K-1,67)
     &                                                  *1.0D3)/1.0D3
        ELSE
          ARV_HH(K,67)=ID_HH_SIKU(K,67)/ID_HH_SIKU(K-1,67)
        END IF
C
C
        IF(IDG_HP_HON8W(K-1,67).LT.IDG_HP_TOKU(K-1,67) .OR.
     &                                        K.LE.MARUME_YR) THEN
          IDR_HP_HON(K,67)=ANINT( IDR_HP_HON(K-1,67)*(1.0D0+KAITE_HPRD)
     &                                                   *1.0D3 )/1.0D3
          IDG_HP_HON8W(K,67)=ANINT( IDR_HP_HON(K,67)*7809D0 )
        ELSE
          IDR_HP_HON(K,67)=IDR_HP_HON(K-1,67)*(1.0D0+KAITE_HP)
          IDG_HP_HON8W(K,67)=IDG_HP_HON8W(K-1,67)*(1.0D0+KAITE_HP)
        END IF
        IDR_HP_TOKU(K,67)=ANINT( IDR_HP_TOKU(K-1,67)*(1.0D0+HHD)
     &                                                   *1.0D3 )/1.0D3
        IDG_HP_TOKU(K,67)=ANINT( IDR_HP_TOKU(K,67)*8042D0 )
C
C
        IDG_HP_SIKU(K,67)=MAX(IDG_HP_HON8W(K,67),IDG_HP_TOKU(K,67))
        IF(IDG_HP_HON8W(K,67).LT.IDG_HP_TOKU(K,67)) THEN
          ARV_HP(K,67)=1.0D0+HHD
        ELSE IF(K.LE.MARUME_YR .AND. 
     &          IDG_HP_HON8W(K-1,67).GE.IDG_HP_TOKU(K-1,67)) THEN
          ARV_HP(K,67)=ANINT(IDG_HP_SIKU(K,67)/IDG_HP_SIKU(K-1,67)
     &                                                    *1.0D3)/1.0D3
        ELSE
          ARV_HP(K,67)=IDG_HP_SIKU(K,67)/IDG_HP_SIKU(K-1,67)
        END IF
C
        DO 2130 X=68,115
C
          ID_HH_HONJU8W(K,X)=MAX(MAX(ID_HH_JUZEN(K),ID_HH_HON0(K,X)),
     &                           ID_HH_HON0(K,67)*0.8D0              )
C
          ID_HH_TOKU(K,X)=ANINT( ID_HH_TOKU(K-1,X-1)*(1.0D0+CID)
     &                                                    *1.0D4 )/1.0D4
          IF(K.EQ.6) ID_HH_TOKU(K,X)=0.9999D0
C
C
          ID_HH_SIKU(K,X)=MAX(ID_HH_HONJU8W(K,X),ID_HH_TOKU(K,X))
          IF(ID_HH_HONJU8W(K,X).LT.ID_HH_TOKU(K,X)) THEN
            ARV_HH(K,X)=1.0D0+CID
          ELSE IF(K.LE.MARUME_YR .AND. 
     &            ID_HH_HONJU8W(K-1,X-1).GE.ID_HH_TOKU(K-1,X-1)) THEN
            ARV_HH(K,X)=ANINT(ID_HH_SIKU(K,X)/ID_HH_SIKU(K-1,X-1)
     &                                                     *1.0D3)/1.0D3
          ELSE
            ARV_HH(K,X)=ID_HH_SIKU(K,X)/ID_HH_SIKU(K-1,X-1)
          END IF
C
C
          IF(IDG_HP_HON8W(K-1,X-1).LT.IDG_HP_TOKU(K-1,X-1)) THEN
            IDR_HP_HON(K,X)=ANINT( IDR_HP_HON(K-1,X-1)
     &                            *(1.0D0+KAITE_CIRD)*1.0D3 )/1.0D3
            IDG_HP_HON8W(K,X)=ANINT( MAX(IDR_HP_HON(K,X),
     &                                   IDR_HP_HON(K,67)*0.8D0)
     &                                                  *7809D0 )
          ELSE
            IDR_HP_HON(K,X)=IDR_HP_HON(K-1,X-1)*(1.0D0+KAITE_CI)
            IDG_HP_HON8W(K,X)=MAX( IDG_HP_HON8W(K,67)*0.8D0,
     &                          IDG_HP_HON8W(K-1,X-1)*(1.0D0+KAITE_CI))
          END IF
          IDR_HP_TOKU(K,X)=ANINT( IDR_HP_TOKU(K-1,X-1)*(1.0D0+CID)
     &                                                   *1.0D3 )/1.0D3
          IDG_HP_TOKU(K,X)=ANINT( IDR_HP_TOKU(K,X)*8042D0 )
C
C
          IDG_HP_SIKU(K,X)=MAX(IDG_HP_HON8W(K,X),IDG_HP_TOKU(K,X))
          IF(IDG_HP_HON8W(K,X).LT.IDG_HP_TOKU(K,X)) THEN
            ARV_HP(K,X)=1.0D0+CID
          ELSE IF(K.LE.MARUME_YR .AND.
     &            IDG_HP_HON8W(K-1,X-1).GE.IDG_HP_TOKU(K-1,X-1)) THEN
            ARV_HP(K,X)=ANINT(IDG_HP_SIKU(K,X)/IDG_HP_SIKU(K-1,X-1)
     &                                                    *1.0D3)/1.0D3
          ELSE
            ARV_HP(K,X)=IDG_HP_SIKU(K,X)/IDG_HP_SIKU(K-1,X-1)
          END IF
 2130   CONTINUE
C
        IF(TAMARI_CI.LT.0.0D0 .OR. K.LE.MARUME_YR) THEN
          HH(K)=KAITE_HHRD
          CI(K)=KAITE_CIRD
        ELSE
          HH(K)=KAITE_HH
          CI(K)=KAITE_CI
        END IF
C
        IF(ID_HH_JUZEN(K).LT.ID_HH_TOKU(K,67)) THEN
          CI2(K,67)=HHD
        ELSE IF(ID_HH_JUZEN(K-1).LT.ID_HH_TOKU(K-1,67)) THEN
          CI2(K,67)=ID_HH_JUZEN(K)/ID_HH_TOKU(K-1,67) - 1.0D0
        ELSE
          IF(CHINSURA.EQ.1 .AND. K.GE.21) THEN
            CI2(K,67)=CI(K)
          ELSE
            IF(HHD.LT.0.0D0 .AND. CID.GT.0.0D0) THEN
              CI2(K,67)=0.0D0
            ELSE
              CI2(K,67)=CI(K)
            END IF
          END IF
        END IF
        DO 2140 X=68,115
          IF(ID_HH_JUZEN(K).LT.ID_HH_TOKU(K,X)) THEN
            CI2(K,X)=CID
          ELSE IF(ID_HH_JUZEN(K-1).LT.ID_HH_TOKU(K-1,X-1)) THEN
            CI2(K,X)=ID_HH_JUZEN(K)/ID_HH_TOKU(K-1,X-1) - 1.0D0
          ELSE
            CI2(K,X)=CI(K)
          END IF
 2140   CONTINUE
C
        IF(IDG_HP_HON8W(K-1,67).LT.IDG_HP_TOKU(K-1,67)) THEN
          HP2(K,67)=ARV_HP(K,67)-1.0D0
        ELSE IF(K.LE.MARUME_YR) THEN
          HP2(K,67)=KAITE_HPRD
        ELSE
          HP2(K,67)=KAITE_HP
        END IF
        DO 2150 X=68,115
          IF(IDG_HP_HON8W(K-1,X-1).LT.IDG_HP_TOKU(K-1,X-1)) THEN
            HP2(K,X)=ARV_HP(K,X)-1.0D0
          ELSE IF(K.LE.MARUME_YR) THEN
            HP2(K,X)=KAITE_CIRD
          ELSE
            HP2(K,X)=KAITE_CI
          END IF
 2150   CONTINUE
C
        TAMARI_CI=ANINT( (TAMARI_CI+KAITE_CIRD-CID)*1.0D3 )/1.0D3
C
 2100 CONTINUE
C
      HH2(-1)=0.4D-2
      HH2(0) =0.7D-2
      HH2(1) =0.8D-2
      DO 4000 K=1,4
        CI(K)=0.0D0
        IF(K.EQ.3 .OR. K.EQ.4) CI(K)=CI0(K-1)
        DO 4010 X=67,115
          CI2(K,X)=CI(K)
          HP2(K,X)=CI(K)
 4010   CONTINUE
 4000 CONTINUE
C
      DO 5000 J=1,23
        DO 5200 K=1,KE
          IF(J.LE.14 .AND. J.NE.13) THEN
            IF(K.LE.3) THEN
              RV(K,J)=CI(K)
              IF(K.EQ.1 .OR. K.EQ.2) RV(K,J)=0.0D0
            ELSE IF(K.EQ.4) THEN
              IF(J.EQ.1 .OR. J.EQ.10) THEN
                RV(K,J)=(1.0D0+CI0(3))*
     &                   ANINT( (1.0D0+HH2(-1))
     &                         *(1.0D0+HH2(0) )
     &                         *(1.0D0+HH2(1) ) *1.0D3 ) / 1.0D3
                RV(K,J)=ANINT( RV(K,J)*1.0D3 )/1.0D3 - 1.0D0
              ELSE
                RV(K,J)=HP2(K,67)
              END IF
            ELSE
              IF(J.EQ.1 .OR. J.EQ.10) THEN
                RV(K,J)=HH(K)
              ELSE
                RV(K,J)=HP2(K,67)
              END IF
            END IF
          ELSE IF(J.EQ.13) THEN
            RV(K,J)=0.0D0
          ELSE
            RV(K,J)=RV(K,SAME(J))
          END IF
C
 5200   CONTINUE
 5000 CONTINUE
C
      AD(KIJUN)=1.0D0
      DO 6100 K=KIJUN+1,KE
        AD(K)=AD(K-1)*(1.0D0+H(K))
        IF(K.LE.MARUME_YR)THEN
          AD(K) = ANINT(AD(K) * 1.0D3) / 1.0D3
        END IF
 6100 CONTINUE
      AD2(4)=0.988D0
      DO 6200 K=5,KIJUN
        IF(K.EQ.15)THEN
            AD2(K)=AD2(K-1)*(1.0D0+HP2(K,67))*0.991D0
        ELSE
            AD2(K)=AD2(K-1)*(1.0D0+HP2(K,67))
        END IF
        IF(K.LE.MARUME_YR)THEN
          AD2(K) = ANINT(AD2(K) * 1.0D3) / 1.0D3
        END IF
 6200 CONTINUE
      DO 6300 J=1,23
        BD(KIJUN,J)=1.0D0
        DO 6400 K=KIJUN+1,KE
          BD(K,J)=BD(K-1,J)*(1.0D0+RV(K,J))
          IF(K.LE.MARUME_YR)THEN
            BD(K,J) = ANINT(BD(K,J) * 1.0D3) / 1.0D3
          END IF
 6400   CONTINUE
 6300 CONTINUE
C
C     年金改定率の出力
C
      IF(KAITE.EQ.1 .AND.
     &   ((SEIDN.LE.6 .AND. SEIDN.NE.0) .OR. 
     &    ((SEIDN.EQ.0 .OR. SEIDN.GE.7) .AND. PSEID.EQ.0))) THEN
        DO 7000 K=5, FLKE
          IF(K.GE.5 .AND. K.LE.KE) THEN
            WRITE(23,8400) K,(ARV_HH(K,X),X=67,115)
            WRITE(22,8400) K,(ARV_HP(K,X),X=67,115)
          ELSE
            WRITE(23,8400) K,(0.0D0,X=67,115)
            WRITE(22,8400) K,(0.0D0,X=67,115)
          END IF
 7000   CONTINUE
      END IF
C
      WRITE(01,8100)
      WRITE(01,8200)
      DO 7400 K=1,KE
        WRITE(01,8300) K,RI(K),H(K),CI(K),RV(K,1),
     &                 RV(K,4),RV(K,14),CI2(K,67)
 7400 CONTINUE
C
C
 8000 FORMAT(1H ,'利回りは',F5.2,'％','  賃金は',F5.2,'％','  物価は'
     &       ,F5.2,'％')
 8100 FORMAT('経済的要素')
 8200 FORMAT('年度,利回り,賃金,物価,改定率(比例),',
     &       '改定率(加給),改定率(基礎),改定率(物価)')
 8300 FORMAT(I5,',',7(F8.5,','))
 8400 FORMAT(I3,',',49(F17.14,','))
C
C
      RETURN
C
      END
C
C
C     **********************************************
C     **                                          **
C     **   実質賃金と可処分所得割合変化率の設定   **
C     **      （名目手取り賃金改定率算出用）      **
C     **                                          **
C     **********************************************
C
C
      SUBROUTINE     JITSUCHIN_KASHOBUN
C
C
      IMPLICIT INTEGER(A-Z)
      INCLUDE 'seps.inc'
C
      COMMON /INECON/JH_KAITE,KOUJOR
      REAL*8 JH_KAITE(5:ECEDY),KOUJOR(5:ECEDY)
      REAL*8 PREMA(3:ECEDY)
C
      DO 1000 K=5,KE
        JH_KAITE(K)=( ((1.0D0+H(K-4))*(1.0D0+H(K-3))
     &               *(1.0D0+H(K-2))) / ((1.0D0+CI0(K-4))
     &               *(1.0D0+CI0(K-3))*(1.0D0+CI0(K-2))) )
     &               **(1.0D0/3.0D0)
 1000 CONTINUE
C
      PREMA(3)=13.58D-2
      DO 2000 K=4,KE
        PREMA(K)=PREMA(K-1)+0.354D-2
        IF(PREMA(K).GT.18.3D-2) PREMA(K)=18.3D-2
 2000 CONTINUE
      DO 3000 K=5,KE
        IF(K.LE.6) THEN
          KOUJOR(K)=1.0D0
        ELSE
          KOUJOR(K)=(0.910D0-PREMA(K-3)/2.0D0)
     &             /(0.910D0-PREMA(K-4)/2.0D0)
        END IF
C
 3000 CONTINUE
C
C
      RETURN
C
      END
C
