C
C     ************************************************************
C     **                                                        **
C     **            Ｋ年度、Ｘ歳の被保険者データを作成          **
C     **                                                        **
C     ************************************************************
C
C
      SUBROUTINE      SIMLG(X,XRB)
C
      IMPLICIT INTEGER (A-Z)
      INCLUDE 'seps.inc'
      INCLUDE 'siml.inc'
C
C
      COMMON /K/ K
      COMMON /S/ S,S2
C
      REAL*8 TM(0:4)
      REAL*8 GEZZ(14:115,0:100)
      REAL*8 TMP,TMQ,TMR1,TMR2,TMZ,TMV
C
C
      GZ(X,0)  =0.0D0
      GZPT(X,0)=0.0D0
      DO 1000 T=1,TEND-2
        GZ(X,T)=G(X-1,T-1)*EXP(-U(K,X,0))
        IF(K.GT.PARTYR1 .AND. S.LE.2 .AND. PSEID.EQ.0) THEN
          GZPT(X,T)=GPT(X-1,T-1)*EXP(-U(K,X,0))
          GZ(X,T)=GZ(X,T)-GZPT(X,T)
        END IF
 1000 CONTINUE
      GZ(X,TEND-1)=(G(X-1,TEND-2)+G(X-1,TEND-1))*EXP(-U(K,X,0))
      IF(K.GT.PARTYR1 .AND. S.LE.2 .AND. PSEID.EQ.0) THEN
        GZPT(X,TEND-1)=(GPT(X-1,TEND-2)+GPT(X-1,TEND-1))*EXP(-U(K,X,0))
        GZ(X,TEND-1)=GZ(X,TEND-1)-GZPT(X,TEND-1)
      END IF
C
      DO 1010 T=0,TEND-1
        GEZZ(X,T)=GE(X-1,T)*(1.0D0-Q(K,X,1))
        YE(X,T)  =GE(X-1,T)-GEZZ(X,T)
 1010 CONTINUE
C
      TMP=GEZZ(X,0)
      TMQ=0.0D0
      TMV=0.0D0
      DO 1020 T=1,TEND-1
        TMP=TMP+GEZZ(X,T)
        TMQ=TMQ+GZ(X,T)
        TMV=TMV+GZPT(X,T)
 1020 CONTINUE
C
      IF(L(K,S,X).LT.TMQ) THEN
        DO 1050 T=1,TEND-1
          IF(TMQ.GT.1.0D-6) THEN
            GZ(X,T)=GZ(X,T)*L(K,S,X)/TMQ
          ELSE
            GZ(X,T)=0.0D0
          END IF
 1050   CONTINUE
        TMQ=L(K,S,X)
      END IF
      
      IF(FLG_PART.GE.1 .AND. K.EQ.PARTYR2 .AND. S.LE.2 .AND.
     &   PSEID.EQ.0                                    ) THEN
        IF((LPT(K,S,X)-LPT1(K,S,X)).LT.TMV) THEN
          DO 1060 T=1,TEND-1
            IF(TMV.GT.1.0D-6) THEN
              GZPT(X,T)=GZPT(X,T)*(LPT(K,S,X)-LPT1(K,S,X))/TMV
            ELSE
              GZPT(X,T)=0.0D0
            END IF
 1060     CONTINUE
          TMV=(LPT(K,S,X)-LPT1(K,S,X))
        END IF
      ELSE IF(K.GT.PARTYR1 .AND. S.LE.2 .AND. PSEID.EQ.0) THEN
        IF(LPT(K,S,X).LT.TMV) THEN
          DO 1070 T=1,TEND-1
            IF(TMV.GT.1.0D-6) THEN
              GZPT(X,T)=GZPT(X,T)*LPT(K,S,X)/TMV
            ELSE
              GZPT(X,T)=0.0D0
            END IF
 1070     CONTINUE
          TMV=LPT(K,S,X)
        END IF
      END IF
