C
C     ******************************************
C     **                                      **
C     **    遺族年金への老齢年金先充て処理    **
C     **                                      **
C     ******************************************
C
C
      SUBROUTINE      ROUSAKI
C
C
      IMPLICIT INTEGER (A-Z)
      INCLUDE 'seps.inc'
C
C
      REAL*8 DTEMP,RTEMP,SINROU(1:3,0:4),KK
C
      DO 1000 K=KIJUN+1,KE
      DO 1010 X=75,114
        IF(X.GE.66+K-7 .AND. X.LE.90+K-KIJUN) THEN
          CALL SUBC2(SINROU,1,3,1,3,0,4,0,4)
          DO 1011 I=1,4
          DO 1012 S=1,3
            IF(PSEID.NE.0 .AND. S.EQ.3) GO TO 1012
            IF(S.NE.2) THEN
              S3=1
            ELSE
              S3=2
            END IF
            DO 1013 J=7,10
              SINROU(S,0)=SINROU(S,0)+D3XS(K,X,S,I,J)
     &                                *(1.0D0-SIK(K,X,S3,I,1))
              SINROU(S,I)=SINROU(S,I)+D3XS(K,X,S,I,J)
     &                                *(1.0D0-SIK(K,X,S3,I,1))
 1013       CONTINUE
 1012     CONTINUE
 1011     CONTINUE
          IF(SINROU(1,0)+SINROU(3,0).LE.0.0D0) THEN
             SINROU(1,0)=1.0D0
             SINROU(1,1)=1.0D0
          END IF
          IF(SINROU(2,0).LE.0.0D0) THEN
             SINROU(2,0)=1.0D0
             SINROU(2,1)=1.0D0
          END IF
C
          DO 1020 J=1,58
            JJ=-1
            IF(J.EQ.1 .OR. J.EQ.7  .OR. J.EQ.13 .OR.
     &         J.EQ.35 .OR. J.EQ.41                )  JJ=J
            IF(J.EQ.5 .OR. J.EQ.11 .OR. J.EQ.17 .OR.
     &         J.EQ.39 .OR. J.EQ.45                )  JJ=J-2
            IF(JJ.LT.0) CYCLE
C
            DO 1030 S=1,3
              IF(PSEID.NE.0 .AND. S.EQ.3) CYCLE
              IF(S.NE.2) THEN
                S3=1
              ELSE
                S3=2
              END IF
              RTEMP=SIK(KIJUN,X,S3,11,1)-SIK(K,X,S3,11,1)
C
              IF(RTEMP.LT.-1.0D-8 .AND. S.NE.2) THEN
                WRITE(6,*) '遺族の支給率がうまく設定できていない'
     &                     //'可能性があります(rousaki.f)'
                WRITE(6,*) '(K,X,S3,RTEMP)=',K,X,S3,RTEMP
              END IF
              IF(RTEMP.LT.0.0D0) RTEMP=0.0D0
C
C
              IF(JJ.EQ.J) THEN
                DTEMP=D3XS(K,X,S,11,J)*RTEMP
              ELSE
                DTEMP=D3XS(K,X,S,11,J)*RTEMP*(1.0D0-RC(S,K,X))
              END IF
C
              IF(DTEMP.LE.0.0D0) GO TO 1030
C
C
              DO 1050 SS=1,3
                IF(PSEID.NE.0 .AND. SS.EQ.3) GO TO 1050
                IF((S.EQ.2 .AND. SS.EQ.2) .OR.
     &             (S.NE.2 .AND. SS.NE.2)      ) GO TO 1050
C
                IF(SS.NE.3) THEN
                  KK=EE(1)
                ELSE
                  KK=EE(2)
                END IF
                IF(SS.NE.2) THEN
                  RTEMP=SINROU(1,0)+SINROU(3,0)
                ELSE
                  RTEMP=SINROU(2,0)
                END IF
C
                DO 1080 I=1,4
                  D3X(K,X,SS,I,JJ)=D3X(K,X,SS,I,JJ)
     &                             +DTEMP*SINROU(SS,I)/RTEMP
                  D3(K,SS,I,JJ,2) =D3(K,SS,I,JJ,2)
     &                             +DTEMP*SINROU(SS,I)/RTEMP
                  IF(JJ.EQ.13 .AND. (I.EQ.1 .OR. I.EQ.3)) THEN
                    D3X(K,X,SS,I,26)=D3X(K,X,SS,I,26)
     &                               +DTEMP*SINROU(SS,I)/RTEMP*KK
                    D3(K,SS,I,26,2) =D3(K,SS,I,26,2)
     &                               +DTEMP*SINROU(SS,I)/RTEMP*KK
                  ELSE IF(JJ.EQ.15 .AND. (I.EQ.1 .OR. I.EQ.3)) THEN
                    D3X(K,X,SS,I,27)=D3X(K,X,SS,I,27)
     &                               +DTEMP*SINROU(SS,I)/RTEMP*KK
                    D3(K,SS,I,27,2) =D3(K,SS,I,27,2)
     &                               +DTEMP*SINROU(SS,I)/RTEMP*KK
                  END IF
 1080           CONTINUE
 1050         CONTINUE
C
 1030       CONTINUE
 1020     CONTINUE
        END IF
 1010 CONTINUE
 1000 CONTINUE
C
C
      RETURN
C
      END
C
