      PROGRAM SHUUFUKU
C
C     KOUZOUBUTSU NO SHUUFUKU HIYOU WO KEISAN SURU NZ)
C 
C     PARAMATER: NZ------SOUSUU
C                DELT--- KAKUKAI OUTOU SOUKAN HENKEI
C                AC------HOUKOU KAKUKAI OUTOU KASOKUDO
C                AREA----KAKUKAI YUKA MENSEKI
C
C     CODED BY: TATSUO INADA (2011.6.22)
C
      INTEGER NZ
      REAL DELT(99),AC(99),HE(99),
     $     AREA(99),ARRAT(99),CRAT(9),
     $     FHKUTAI(2,5),FHNGS(2,3,8),FKRAT(5,9),
     $     FKC,FKRB(9,99)
      CHARACTER*20 FILENM

C
C                                       **DATA INPUT**
C
      READ(5,*) FILENM
      OPEN (UNIT=7, FILE=FILENM, ACCESS='SEQUENTIAL',
     &      STATUS='OLD', FORM='FORMATTED',
     &      IOSTAT=IOS)
      OPEN (UNIT=8, FILE='LOG08', ACCESS='SEQUENTIAL',
     &      STATUS='UNKNOWN', FORM='FORMATTED',
     &      IOSTAT=IOS)
      READ(7,*) NZ
      READ(7,*) (HE(IZ),IZ=1,NZ)
      READ(7,*) (DELT(IZ),IZ=1,NZ)
      READ(7,*) (AC(IZ),IZ=1,NZ)
      READ(7,*) (AREA(IZ),IZ=1,NZ)
      READ(7,*) (CRAT(I),I=1,9)
      CALL LOGOUT(CRAT,9,1,1)
C
C                                       **DATA TEIGI**
C
      CALL ARRTST(AREA,NZ,ARRAT)
      CALL LOGOUT(CRAT,9,1,1)
      CALL TEIGI(FHKUTAI,FHNGS,FKRAT)
      CALL LOGOUT(CRAT,9,1,1)
C
C                                       **HIGAIDO NO SETTEI**
C
      CALL FKRB1(HE,DELT,FHKUTAI,FKRAT,NZ,FKRB)
      CALL FKRB2(HE,DELT,FHNGS,FKRAT,NZ,FKRB)
      CALL FKRB3(AC,FHNGS,FKRAT,NZ,FKRB)
C
C                                      **SHUUFUKU HIYOU NO KEISAN**
C
      CALL LOGOUT(CRAT,9,1,1)
      CALL FKRSET(ARRAT,CRAT,FKRB,NZ,FKC)
C
C                                       **DATA OUTPUT**
C
      CALL LOGOUT(ARRAT,NZ,1,1)
      CALL LOGOUT(CRAT,9,1,1)
      CALL LOGOUT(FKRB,9,NZ,1)
      WRITE(6,*) FKC
      STOP
      END
      SUBROUTINE LOGOUT(AAA,N1,N2,N3)
      REAL AAA(N1,N2,N3)
      DO 20 I3=1,N3
          DO 10 I2=1,N2
              WRITE(8,1010)(AAA(I1,I2,I3),I1=1,N1)
 1010         FORMAT(1H ,5E15.7)
   10     CONTINUE
   20 CONTINUE
      RETURN
      END
      SUBROUTINE ARRTST(AREA,NZ,ARRAT)
      INTEGER NZ
      REAL AREA(NZ),ARRAT(NZ),AA
      AA=0.0
      DO 10 IZ=1,NZ
          AA=AA+AREA(IZ)
   10 CONTINUE
      DO 20 IZ=1,NZ
          ARRAT(IZ)=AREA(IZ)/AA
   20 CONTINUE
      RETURN
      END
      SUBROUTINE TEIGI(FHKUTAI,FHNGS,FKRAT)
      REAL FHKUTAI(2,5),FHNGS(2,3,8),FKRAT(5,9)
C
      FHKUTAI(1,1)=1/60.0
      FHKUTAI(2,1)=1.0/100.0
      FHKUTAI(1,2)=1.0/100.0
      FHKUTAI(2,2)=1.0/200.0
      FHKUTAI(1,3)=1.0/200.0
      FHKUTAI(2,3)=1.0/400.0
      FHKUTAI(1,4)=1.0/400.0
      FHKUTAI(2,4)=1.0/900.0
      FHKUTAI(1,5)=1.0/900.0
      FHKUTAI(2,5)=0.0