C
      TMR2=0.0D0
      IF(S.LE.2) THEN
        IF(TMP+TMQ+TMV.LT.POP(K,S,X)) THEN
          TMR1=MIN(1.0D0,MAX(RT(K,X),TMP/(POP(K,S,X)-TMQ-TMV)))
     &            *(L(K,S,X)-TMQ)
          IF(K.GE.PARTYR1 .AND. PSEID.EQ.0) THEN
            IF(K.EQ.PARTYR1) THEN
              TMR2=RT(K,X)*MIN(1.0D0,MAX(0.0D0,DBLE(X-25)/40.0D0))
     &             *LPT(K,S,X)
            ELSE IF(FLG_PART.GE.1 .AND. K.EQ.PARTYR2) THEN
              TMR2= MIN(1.0D0,MAX(RT(K,X),TMP/(POP(K,S,X)-TMQ-TMV)))
     &              *(LPT(K,S,X)-LPT1(K,S,X)-TMV)
     &             +RT(K,X)*MIN(1.0D0,MAX(0.0D0,DBLE(X-25)/40.0D0))
     &              *(LPT1(K,S,X))
            ELSE
              TMR2=MIN(1.0D0,MAX(RT(K,X),TMP/(POP(K,S,X)-TMQ-TMV)))
     &              *(LPT(K,S,X)-TMV)
            END IF
          END IF
        ELSE
          TMR1=MAX(0.0D0,L(K,S,X)-TMQ)
          IF(K.GE.PARTYR1 .AND. PSEID.EQ.0) THEN
            TMR2=MAX(0.0D0,LPT(K,S,X)-TMV)
          END IF
        END IF
      ELSE
        TMR1=RT(K,X)*MAX(0.0D0,L(K,S,X)-TMQ)
      END IF
C
      DO 1200 T=0,TEND-1
        IF(X.LE.XRB .AND. TMP.GT.1.0D-6) THEN
          IF(K.GE.PARTYR1 .AND. S.LE.2 .AND.PSEID.EQ.0) THEN
            IF(TMP.GE.TMR1+TMR2) THEN
              GN(X,T)  =GEZZ(X,T)*TMR1/TMP
              GNPT(X,T)=GEZZ(X,T)*TMR2/TMP
            ELSE
              IF(TMR1+TMR2.GT.1.0D-6) THEN
                GN(X,T)  =GEZZ(X,T)*TMR1/(TMR1+TMR2)
                GNPT(X,T)=GEZZ(X,T)*TMR2/(TMR1+TMR2)
              ELSE
                GN(X,T)=0.0D0
                GNPT(X,T)=0.0D0
              END IF
            END IF
          ELSE
            IF(TMP.GE.TMR1) THEN
              GN(X,T)=GEZZ(X,T)*TMR1/TMP
            ELSE
              GN(X,T)=GEZZ(X,T)
            END IF
            GNPT(X,T)=0.0D0
          END IF
        ELSE
          GN(X,T)=0.0D0
          GNPT(X,T)=0.0D0
        END IF
        GEZ(X,T)=MAX(0.0D0,GEZZ(X,T)-GN(X,T)-GNPT(X,T))
 1200 CONTINUE
C
C
      GNN(X)=L(K,S,X)-GN(X,0)
      DO 1210 T=1,TEND-1
        GNN(X)=GNN(X)-GZ(X,T)-GN(X,T)
 1210 CONTINUE
      IF (ABS(GNN(X)).LT.1.0D-6) THEN
        L(K,S,X)=L(K,S,X)-GNN(X)
        GNN(X)=0.0D0
      END IF