C
      FHNGS(1,1,1)=999.0
      FHNGS(2,1,1)=1.0/100.0
      FHNGS(1,2,1)=1.0/100.0
      FHNGS(2,2,1)=1.0/200.0
      FHNGS(1,3,1)=1.0/200.0
      FHNGS(2,3,1)=1.0/400.0
      FHNGS(1,1,2)=999.0
      FHNGS(2,1,2)=1.0/100.0
      FHNGS(1,2,2)=1.0/100.0
      FHNGS(2,2,2)=1.0/200.0
      FHNGS(1,3,2)=1.0/200.0
      FHNGS(2,3,2)=1.0/400.0
      FHNGS(1,1,3)=9999.0
      FHNGS(2,1,3)=1500.0
      FHNGS(1,2,3)=1500.0
      FHNGS(2,2,3)=1000.0
      FHNGS(1,3,3)=1000.0
      FHNGS(2,3,3)=600.0
      FHNGS(1,1,4)=999.0
      FHNGS(2,1,4)=1.0/100.0
      FHNGS(1,2,4)=1.0/100.0
      FHNGS(2,2,4)=1.0/200.0
      FHNGS(1,3,4)=1.0/200.0
      FHNGS(2,3,4)=1.0/400.0
      FHNGS(1,1,5)=999.0
      FHNGS(2,1,5)=1.0/100.0
      FHNGS(1,2,5)=1.0/100.0
      FHNGS(2,2,5)=1.0/200.0
      FHNGS(1,3,5)=1.0/200.0
      FHNGS(2,3,5)=1.0/400.0
      FHNGS(1,1,6)=9999.0
      FHNGS(2,1,6)=1500.0
      FHNGS(1,2,6)=1500.0
      FHNGS(2,2,6)=1000.0
      FHNGS(1,3,6)=1000.0
      FHNGS(2,3,6)=600.0
      FHNGS(1,1,7)=9999.0
      FHNGS(2,1,7)=1500.0
      FHNGS(1,2,7)=1500.0
      FHNGS(2,2,7)=1000.0
      FHNGS(1,3,7)=1000.0
      FHNGS(2,3,7)=600.0
      FHNGS(1,1,8)=9999.0
      FHNGS(2,1,8)=1500.0
      FHNGS(1,2,8)=1500.0
      FHNGS(2,2,8)=1000.0
      FHNGS(1,3,8)=1000.0
      FHNGS(2,3,8)=600.0
C
      FKRAT(1,1)=0.5
      FKRAT(2,1)=0.2
      FKRAT(3,1)=0.05
      FKRAT(4,1)=0
      FKRAT(5,1)=0
      FKRAT(1,2)=0.5
      FKRAT(2,2)=0.2
      FKRAT(3,2)=0.05
      FKRAT(4,2)=0.01
      FKRAT(5,2)=0
      FKRAT(1,3)=0.5
      FKRAT(2,3)=0.2
      FKRAT(3,3)=0.05
      FKRAT(4,3)=0
      FKRAT(5,3)=0
      FKRAT(1,4)=0.5/2.0
      FKRAT(2,4)=0.2/2.0
      FKRAT(3,4)=0.05/2.0
      FKRAT(4,4)=0.01
      FKRAT(5,4)=0
      FKRAT(1,5)=0.5
      FKRAT(2,5)=0.2
      FKRAT(3,5)=0.05
      FKRAT(4,5)=0
      FKRAT(5,5)=0
      FKRAT(1,6)=0.5
      FKRAT(2,6)=0.2
      FKRAT(3,6)=0.05
      FKRAT(4,6)=0
      FKRAT(5,6)=0
      FKRAT(1,7)=0.5
      FKRAT(2,7)=0.2
      FKRAT(3,7)=0.05
      FKRAT(4,7)=0.01
      FKRAT(5,7)=0
      FKRAT(1,8)=0.5
      FKRAT(2,8)=0.2
      FKRAT(3,8)=0.05
      FKRAT(4,8)=0.01
      FKRAT(5,8)=0
      FKRAT(1,9)=0.5
      FKRAT(2,9)=0.2
      FKRAT(3,9)=0.05
      FKRAT(4,9)=0.01
      FKRAT(5,9)=0
C
      RETURN
      END
C
      SUBROUTINE FKRB1(HE,DELT,FHKUTAI,FKRAT,NZ,FKRB)
      INTEGER NZ
      REAL HE(NZ),DELT(NZ),FHKUTAI(2,5),FKRAT(5,9),FKRB(9,NZ)
C
      DO 20 IZ=1,NZ
          DO 10 I=1,5
              IF(ABS(DELT(IZ)/HE(IZ)).LT.FHKUTAI(1,I) .AND.
     \           ABS(DELT(IZ)/HE(IZ)).GE.FHKUTAI(2,I)) THEN
                   FKRB(1,IZ)=FKRAT(I,1)
                   GO TO 20            
              ENDIF
   10     CONTINUE
          WRITE(6,*) '**HOUKAI**',IZ
          FKRB(1,IZ)=0.5
   20 CONTINUE
      RETURN
      END