C
      G(X,TEND-1)=GZ(X,TEND-1)+GN(X,TEND-1)
      IF(K.GT.PARTYR1 .AND. S.LE.2 .AND. PSEID.EQ.0) THEN
        Y(X,TEND-1,0)=G(X-1,TEND-2)+G(X-1,TEND-1)
     &               -GPT(X-1,TEND-2)-GPT(X-1,TEND-1)
     &               -GZ(X,TEND-1)
        TM(0)=(G(X-1,TEND-2)+G(X-1,TEND-1)
     &         -GPT(X-1,TEND-2)-GPT(X-1,TEND-1)+GZ(X,TEND-1))/2.0D0
      ELSE
        Y(X,TEND-1,0)=G(X-1,TEND-2)+G(X-1,TEND-1)-GZ(X,TEND-1)
        TM(0)=(G(X-1,TEND-2)+G(X-1,TEND-1)+GZ(X,TEND-1))/2.0D0
      END IF
      Y(X,TEND-1,2)=TM(0)*U(K,X,2)
      Y(X,TEND-1,3)=TM(0)*U(K,X,3)
      Y(X,TEND-1,1)=Y(X,TEND-1,0)-Y(X,TEND-1,2)-Y(X,TEND-1,3)
      IF(Y(X,TEND-1,1).LT.-1.0D-12) THEN
        IF(X.LE.XRB .OR. Y(X,TEND-1,1).LT.-1.0D-2) THEN
          WRITE(6,'(A,3I,F12.8)') '生存脱退エラー',K,X,T,Y(X,TEND-1,1)
          STOP
        ELSE
          Y(X,TEND-1,1)=0.0D0
          TMP=Y(X,TEND-1,2)+Y(X,TEND-1,3)
          IF(TMP.GT.1.0D-12) THEN
            Y(X,TEND-1,2)=Y(X,TEND-1,0)*Y(X,TEND-1,2)/TMP
            Y(X,TEND-1,3)=Y(X,TEND-1,0)*Y(X,TEND-1,3)/TMP
          ELSE
            Y(X,TEND-1,0)=0.0D0
            Y(X,TEND-1,2)=0.0D0
            Y(X,TEND-1,3)=0.0D0
          END IF
        END IF
      END IF
      GE(X,TEND-1)=GEZ(X,TEND-1)+Y(X,TEND-1,1)
      DO 1220 T=TEND-2,1,-1
        G(X,T)=GZ(X,T)+GN(X,T)
        IF(K.GT.PARTYR1 .AND. S.LE.2 .AND. PSEID.EQ.0) THEN
          Y(X,T,0)=G(X-1,T-1)-GPT(X-1,T-1)-GZ(X,T)
          TM(0)=(G(X-1,T-1)-GPT(X-1,T-1)+GZ(X,T))/2.0D0
        ELSE
          Y(X,T,0)=G(X-1,T-1)-GZ(X,T)
          TM(0)=(G(X-1,T-1)+GZ(X,T))/2.0D0
        END IF
        Y(X,T,2)=TM(0)*U(K,X,2)
        Y(X,T,3)=TM(0)*U(K,X,3)
        Y(X,T,1)=Y(X,T,0)-Y(X,T,2)-Y(X,T,3)
        IF(Y(X,T,1).LT.-1.0D-12) THEN
          IF(X.LE.XRB .OR. Y(X,T,1).LT.-1.0D-2) THEN
            WRITE(6,'(A,3I,F12.8)') '生存脱退エラー',K,X,T,Y(X,T,1)
          ELSE
            Y(X,T,1)=0.0D0
            TMP=Y(X,T,2)+Y(X,T,3)
            IF(TMP.GT.1.0D-12) THEN
              Y(X,T,2)=Y(X,T,0)*Y(X,T,2)/TMP
              Y(X,T,3)=Y(X,T,0)*Y(X,T,3)/TMP
            ELSE
              Y(X,T,0)=0.0D0
              Y(X,T,2)=0.0D0
              Y(X,T,3)=0.0D0
            END IF
          END IF
        END IF
        GE(X,T)=GEZ(X,T)+Y(X,T,1)
 1220 CONTINUE
      G(X,0) =GN(X,0)+GNN(X)
      GE(X,0)=GEZ(X,0)
C
C
      IF(K.GE.PARTYR1 .AND. S.LE.2 .AND. PSEID.EQ.0) THEN
        GNNPT(X)=LPT(K,S,X)-GNPT(X,0)
        DO 1300 T=1,TEND-1
          GNNPT(X)=GNNPT(X)-GZPT(X,T)-GNPT(X,T)
 1300   CONTINUE
        IF(ABS(GNNPT(X)).LT.1.0D-6) THEN
          LPT(K,S,X)=LPT(K,S,X)-GNNPT(X)
          GNNPT(X)=0.0D0
        ELSE IF(GNNPT(X).LE.-1.0D-6) THEN
          WRITE(6,*) X,'歳の新規加入者数エラー,GNNPT=,',GNNPT(X)
          STOP
        END IF