C
      SUBROUTINE FKRB2(HE,DELT,FHNGS,FKRAT,NZ,FKRB)
      INTEGER NZ
      REAL HE(NZ),DELT(NZ),FHNGS(2,3,8),FKRAT(5,9),FKRB(9,NZ)
C
      DO 90 IZ=1,NZ
          DO 10 I=1,3
              IF(ABS(DELT(IZ)/HE(IZ)).LT.FHNGS(1,I,1) .AND.
     \           ABS(DELT(IZ)/HE(IZ)).GE.FHNGS(2,I,1)) THEN
                   FKRB(2,IZ)=FKRAT(I,2)
                   GO TO 20
              ENDIF
   10     CONTINUE
          FKRB(2,IZ)=0
   20     CONTINUE
          DO 30 I=1,3
              IF(ABS(DELT(IZ)/HE(IZ)).LT.FHNGS(1,I,2) .AND.
     \           ABS(DELT(IZ)/HE(IZ)).GE.FHNGS(2,I,2)) THEN
                   FKRB(3,IZ)=FKRAT(I,3)
                   GO TO 40
              ENDIF
   30     CONTINUE
          FKRB(3,IZ)=0
   40     CONTINUE
          DO 50 I=1,3
              IF(ABS(DELT(IZ)/HE(IZ)).LT.FHNGS(1,I,4) .AND.
     \           ABS(DELT(IZ)/HE(IZ)).GE.FHNGS(2,I,4)) THEN
                   FKRB(5,IZ)=FKRAT(I,5)
                   GO TO 60
              ENDIF
   50     CONTINUE
          FKRB(5,IZ)=0
   60     CONTINUE
          DO 70 I=1,3
              IF(ABS(DELT(IZ)/HE(IZ)).LT.FHNGS(1,I,5) .AND.
     \           ABS(DELT(IZ)/HE(IZ)).GE.FHNGS(2,I,5)) THEN
                   FKRB(6,IZ)=FKRAT(I,6)
                   GO TO 80
              ENDIF
   70     CONTINUE
          FKRB(6,IZ)=0
   80     CONTINUE
   90 CONTINUE
      RETURN
      END
C
      SUBROUTINE FKRB3(AC,FHNGS,FKRAT,NZ,FKRB)
      INTEGER NZ
      REAL AC(NZ),FHNGS(2,3,8),FKRAT(5,9),FKRB(9,NZ)
C
      DO 90 IZ=1,NZ
          DO 10 I=1,3
              IF(ABS(AC(IZ)).LT.FHNGS(1,I,3) .AND.
     \           ABS(AC(IZ)).GE.FHNGS(2,I,3)) THEN
                   FKRB(4,IZ)=FKRAT(I,4)
                   GO TO 20
              ENDIF
   10     CONTINUE
          FKRB(4,IZ)=0
   20     CONTINUE
          DO 30 I=1,3
              IF(ABS(AC(IZ)).LT.FHNGS(1,I,6) .AND.
     \           ABS(AC(IZ)).GE.FHNGS(2,I,6)) THEN
                   FKRB(7,IZ)=FKRAT(I,7)
                   GO TO 40
              ENDIF
   30     CONTINUE
          FKRB(7,IZ)=0
   40     CONTINUE
          DO 50 I=1,3
              IF(ABS(AC(IZ)).LT.FHNGS(1,I,7) .AND.
     \           ABS(AC(IZ)).GE.FHNGS(2,I,7)) THEN
                   FKRB(8,IZ)=FKRAT(I,8)
                   GO TO 60
              ENDIF
   50     CONTINUE
          FKRB(8,IZ)=0
   60     CONTINUE
          DO 70 I=1,3
              IF(ABS(AC(IZ)).LT.FHNGS(1,I,8) .AND.
     \           ABS(AC(IZ)).GE.FHNGS(2,I,8)) THEN
                   FKRB(9,IZ)=FKRAT(I,9)
                   GO TO 80
              ENDIF
   70     CONTINUE
          FKRB(9,IZ)=0
   80     CONTINUE
   90 CONTINUE
      RETURN
      END
C
      SUBROUTINE FKRSET(ARRAT,CRAT,FKRB,NZ,FKC)
      INTEGER NZ
      REAL ARRAT(NZ),CRAT(9),FKRB(9,NZ),FKC
      FKC=0.0
      DO 10 IZ=1,NZ
      DO 10 I=1,9
          FKC=FKC+ARRAT(IZ)*CRAT(I)*FKRB(I,IZ)
   10 CONTINUE
      RETURN
      END