C
        GPT(X,TEND-1)=GZPT(X,TEND-1)+GNPT(X,TEND-1)
        YPT(X,TEND-1,0)=GPT(X-1,TEND-2)+GPT(X-1,TEND-1)-GZPT(X,TEND-1)
        TM(0)=(GPT(X-1,TEND-2)+GPT(X-1,TEND-1)+GZPT(X,TEND-1))/2.0D0
        YPT(X,TEND-1,2)=TM(0)*U(K,X,2)
        YPT(X,TEND-1,3)=TM(0)*U(K,X,3)
        YPT(X,TEND-1,1)=YPT(X,TEND-1,0)-YPT(X,TEND-1,2)-YPT(X,TEND-1,3)
        IF(YPT(X,TEND-1,1).LT.-1.0D-12) THEN
          IF(X.LE.XRB .OR. YPT(X,TEND-1,1).LT.-1.0D-2) THEN
            WRITE(6,'(A,I,F10.5)') '生存脱退エラーPT',K,YPT(X,TEND-1,1)
            STOP
          ELSE
            YPT(X,TEND-1,1)=0.0D0
            TMP=YPT(X,TEND-1,2)+YPT(X,TEND-1,3)
            IF(TMP.GT.1.0D-12) THEN
              YPT(X,TEND-1,2)=YPT(X,TEND-1,0)*YPT(X,TEND-1,2)/TMP
              YPT(X,TEND-1,3)=YPT(X,TEND-1,0)*YPT(X,TEND-1,3)/TMP
            ELSE
              YPT(X,TEND-1,0)=0.0D0
              YPT(X,TEND-1,2)=0.0D0
              YPT(X,TEND-1,3)=0.0D0
            END IF
          END IF
        END IF
        DO 1310 T=TEND-2,1,-1
          GPT(X,T)=GZPT(X,T)+GNPT(X,T)
          YPT(X,T,0)=GPT(X-1,T-1)-GZPT(X,T)
          TM(0)=(GPT(X-1,T-1)+GZPT(X,T))/2.0D0
          YPT(X,T,2)=TM(0)*U(K,X,2)
          YPT(X,T,3)=TM(0)*U(K,X,3)
          YPT(X,T,1)=YPT(X,T,0)-YPT(X,T,2)-YPT(X,T,3)
          IF(YPT(X,T,1).LT.-1.0D-12) THEN
            IF(X.LE.XRB .OR. YPT(X,T,1).LT.-1.0D-2) THEN
              WRITE(6,'(A,I,F10.5)') '生存脱退エラーPT',K,YPT(X,T,1)
              STOP
            ELSE
              YPT(X,T,1)=0.0D0
              TMP=YPT(X,T,2)+YPT(X,T,3)
              IF(TMP.GT.1.0D-12) THEN
                YPT(X,T,2)=YPT(X,T,0)*YPT(X,T,2)/TMP
                YPT(X,T,3)=YPT(X,T,0)*YPT(X,T,3)/TMP
              ELSE
                YPT(X,T,0)=0.0D0
                YPT(X,T,2)=0.0D0
                YPT(X,T,3)=0.0D0
              END IF
            END IF
          END IF
 1310   CONTINUE
        GPT(X,0)= GNPT(X,0)+GNNPT(X)
C
        DO 1320 T=1,TEND-1
          G(X,T)=G(X,T)+GPT(X,T)
          Y(X,T,0)=Y(X,T,0)+YPT(X,T,0)
          Y(X,T,1)=Y(X,T,1)+YPT(X,T,1)
          Y(X,T,2)=Y(X,T,2)+YPT(X,T,2)
          Y(X,T,3)=Y(X,T,3)+YPT(X,T,3)
          GE(X,T)=GE(X,T)+YPT(X,T,1)
C
          GN(X,T)=GN(X,T)+GNPT(X,T)
          GZ(X,T)=GZ(X,T)+GZPT(X,T)
 1320   CONTINUE
        G(X,0)=G(X,0)+GPT(X,0)
        GN(X,0)=GN(X,0)+GNPT(X,0)
        GNN(X)=GNN(X)+GNNPT(X)
C
      END IF
C
      IF(X.GE.61) THEN
        TMZ=GZ(X,0)
        DO 1400 T=1,TEND-1
          TMZ=TMZ+GZ(X,T)
 1400   CONTINUE
C
        IF(PSEID.EQ.0 .AND. S.LE.2) THEN
          IF(L(K-1,S,X-1)+LPT(K-1,S,X-1).GT.1.0D-6) THEN
            Q2(K,X)=1.0D0-MAX(0.0D0,
     &                    MIN(1.0D0,TMZ/(L(K-1,S,X-1)+LPT(K-1,S,X-1))))
          ELSE
            Q2(K,X)=1.0D0
          END IF
        ELSE
          IF(L(K-1,S,X-1).GT.1.0D-6) THEN
            Q2(K,X)=1.0D0-MAX(0.0D0,MIN(1.0D0,TMZ/(L(K-1,S,X-1))))
          ELSE
            Q2(K,X)=1.0D0
          END IF
        END IF
      END IF
C
C
      RETURN
C
      END
C
