22 integer :: fissnuc_index
31 integer,
dimension(:),
allocatable :: fissparts
32 integer,
dimension(:,:),
allocatable :: cscf_ind
34 real(
r_kind),
dimension(:),
allocatable :: q_value
35 real(
r_kind),
dimension(:),
allocatable :: channelprob
36 real(
r_kind),
dimension(:),
allocatable :: ch_amount
54 integer,
dimension(:),
allocatable :: net_idx
55 integer,
dimension(:),
allocatable :: z
56 integer,
dimension(:),
allocatable :: a
57 real(
r_kind),
dimension(:),
allocatable :: y
103 integer :: alloc_stat
117 if ( alloc_stat /= 0)
call raise_exception(
'Allocation of "fissrate" failed.',&
118 "init_fission_rates",190001)
131 if (
nfiss .gt. 0)
then
159 real(r_kind) :: n_nucleons_created
160 real(r_kind) :: n_nucleons_destroyed
161 real(r_kind) :: conservation
162 real(r_kind) :: norm_factor
163 real(r_kind),
parameter :: error_thresh = 1d-3
165 info_entry(
"check_fission_mass_conservation")
169 n_nucleons_created = 0d0
170 n_nucleons_destroyed = 0d0
174 if (
fissrate(i)%ch_amount(j) .gt. 0)
then
182 conservation = n_nucleons_created - n_nucleons_destroyed
186 if (abs(conservation) .gt. error_thresh)
then
187 call raise_exception(
"Fission rate does not conserve mass (threshold = 1e-4)! Check your fission fragments! "//new_line(
"A")//&
188 "Parent: "//trim(adjustl(
net_names(
fissrate(i)%fissnuc_index)))//new_line(
"A")//&
189 "Conservation: "//
num_to_str(conservation)//new_line(
"A")//&
191 "check_fission_mass_conservation",190018)
195 norm_factor = n_nucleons_destroyed/n_nucleons_created
198 if (
fissrate(i)%ch_amount(j) .gt. 0)
then
204 info_exit(
"check_fission_mass_conservation")
223 integer,
dimension(:),
allocatable :: indices
225 info_entry(
"reorder_fragments")
232 if (
allocated(indices))
deallocate(indices)
233 allocate(indices(
fissrate(i)%dimens-2))
243 info_exit(
"reorder_fragments")
258 character(len=7) :: tmp
260 if (verbose_level .ge. 1)
then
263 elseif (verbose_level .ge. 2)
then
264 if (
nfiss .gt. 0)
write(*,
"(A)")
""
265 if (
nfiss .gt. 0)
write(*,
"(A)")
" Fission rates: "
266 if (
nfiss .gt. 0)
write(*,
"(A)")
" |----------------------|"
268 if (
nfiss .gt. 0)
write(*,
"(A)")
" | Total :"//adjustr(tmp)//
" |"
270 if (
n_nf .gt. 0)
write(*,
"(A)")
" | n-induced :"//adjustr(tmp)//
" |"
272 if (
n_bf .gt. 0)
write(*,
"(A)")
" | b-delayed :"//adjustr(tmp)//
" |"
274 if (
n_sf .gt. 0)
write(*,
"(A)")
" | spontaneous :"//adjustr(tmp)//
" |"
275 if (
nfiss .gt. 0)
write(*,
"(A)")
" |----------------------|"
276 if (
nfiss .gt. 0)
write(*,
"(A)")
""
296 character(len=*),
intent(in) :: path
299 integer :: alloc_stat
300 logical :: is_allocated
315 if ( alloc_stat /= 0)
call raise_exception(
'Allocation of "fissrate" failed.',&
316 "read_binary_fission_reaction_data",190001)
320 read(file_id)
fissrate(i)%fissnuc_index
329 read(file_id) is_allocated
330 if (is_allocated)
then
333 if ( alloc_stat /= 0)
call raise_exception(
'Allocation of "fissrate(i)%fissparts" failed.',&
334 "read_binary_fission_reaction_data",190001)
338 read(file_id) is_allocated
339 if (is_allocated)
then
341 if ( alloc_stat /= 0)
call raise_exception(
'Allocation of "fissrate(i)%cscf_ind" failed.',&
342 "read_binary_fission_reaction_data",190001)
348 read(file_id) is_allocated
349 if (is_allocated)
then
351 if ( alloc_stat /= 0)
call raise_exception(
'Allocation of "fissrate(i)%q_value" failed.',&
352 "read_binary_fission_reaction_data",190001)
356 read(file_id) is_allocated
357 if (is_allocated)
then
359 if ( alloc_stat /= 0)
call raise_exception(
'Allocation of "fissrate(i)%channelprob" failed.',&
360 "read_binary_fission_reaction_data",190001)
361 read(file_id)
fissrate(i)%channelprob
364 read(file_id) is_allocated
365 if (is_allocated)
then
367 if ( alloc_stat /= 0)
call raise_exception(
'Allocation of "fissrate(i)%ch_amount" failed.',&
368 "read_binary_fission_reaction_data",190001)
391 character(len=*),
intent(in) :: path
408 write(file_id)
fissrate(i)%fissnuc_index
415 write(file_id)
fissrate(i)%reac_type
416 write(file_id)
allocated(
fissrate(i)%fissparts)
417 if (
allocated(
fissrate(i)%fissparts))
then
418 write(file_id)
fissrate(i)%fissparts
420 write(file_id)
allocated(
fissrate(i)%cscf_ind)
421 if (
allocated(
fissrate(i)%cscf_ind))
then
425 write(file_id)
allocated(
fissrate(i)%q_value)
426 if (
allocated(
fissrate(i)%q_value))
then
429 write(file_id)
allocated(
fissrate(i)%channelprob)
430 if (
allocated(
fissrate(i)%channelprob))
then
431 write(file_id)
fissrate(i)%channelprob
433 write(file_id)
allocated(
fissrate(i)%ch_amount)
434 if (
allocated(
fissrate(i)%ch_amount))
then
435 write(file_id)
fissrate(i)%ch_amount
465 integer,
intent(inout) :: rrate_length
466 integer,
intent(out) :: fiss_count
467 integer :: new_length
472 new_length = rrate_length
473 if (
nfiss .ne. 0)
then
480 new_length = rrate_length
483 rrate_length = new_length
523 integer,
intent(inout) :: rrate_length
524 type(
fissionrate_type),
dimension(:),
allocatable,
intent(inout) :: fissrate_in
525 integer,
intent(inout) :: nfiss_in
527 real(
r_kind),
dimension(net_size) :: lambdas
529 real(
r_kind) :: tot_fiss_prob
530 integer :: parent_idx
533 logical,
dimension(rrate_length) :: rrate_mask
534 logical,
dimension(nfiss_in) :: fissrate_mask
537 integer :: new_rrate_length
538 integer :: new_nfiss_in
539 integer :: alloc_stat
540 real(
r_kind) :: lambda_rate
542 info_entry(
"modify_halflifes")
546 fissrate_mask(:) = .true.
549 if (
allocated(rrate))
then
550 rrate_mask(:) = .true.
556 if ((rrate(i)%reac_src .eq.
rrs_twr) .or. &
557 (rrate(i)%reac_src .eq.
rrs_nu) .or. &
558 (rrate(i)%reac_src .eq.
rrs_fiss) .or. &
559 (rrate(i)%reac_src .eq.
rrs_aext) .or. &
560 (rrate(i)%reac_src .eq.
rrs_detb)) cycle
562 if (rrate(i)%reac_type.eq.
rrt_betm)
then
564 if ((rrate(i)%parts(j).ne.
ineu) .and. (rrate(i)%parts(j).ne.
ipro))
then
569 if ((rrate(i)%reac_src .eq.
rrs_reacl) .or. &
570 (rrate(i)%reac_src .eq.
rrs_wext))
then
571 lambda_rate = dexp(rrate(i)%param(1))
572 lambdas(rrate(i)%parts(j)) = lambdas(rrate(i)%parts(j))+lambda_rate
573 if ((1d0-tot_fiss_prob) .ne. 0d0)
then
574 rrate(i)%param(1) = rrate(i)%param(1)+dlog(1d0-tot_fiss_prob)
577 rrate_mask(i) = .false.
580 else if (rrate(i)%reac_src .eq.
rrs_tabl)
then
586 lambdas(rrate(i)%parts(j)) = lambdas(rrate(i)%parts(j))+lambda_rate
587 if ((1d0-tot_fiss_prob) .ne. 0d0)
then
591 rrate_mask(i) = .false.
595 "modify_halflifes",190014)
605 new_rrate_length = count(rrate_mask)
606 if (new_rrate_length .ne. rrate_length)
then
609 if (verbose_level .ge. 2)
then
610 write(*,*)
"Reducing the rate array to the correct size by removing "//&
612 " beta-decays and putting it into fission rates."
616 allocate(rrate_tmp(new_rrate_length),stat=alloc_stat)
617 if ( alloc_stat /= 0)
call raise_exception(
'Allocation of "rrate_tmp" failed.',&
618 "modify_halflifes",190001)
620 rrate_tmp(1:new_rrate_length) = pack(rrate,rrate_mask)
621 deallocate(rrate,stat=alloc_stat)
622 if ( alloc_stat /= 0)
call raise_exception(
'Deallocation of "rrate" failed.',&
623 "modify_halflifes",190002)
625 allocate(rrate(new_rrate_length),stat=alloc_stat)
626 if ( alloc_stat /= 0)
call raise_exception(
'Allocation of "rrate" failed.',&
627 "modify_halflifes",190001)
629 rrate(1:new_rrate_length) = rrate_tmp(1:new_rrate_length)
630 deallocate(rrate_tmp,stat=alloc_stat)
631 if ( alloc_stat /= 0)
call raise_exception(
'Deallocation of "rrate_tmp" failed.',&
632 "modify_halflifes",190002)
633 rrate_length = new_rrate_length
638 do i=1,
size(fissrate_in)
639 if (fissrate_in(i)%reac_type.eq.
rrt_bf)
then
641 parent_idx = fissrate_in(i)%fissnuc_index
642 px_idx = int(fissrate_in(i)%released_n+1d0)
644 if (lambdas(parent_idx) .eq. 0d0)
then
646 fissrate_mask(i) = .false.
649 fissrate_in(i)%param(:) = 0d0
650 fissrate_in(i)%param(1) = dlog(px * lambdas(parent_idx))
656 new_nfiss_in = count(fissrate_mask)
657 if (new_nfiss_in .ne. nfiss_in)
then
659 if (verbose_level .ge. 2)
then
660 write(*,*)
"Reducing the fission rate array to the correct size by removing "//&
661 int_to_str(nfiss_in-new_nfiss_in)//
" beta-delayed fission rates."
664 allocate(fissrate_tmp(new_nfiss_in),stat=alloc_stat)
665 if ( alloc_stat /= 0)
call raise_exception(
'Allocation of "fissrate_tmp" failed.',&
666 "modify_halflifes",190001)
669 if (fissrate_mask(i))
then
671 allocate(fissrate_tmp(j)%fissparts(fissrate_in(i)%dimens),stat=alloc_stat)
672 if ( alloc_stat /= 0)
call raise_exception(
'Allocation of "fissrate_tmp(j)%fissparts" failed.',&
673 "modify_halflifes",190001)
674 allocate(fissrate_tmp(j)%cscf_ind(fissrate_in(i)%dimens,fissrate_in(i)%dimens),stat=alloc_stat)
675 if ( alloc_stat /= 0)
call raise_exception(
'Allocation of "fissrate_tmp(j)%cscf_ind" failed.',&
676 "modify_halflifes",190001)
677 allocate(fissrate_tmp(j)%q_value(fissrate_in(i)%channels),stat=alloc_stat)
678 if ( alloc_stat /= 0)
call raise_exception(
'Allocation of "fissrate_tmp(j)%q_value" failed.',&
679 "modify_halflifes",190001)
680 allocate(fissrate_tmp(j)%channelprob(fissrate_in(i)%channels),stat=alloc_stat)
681 if ( alloc_stat /= 0)
call raise_exception(
'Allocation of "fissrate_tmp(j)%channelprob" failed.',&
682 "modify_halflifes",190001)
683 allocate(fissrate_tmp(j)%ch_amount(fissrate_in(i)%dimens),stat=alloc_stat)
684 if ( alloc_stat /= 0)
call raise_exception(
'Allocation of "fissrate_tmp(j)%ch_amount" failed.',&
685 "modify_halflifes",190001)
687 fissrate_tmp(j) = fissrate_in(i)
693 deallocate(fissrate_in,stat=alloc_stat)
694 if ( alloc_stat /= 0)
call raise_exception(
'Deallocation of "fissrate_in" failed.',&
695 "modify_halflifes",190002)
696 allocate(fissrate_in(new_nfiss_in),stat=alloc_stat)
697 if ( alloc_stat /= 0)
call raise_exception(
'Allocation of "fissrate_in" or failed.',&
698 "modify_halflifes",190001)
702 allocate(fissrate_in(i)%fissparts(fissrate_tmp(i)%dimens),stat=alloc_stat)
703 if ( alloc_stat /= 0)
call raise_exception(
'Allocation of "fissrate_in(i)%fissparts" failed.',&
704 "modify_halflifes",190001)
705 allocate(fissrate_in(i)%cscf_ind(fissrate_tmp(i)%dimens,fissrate_tmp(i)%dimens),stat=alloc_stat)
706 if ( alloc_stat /= 0)
call raise_exception(
'Allocation of "fissrate_in(i)%cscf_ind" failed.',&
707 "modify_halflifes",190001)
708 allocate(fissrate_in(i)%q_value(fissrate_tmp(i)%channels),stat=alloc_stat)
709 if ( alloc_stat /= 0)
call raise_exception(
'Allocation of "fissrate_in(i)%q_value" failed.',&
710 "modify_halflifes",190001)
711 allocate(fissrate_in(i)%channelprob(fissrate_tmp(i)%channels),stat=alloc_stat)
712 if ( alloc_stat /= 0)
call raise_exception(
'Allocation of "fissrate_in(i)%channelprob" failed.',&
713 "modify_halflifes",190001)
714 allocate(fissrate_in(i)%ch_amount(fissrate_tmp(i)%dimens),stat=alloc_stat)
715 if ( alloc_stat /= 0)
call raise_exception(
'Allocation of "fissrate_in(i)%ch_amount" failed.',&
716 "modify_halflifes",190001)
717 fissrate_in(i) = fissrate_tmp(i)
722 deallocate(fissrate_tmp,stat=alloc_stat)
723 if ( alloc_stat /= 0)
call raise_exception(
'Deallocation of "fissrate_tmp" or failed.',&
724 "modify_halflifes",190002)
725 nfiss_in = new_nfiss_in
731 if ( alloc_stat /= 0)
call raise_exception(
'Deallocation of "beta_delayed_fiss_probs" failed.',&
732 "modify_halflifes",190002)
734 info_exit(
"modify_halflifes")
771 integer :: alloc_stat
773 info_entry(
"count_fission_rates")
784 call raise_exception(
"Fission format for spontaneous fission rates not implemented, got '"//&
786 "'fission_format_spontaneous' parameter.",&
787 "count_fission_rates",190010)
797 call raise_exception(
"Fission format for neutron-induced fission rates not implemented, got '"//&
799 "'fission_format_n_induced' parameter.",&
800 "count_fission_rates",190010)
815 if ( alloc_stat /= 0)
call raise_exception(
'Allocation of "beta_delayed_fiss_probs" failed.',&
816 "count_fission_rates",190001)
819 call raise_exception(
"Fission format for beta-delayed fission rates not implemented, got '"//&
821 "'fission_format_beta_delayed' parameter.",&
822 "count_fission_rates",190010)
828 info_exit(
"count_fission_rates")
847 character(len=*),
intent(in) :: fission_rate_file
848 integer,
intent(out) :: count_rates
851 integer :: fissionlib
852 character(5),
dimension(6) :: parts
853 integer,
dimension(6) :: parts_index
854 real(
r_kind),
dimension(9) :: params
870 read(fissionlib,
my_format(1), iostat = read_stat) &
871 grp, parts(1:6), src, res, rev, q
872 if (read_stat /= 0)
exit
873 read(fissionlib,
"(4E13.6)") params(1:4)
874 read(fissionlib,
"(5E13.6)") params(5:9)
875 if (grp.ne.0) cycle fission
878 if (parts(j) .eq.
' ')
exit indices
879 parts_index(j) =
benam(parts(j))
881 if (parts_index(j) .eq. 0) cycle fission
916 character(len=*),
intent(in) :: fission_rate_file
917 integer,
intent(out) :: count_rates
920 integer :: fissionlib
921 character(5),
dimension(6) :: parts
922 integer,
dimension(6) :: parts_index
924 real(
r_kind),
dimension(9) :: params
940 read(fissionlib, *, iostat = read_stat) &
941 parts(1), params(1), src
942 if (read_stat /= 0)
exit
946 if (parts(j) .eq.
' ')
exit indices_hl
947 parts_index(j) =
benam(parts(j))
949 if (parts_index(j) .eq. 0) cycle fission_hl
1000 character(len=*),
intent(in) :: fission_rate_file
1001 integer,
intent(out) :: count_rates
1002 integer,
intent(out) :: nr_cols
1003 integer,
parameter :: maxcols = 30
1005 integer :: read_stat
1006 integer :: fissionlib
1007 character(5) :: parent
1008 integer :: idx_parent
1010 real(
r_kind),
dimension(maxcols):: buff
1011 character(500) :: dummy
1013 integer :: fiss_probs
1027 read(fissionlib, * , iostat = read_stat) parent, src
1029 if (read_stat /= 0)
exit
1032 if (ifiss .eq. 0)
then
1033 read(fissionlib,
'(A)', iostat = read_stat) dummy
1035 read(dummy,*,iostat=read_stat) buff(1:j)
1036 if (read_stat .ne. 0)
exit
1039 nr_cols = count(buff .ne. -1d0)
1041 read(fissionlib,*, iostat = read_stat) buff(1:nr_cols)
1042 if (read_stat .ne. 0)
call raise_exception(
'Reading the fission probabilities failed.',&
1043 "count_fission_rates_probability_format",190012)
1047 fiss_probs = count((buff .ne. -1d0) .and. (buff .ne. 0d0))
1050 idx_parent =
benam(parent)
1052 if (idx_parent .eq. 0) cycle fission_prob
1056 ifiss = ifiss + fiss_probs
1089 integer :: neutfission=0
1090 integer :: betafission=0
1091 integer :: fissindex
1094 integer :: nfrac_distr
1103 if (astat /= 0)
call raise_exception(
'Allocation of "fissfrags_bdel" failed.',&
1104 "add_fission_fragments",190001)
1126 do fissindex=1,
nfiss
1146 //
") not implemented yet. "//&
1147 "Set it to a supported value!",&
1148 "add_fission_fragments",&
1156 //
") not implemented yet. "//&
1157 "Set it to a supported value!",&
1158 "add_fission_fragments",&
1179 //
") not implemented yet. "//&
1180 "Set it to a supported value!",&
1181 "add_fission_fragments",&
1189 //
") not implemented yet. "//&
1190 "Set it to a supported value!",&
1191 "add_fission_fragments",&
1212 //
") not implemented yet. "//&
1213 "Set it to a supported value!",&
1214 "add_fission_fragments",&
1222 //
") not implemented yet. "//&
1223 "Set it to a supported value!",&
1224 "add_fission_fragments",&
1239 if (astat.ne.0)
call raise_exception(
"Could not deallocate fissfrags_beta_delayed array.",&
1240 "add_fission_fragments",190002)
1244 if (astat.ne.0)
call raise_exception(
"Could not deallocate fissfrags_n_induced array.",&
1245 "add_fission_fragments",190002)
1249 if (astat.ne.0)
call raise_exception(
"Could not deallocate fissfrags_spontaneous array.",&
1250 "add_fission_fragments",190002)
1285 integer :: fisscount
1302 call raise_exception(
"Fission format for spontaneous fission rates not implemented, got '"//&
1304 "'fission_format_spontaneous' parameter.",&
1305 "read_fission_rates",190010)
1316 call raise_exception(
"Fission format for neutron-induced fission rates not implemented, got '"//&
1318 "'fission_format_n_induced' parameter.",&
1319 "read_fission_rates",190010)
1337 call raise_exception(
"Fission format for beta-delayed fission rates not implemented, got '"//&
1339 "'fission_format_beta_delayed' parameter.",&
1340 "read_fission_rates",190010)
1379 character(len=*),
intent(in) :: fission_path
1380 integer,
intent(in) :: reac_type
1381 integer,
intent(inout) :: start_idx
1382 integer :: read_stat
1383 integer :: fissionlib
1384 character(5),
dimension(6) :: parts
1385 integer,
dimension(6) :: parts_index
1386 real(
r_kind),
dimension(9) :: params
1392 integer :: group_index
1393 integer :: fissindex
1402 fissindex = start_idx
1404 read(fissionlib,
my_format(1), iostat = read_stat) &
1405 grp, parts(1:6), src, res, rev, q
1406 if (read_stat /= 0)
exit fission_loop
1407 read(fissionlib,
"(4E13.6)") params(1:4)
1408 read(fissionlib,
"(5E13.6)") params(5:9)
1416 inner_fission:
do j=1,6
1417 if (parts(j) .eq.
' ')
exit inner_fission
1418 parts_index(j) =
benam(parts(j))
1420 if (parts_index(j) .eq. 0) cycle fission_loop
1421 end do inner_fission
1432 if (reac_type.eq.
rrt_nf)
then
1433 fissrate(fissindex)%reac_type = reac_type
1436 if (parts_index(1) .eq.
ineu)
then
1437 fissrate(fissindex)%fissnuc_index = parts_index(2)
1439 fissrate(fissindex)%fissnuc_index = parts_index(1)
1442 else if (reac_type.eq.
rrt_sf)
then
1443 fissrate(fissindex)%reac_type = reac_type
1446 fissrate(fissindex)%fissnuc_index = parts_index(1)
1448 else if (reac_type.eq.
rrt_bf)
then
1450 fissrate(fissindex)%released_n = count(parts_index(:) .eq.
ineu)
1451 fissrate(fissindex)%reac_type = reac_type
1454 fissrate(fissindex)%fissnuc_index = parts_index(1)
1461 fissindex = fissindex + 1
1465 start_idx = fissindex
1512 character(len=*),
intent(in) :: fission_path
1513 integer,
intent(in) :: reac_type
1514 integer,
intent(inout) :: start_idx
1516 integer :: read_stat
1517 integer :: fissionlib
1518 character(5),
dimension(6) :: parts
1519 integer,
dimension(6) :: parts_index
1520 real(
r_kind),
dimension(9) :: params
1522 integer :: group_index
1523 integer :: fissindex
1525 integer :: idx_parent
1526 character(5) :: parent
1527 real(
r_kind),
dimension(amount_cols):: pnf
1530 fissindex = start_idx
1539 read(fissionlib,*, iostat = read_stat) parent, src
1540 if (read_stat /= 0)
exit
1541 read(fissionlib,*, iostat = read_stat) pnf
1543 if (read_stat /= 0)
call raise_exception(
"Could not read fission probabilities.",&
1544 "read_fission_rates_probability_format",&
1549 idx_parent =
benam(parent)
1550 if (idx_parent .eq. 0) cycle fission_prob
1554 parts_index(1) = idx_parent
1557 if (pnf(j) .eq. 0d0) cycle
1563 if (reac_type.eq.
rrt_bf)
then
1565 fissrate(fissindex)%reac_type = reac_type
1568 fissrate(fissindex)%fissnuc_index = parts_index(1)
1569 fissrate(fissindex)%released_n = j-1
1571 call raise_exception(
"Fission type not implemented for probability format!",&
1572 "read_fission_rates_probability_format",&
1585 fissindex = fissindex + 1
1590 " is larger than one.",
"read_fission_rates_probability_format",&
1625 character(len=*),
intent(in) :: fission_path
1626 integer,
intent(in) :: reac_type
1627 integer,
intent(inout) :: start_idx
1628 integer :: read_stat
1629 integer :: fissionlib
1630 character(5),
dimension(6) :: parts
1631 integer,
dimension(6) :: parts_index
1632 real(
r_kind),
dimension(9) :: params
1634 integer :: group_index
1635 integer :: fissindex
1644 fissindex = start_idx
1649 read(fissionlib, *, iostat = read_stat) &
1650 parts(1), params(1), src
1651 if (read_stat /= 0)
exit fission_loop
1653 params(1) = dlog(dlog(2d0)/params(1))
1655 inner_fission:
do j=1,6
1656 if (parts(j) .eq.
' ')
exit inner_fission
1657 parts_index(j) =
benam(parts(j))
1659 if (parts_index(j) .eq. 0) cycle fission_loop
1660 end do inner_fission
1669 if (reac_type .eq.
rrt_sf)
then
1670 fissrate(fissindex)%reac_type = reac_type
1673 fissrate(fissindex)%fissnuc_index = parts_index(1)
1675 else if (reac_type .eq.
rrt_bf)
then
1676 fissrate(fissindex)%reac_type = reac_type
1679 fissrate(fissindex)%fissnuc_index = parts_index(1)
1681 call raise_exception(
"Fission type not implemented for half life format!",&
1682 "read_fission_rates_halflife_format",&
1693 fissindex = fissindex + 1
1697 start_idx = fissindex
1729 integer :: fiss_mode
1731 integer :: alloc_stat
1733 info_entry(
"fiss_dist")
1740 mass =
isotope(fissrate_inout%fissnuc_index)%mass
1741 pnr =
isotope(fissrate_inout%fissnuc_index)%p_nr
1744 if (fissrate_inout%reac_type .eq.
rrt_nf)
then
1749 else if (fissrate_inout%reac_type .eq.
rrt_sf)
then
1754 else if (fissrate_inout%reac_type .eq.
rrt_bf)
then
1759 nemiss = fissrate_inout%released_n
1772 z2 = nint(52.01 - (zf - 80)/1.d1)
1779 if (a1.gt.
minmax(z1,2))
then
1780 nemiss = nemiss + a1 -
minmax(z1,2)
1782 else if (a1.lt.
minmax(z1,1))
then
1783 if (verbose_level .ge. 2)
then
1784 print *,
'a1 error:', z1, a1, zf, af
1785 print *,
'adjusting...'
1791 if (a2.gt.
minmax(z2,2))
then
1792 nemiss = nemiss + a2 -
minmax(z2,2)
1795 else if (a2.lt.
minmax(z2,1))
then
1796 if (verbose_level .ge. 2)
then
1797 print *,
'a2 error:', z2, a2, zf, af
1798 print *,
'adjusting...'
1805 fissrate_inout%fissnuc_index =
findaz(mass,pnr)
1806 fissrate_inout%channels = 1
1808 allocate(fissrate_inout%channelprob(1),fissrate_inout%q_value(1),stat=alloc_stat)
1809 if (alloc_stat.ne.0)
call raise_exception(
"Could not allocate memory for channelprob and q_value.",&
1812 fissrate_inout%channelprob(1) = 1.d0
1813 fissrate_inout%mode = fiss_mode
1815 if (fiss_mode.eq.1)
then
1816 fissrate_inout%dimens = 4
1817 allocate(fissrate_inout%fissparts(fissrate_inout%dimens), &
1818 fissrate_inout%ch_amount(fissrate_inout%dimens),stat=alloc_stat)
1819 if (alloc_stat.ne.0)
call raise_exception(
"Could not allocate 'fissparts' and 'ch_amount'.",&
1821 fissrate_inout%fissparts(1) =
ineu
1822 fissrate_inout%ch_amount(1) = float(nemiss) - 1.d0
1823 fissrate_inout%fissparts(2) = fissrate_inout%fissnuc_index
1824 fissrate_inout%ch_amount(2) = -1.d0
1825 fissrate_inout%fissparts(3) =
findaz(a1,z1)
1826 fissrate_inout%ch_amount(3) = 1.d0
1827 fissrate_inout%fissparts(4) =
findaz(a2,z2)
1828 fissrate_inout%ch_amount(4) = 1.d0
1829 fissrate_inout%q_value(1) = (1-nemiss) *
isotope(
ineu)%mass_exc + &
1830 isotope(fissrate_inout%fissnuc_index)%mass_exc - &
1831 isotope(fissrate_inout%fissparts(3))%mass_exc - &
1832 isotope(fissrate_inout%fissparts(4))%mass_exc
1834 if (nemiss .eq. 0)
then
1835 fissrate_inout%dimens = 3
1836 allocate(fissrate_inout%fissparts(fissrate_inout%dimens),&
1837 fissrate_inout%ch_amount(fissrate_inout%dimens),stat=alloc_stat)
1838 if (alloc_stat.ne.0)
call raise_exception(
"Could not allocate 'fissparts' and 'ch_amount'.",&
1841 fissrate_inout%dimens = 4
1842 allocate(fissrate_inout%fissparts(fissrate_inout%dimens),&
1843 fissrate_inout%ch_amount(fissrate_inout%dimens),stat=alloc_stat)
1844 if (alloc_stat.ne.0)
call raise_exception(
"Could not allocate 'fissparts' and 'ch_amount'.",&
1846 fissrate_inout%fissparts(4) =
ineu
1847 fissrate_inout%ch_amount(4) = float(nemiss)
1849 fissrate_inout%fissparts(1) = fissrate_inout%fissnuc_index
1850 fissrate_inout%ch_amount(1) = -1.d0
1851 fissrate_inout%fissparts(2) =
findaz(a1,z1)
1852 fissrate_inout%ch_amount(2) = 1.d0
1853 fissrate_inout%fissparts(3) =
findaz(a2,z2)
1854 fissrate_inout%ch_amount(3) = 1.d0
1856 if (fissrate_inout%fissparts(2) .eq. -1)
then
1857 call raise_exception(
"Fragment was not found in nucleus library, does your library have 'holes'? "//&
1861 if (fissrate_inout%fissparts(3) .eq. -1)
then
1862 call raise_exception(
"Fragment was not found in nucleus library, does your library have 'holes'? "//&
1867 fissrate_inout%q_value(1) =
isotope(fissrate_inout%fissparts(1))%mass_exc - &
1868 isotope(fissrate_inout%fissparts(2))%mass_exc - &
1869 isotope(fissrate_inout%fissparts(3))%mass_exc - &
1873 qval = fissrate_inout%q_value(1)
1874 fissrate_inout%averageQ = qval
1875 info_exit(
"fiss_dist")
1909 integer :: fiss_mode
1912 integer :: a1,a2,z1,z2
1914 real(
r_kind) :: za,al,ah,cz,ca
1915 real(
r_kind),
parameter :: lim = 1.d-6
1917 integer :: alloc_stat
1920 integer :: neutronflag
1921 real(
r_kind) :: nemiss_total
1922 integer :: additional_neutrons
1925 info_entry(
"kodtakdist")
1929 additional_neutrons = 0d0
1932 mass =
isotope(fissrate_inout%fissnuc_index)%mass
1933 pnr =
isotope(fissrate_inout%fissnuc_index)%p_nr
1936 if (fissrate_inout%reac_type .eq.
rrt_nf)
then
1941 else if (fissrate_inout%reac_type .eq.
rrt_sf)
then
1946 else if (fissrate_inout%reac_type .eq.
rrt_bf)
then
1951 additional_neutrons = fissrate_inout%released_n
1952 af = mass-additional_neutrons
1957 al = 0.85d0*af - 104.98d0
1958 ah = 0.15d0*af + 103.87d0
1966 za = zf*(a+0.6d0)/af
1968 paz = 0.5d0*dexp(-((z-za)**2)/cz) * &
1969 ((dexp(-((a-al)**2)/ca))+(dexp(-((a-ah)**2)/ca)))/ &
1970 (
unit%pi*dsqrt(cz*ca))
1980 if (a1.gt.
minmax(z1,2))
then
1982 else if (a1.lt.
minmax(z1,1))
then
1983 if (verbose_level .ge. 2)
then
1984 print *,
'Warning in kodtakdist, fragment was lighter than included nuclei'
1985 print *,
'Fragment was: ', a1, z1
1989 if (a2.gt.
minmax(z2,2))
then
1991 else if (a2.lt.
minmax(z2,1))
then
1992 if (verbose_level .ge. 2)
then
1993 print *,
'Warning in kodtakdist, fragment was lighter than included nuclei'
1994 print *,
'Fragment was: ', a2, z2
2002 fissrate_inout%channels = nf
2003 fissrate_inout%fissnuc_index =
findaz(mass,pnr)
2004 fissrate_inout%mode = fiss_mode
2007 allocate(fissrate_inout%channelprob(nf),fissrate_inout%q_value(nf), &
2009 if (alloc_stat .ne. 0)
call raise_exception(
"Allocation of fission rate prob. arrays failed.",&
2010 "kodtakdist",190001)
2013 select case (fiss_mode)
2015 dimens = 2 * fissrate_inout%channels + 2
2016 fissrate_inout%dimens = dimens
2017 allocate(fissrate_inout%fissparts(dimens),fissrate_inout%ch_amount(dimens),&
2019 if (alloc_stat .ne. 0)
call raise_exception(
"Allocation of fission rate parts failed.",&
2020 "kodtakdist",190001)
2022 fissrate_inout%fissparts(1) =
ineu
2023 fissrate_inout%fissparts(2) = fissrate_inout%fissnuc_index
2024 fissrate_inout%ch_amount(2) = -1.d0
2026 dimens = 2 * fissrate_inout%channels + 1
2027 if (neutronflag.eq.1) dimens = dimens+1
2028 fissrate_inout%dimens = dimens
2029 allocate(fissrate_inout%fissparts(dimens),fissrate_inout%ch_amount(dimens),&
2031 if (alloc_stat .ne. 0)
call raise_exception(
"Allocation of fission rate parts failed.",&
2032 "kodtakdist",190001)
2033 fissrate_inout%ch_amount(1) = -1.d0
2034 fissrate_inout%fissparts(1) = fissrate_inout%fissnuc_index
2038 nemiss_total = float(additional_neutrons)
2042 massloop:
do a = 1,af
2043 za = zf*(a+0.6d0)/af
2044 paz = 0.5d0*dexp(-((z-za)**2)/cz) * &
2045 ((dexp(-((a-al)**2)/ca))+(dexp(-((a-ah)**2)/ca)))/ &
2046 (
unit%pi*dsqrt(cz*ca))
2047 if(paz.lt.lim) cycle massloop
2057 if (a1.gt.
minmax(z1,2))
then
2058 nemiss = a1 -
minmax(z1,2)
2061 else if (a1.lt.
minmax(z1,1))
then
2062 if (verbose_level .ge. 2)
then
2063 print *,
'Warning in kodtakdist, fragment was lighter than included nuclei'
2064 print *,
'Fragment was: ', a1, z1
2068 if (a2.gt.
minmax(z2,2))
then
2069 nemiss = nemiss + a2 -
minmax(z2,2)
2071 else if (a2.lt.
minmax(z2,1))
then
2073 if (verbose_level .ge. 2)
then
2074 print *,
'Warning in kodtakdist, fragment was lighter than included nuclei'
2075 print *,
'Fragment was: ', a2, z2
2080 nemiss_total = nemiss_total+ float(nemiss)*paz
2082 select case(fiss_mode)
2084 fissrate_inout%channelprob(i) = paz
2085 fissrate_inout%fissparts(i+2) =
findaz(a1,z1)
2087 if (fissrate_inout%fissparts(i+2) .eq. -1)
then
2088 call raise_exception(
"Fragment was not found in nucleus library, does your library have 'holes'? "//&
2090 "kodtakdist",190013)
2093 fissrate_inout%ch_amount(i+2) = fissrate_inout%channelprob(i)
2094 fissrate_inout%fissparts(i+2+fissrate_inout%channels) =
findaz(a2,z2)
2096 if (fissrate_inout%fissparts(i+2+fissrate_inout%channels) .eq. -1)
then
2097 call raise_exception(
"Fragment was not found in nucleus library, does your library have 'holes'? "//&
2099 "kodtakdist",190013)
2101 fissrate_inout%ch_amount(i+2+fissrate_inout%channels) = fissrate_inout%channelprob(i)
2102 fissrate_inout%q_value(i) =
isotope(fissrate_inout%fissnuc_index)%mass_exc - &
2104 isotope(fissrate_inout%fissparts(i+2))%mass_exc - &
2105 isotope(fissrate_inout%fissparts(i+2+fissrate_inout%channels))%mass_exc
2107 fissrate_inout%channelprob(i) = paz
2108 fissrate_inout%fissparts(i+1) =
findaz(a1,z1)
2110 if (fissrate_inout%fissparts(i+1) .eq. -1)
then
2111 call raise_exception(
"Fragment was not found in nucleus library, does your library have 'holes'?",&
2112 "kodtakdist",190013)
2115 fissrate_inout%ch_amount(i+1) = fissrate_inout%channelprob(i)
2116 fissrate_inout%fissparts(i+1+fissrate_inout%channels) =
findaz(a2,z2)
2118 if (fissrate_inout%fissparts(i+1+fissrate_inout%channels) .eq. -1)
then
2119 call raise_exception(
"Fragment was not found in nucleus library, does your library have 'holes'?",&
2120 "kodtakdist",190013)
2123 fissrate_inout%ch_amount(i+1+fissrate_inout%channels) = fissrate_inout%channelprob(i)
2124 if (neutronflag.eq.1)
then
2125 fissrate_inout%fissparts(dimens) =
ineu
2126 fissrate_inout%ch_amount(dimens) = real(nemiss)
2128 fissrate_inout%q_value(i) =
isotope(fissrate_inout%fissnuc_index)%mass_exc - &
2130 isotope(fissrate_inout%fissparts(i+1))%mass_exc - &
2131 isotope(fissrate_inout%fissparts(i+1+fissrate_inout%channels))%mass_exc
2137 select case(fiss_mode)
2139 fissrate_inout%ch_amount(1) = nemiss_total - 1.d0
2141 if (neutronflag.eq.1)
then
2142 fissrate_inout%fissparts(dimens) =
ineu
2143 fissrate_inout%ch_amount(dimens) = nemiss_total
2148 do i=1,fissrate_inout%dimens
2149 qval = qval -
isotope(fissrate_inout%fissparts(i))%mass_exc*fissrate_inout%ch_amount(i)
2151 fissrate_inout%averageQ = qval
2155 info_exit(
"kodtakdist")
2198 character(len=*),
intent(in) :: file
2199 type(
fragtype),
dimension(:),
allocatable,
intent(out) :: fragment_array
2202 integer :: frag_counter
2207 integer :: read_stat
2211 real(r_kind) :: Ynem
2212 real(r_kind) :: helper
2213 integer :: mina,maxa
2216 info_entry(
"read_fiss_fragment_file")
2225 read(file_id,*,iostat=read_stat) zf, af, nof
2226 if (read_stat .ne. 0)
exit
2233 if (((
findaz(af,zf) .ne. -1) .or. &
2234 (
findaz(af-1,zf) .ne. -1) .or. &
2235 (
findaz(af,zf-1) .ne. -1)))
then
2236 frag_counter = frag_counter + 1
2241 allocate(fragment_array(frag_counter),stat=astat)
2242 if (astat .ne. 0)
then
2244 "read_fiss_fragment_file",190001)
2250 fragloop:
do i = 1,frag_counter
2251 read(file_id,*,iostat=read_stat) zf, af, nof
2258 if (.not. ((
findaz(af,zf) .ne. -1) .or. &
2259 (
findaz(af-1,zf) .ne. -1) .or. &
2260 (
findaz(af,zf-1) .ne. -1)))
then
2269 allocate(fragment_array(i)%net_idx(nof),&
2270 fragment_array(i)%Z(nof),&
2271 fragment_array(i)%A(nof),&
2272 fragment_array(i)%Y(nof),&
2274 if (astat .ne. 0)
then
2276 "read_fiss_fragment_file",190001)
2280 fragment_array(i)%nr_frags = nof
2281 fragment_array(i)%Zp = zf
2282 fragment_array(i)%Ap = af
2290 read(file_id,*) fragment_array(i)%Z(j),fragment_array(i)%A(j),fragment_array(i)%Y(j)
2291 fragment_array(i)%net_idx(j) =
findaz(fragment_array(i)%A(j),fragment_array(i)%Z(j))
2295 if (fragment_array(i)%net_idx(j) .eq. -1)
then
2297 if (verbose_level .ge. 2)
then
2298 write(*,*)
"Fragment ",fragment_array(i)%Z(j),fragment_array(i)%A(j),&
2299 " not in network. Splitting into lighter isotope and neutrons."
2302 mina =
minmax(fragment_array(i)%Z(j),1)
2303 maxa =
minmax(fragment_array(i)%Z(j),2)
2304 if (fragment_array(i)%A(j) .gt. maxa)
then
2306 nem = nem + (fragment_array(i)%A(j)-maxa)
2310 ynem = ynem + fragment_array(i)%Y(j)*(fragment_array(i)%A(j)-maxa)
2311 fragment_array(i)%Y(j) = fragment_array(i)%Y(j)
2312 fragment_array(i)%A(j) = maxa
2313 fragment_array(i)%net_idx(j) =
findaz(maxa,fragment_array(i)%Z(j))
2321 if (fragment_array(i)%net_idx(j) .eq. -1)
then
2324 if (verbose_level .ge. 2)
then
2325 write(*,*)
"Fission fragment Z=",fragment_array(i)%Z(j), &
2326 "A=",fragment_array(i)%A(j), &
2327 "Y=",fragment_array(i)%Y(j), &
2328 "not in network, trying to remap."
2332 mina =
minmax(fragment_array(i)%Z(j),1)
2333 bn = (mina-fragment_array(i)%A(j))
2338 if ((fragment_array(i)%net_idx(m) .ne. -1) .and. &
2339 ((bn*fragment_array(i)%Y(j) / fragment_array(i)%A(m)) .lt. fragment_array(i)%Y(m)))
then
2347 "consider to include more nuclides in the network. "//&
2349 "Nucleus Z="//trim(int_to_str(fragment_array(i)%Z(j)))// &
2350 ", A="//trim(int_to_str(fragment_array(i)%A(j)))// &
2351 " was not included. "//new_line(
'A')//&
2352 "Need "//int_to_str(bn)//
" neutrons.",&
2353 "read_fiss_fragment_file",&
2358 fragment_array(i)%Y(m) = fragment_array(i)%Y(m) - (bn*fragment_array(i)%Y(j) / fragment_array(i)%A(m))
2359 fragment_array(i)%Y(j) = fragment_array(i)%Y(j)
2361 fragment_array(i)%A(j) = mina
2362 fragment_array(i)%net_idx(j) =
findaz(mina,fragment_array(i)%Z(j))
2369 helper = helper+fragment_array(i)%A(j)*fragment_array(i)%Y(j)
2371 if (abs(helper - float(fragment_array(i)%Ap)) .gt. 1e-2)
then
2372 call raise_exception(
"Yield of fission fragments is not conserved. "// &
2373 "This happened for fragment distribution of "// &
2374 "Nucleus Z="//trim(int_to_str(fragment_array(i)%Zp))// &
2375 ", A="//trim(int_to_str(fragment_array(i)%Ap))// &
2376 ". Ensure that the sum is 2.",
"read_fiss_fragment_file",&
2380 fragment_array(i)%neutrons = nem
2381 fragment_array(i)%Yn = ynem
2388 info_exit(
"read_fiss_fragment_file")
2412 integer,
optional,
intent(in) :: missing_frags
2416 real(r_kind) :: qval
2417 integer :: nfrac_distr
2420 integer :: ind_parent
2426 integer :: additional_neutrons
2427 integer :: missing_frags_internal
2429 info_entry(
"file_fiss_frag")
2432 if (.not.
present(missing_frags))
then
2433 missing_frags_internal = 0
2435 missing_frags_internal = missing_frags
2439 mass =
isotope(fissrate_inout%fissnuc_index)%mass
2440 pnr =
isotope(fissrate_inout%fissnuc_index)%p_nr
2443 if (fissrate_inout%reac_type .eq.
rrt_bf)
then
2446 fissrate_inout%mode = 3
2447 else if (fissrate_inout%reac_type .eq.
rrt_nf)
then
2450 fissrate_inout%mode = 1
2451 else if (fissrate_inout%reac_type .eq.
rrt_sf)
then
2454 fissrate_inout%mode = 2
2458 additional_neutrons = fissrate_inout%released_n
2464 afiss = mass - additional_neutrons
2467 if (fissrate_inout%reac_type .eq.
rrt_bf)
then
2470 elseif (fissrate_inout%reac_type .eq.
rrt_nf)
then
2476 ind_parent =
findaz(mass,pnr)
2477 fissrate_inout%fissnuc_index = ind_parent
2481 if (fissrate_inout%reac_type .eq.
rrt_bf)
then
2483 else if (fissrate_inout%reac_type .eq.
rrt_nf)
then
2485 else if (fissrate_inout%reac_type .eq.
rrt_sf)
then
2489 if ((fissfrags_tmp%Zp .eq. zfiss) .and. (fissfrags_tmp%Ap .eq. afiss))
then
2496 if (.not. found)
then
2499 if (missing_frags_internal .eq. 0)
then
2501 "A="//
int_to_str(afiss)//
" in fragment file. Either add it to the fission fragment file or set "//&
2502 "'fission_frag_missing' to 1 (Panov et al. 2001) or 2 (Kodama & Takahashi 1975)",&
2503 "file_fiss_frag", 190016)
2507 if (verbose_level .ge.2)
then
2508 write(*,*)
"No fragment distribution found for Z=",zfiss,
", A=",afiss
2509 if (missing_frags_internal .eq. 1)
then
2510 write(*,*)
"Using Panov 2001 instead."
2511 else if (missing_frags_internal .eq. 2)
then
2512 write(*,*)
"Using Kodama & Takahashi 1975 instead."
2516 if (missing_frags_internal .eq. 1)
then
2519 else if (missing_frags_internal .eq. 2)
then
2524 "Got "//
int_to_str(missing_frags_internal)//
".",&
2525 "file_fiss_frag",190015)
2529 if (fissrate_inout%reac_type .eq.
rrt_bf)
then
2531 else if (fissrate_inout%reac_type .eq.
rrt_nf)
then
2533 else if (fissrate_inout%reac_type .eq.
rrt_sf)
then
2538 allocate(fissrate_inout%fissparts(fissfrags_tmp%nr_frags+2),&
2539 fissrate_inout%ch_amount(fissfrags_tmp%nr_frags+2),&
2542 if (astat .ne. 0)
then
2543 call raise_exception(
"Could not allocate memory for fission fragments.",&
2544 "file_fiss_frag",190001)
2549 fissrate_inout%dimens = fissfrags_tmp%nr_frags+2
2552 if (.not. (fissrate_inout%reac_type .eq.
rrt_nf))
then
2553 fissrate_inout%fissparts(1) = ind_parent
2554 fissrate_inout%fissparts(2) =
ineu
2555 fissrate_inout%ch_amount(1) = -1d0
2556 fissrate_inout%ch_amount(2) = fissfrags_tmp%Yn+float(additional_neutrons)
2558 fissrate_inout%fissparts(1) =
ineu
2559 fissrate_inout%fissparts(2) = ind_parent
2560 fissrate_inout%ch_amount(1) = fissfrags_tmp%Yn-1d0+float(additional_neutrons)
2561 fissrate_inout%ch_amount(2) = -1d0
2565 do i=1,fissfrags_tmp%nr_frags
2566 fissrate_inout%fissparts(i+2) = fissfrags_tmp%net_idx(i)
2567 fissrate_inout%fissparts(i+2) = fissfrags_tmp%net_idx(i)
2568 fissrate_inout%ch_amount(i+2) = fissfrags_tmp%Y(i)
2574 qvalue:
do i=1,fissrate_inout%dimens
2575 qval = qval -
isotope(fissrate_inout%fissparts(i))%mass_exc*fissrate_inout%ch_amount(i)
2577 fissrate_inout%averageQ = qval
2579 info_exit(
"file_fiss_frag")
2594 integer,
intent(in) :: mass,pnr
2595 integer,
intent(in) :: pos
2596 real(
r_kind),
intent(out) :: qval
2597 integer :: fmass,fpnr
2598 integer :: read_stat
2599 integer :: alloc_stat
2601 integer,
dimension(:),
allocatable :: a1,z1
2602 integer,
dimension(:),
allocatable :: a2,z2
2603 integer,
intent(in) :: neutfission
2604 integer :: i,nof, nemiss
2606 real(
r_kind) :: nrate,npre,nafter
2607 real(
r_kind),
dimension(:),
allocatable :: paz
2610 character(2) :: dummy
2612 info_entry(
"abla_nfiss")
2616 read(neutfission,
"(I3,1X,I3,5X,I3)",iostat=read_stat) zf, af, nof
2617 if (read_stat /= 0)
then
2622 read(neutfission,*,iostat=read_stat) nrate, npre, nafter
2623 if (read_stat /= 0)
then
2624 call raise_exception(
"Could not read fission file.",
"abla_nfiss",190004)
2627 if ((af.eq.mass).and.(zf.eq.pnr).and.(nof.ne.0))
then
2629 n_mult = npre + nafter
2630 nemiss = int(dnint(n_mult))
2633 allocate(a1(nof),stat=alloc_stat)
2634 allocate(a2(nof),stat=alloc_stat)
2635 allocate(z1(nof),stat=alloc_stat)
2636 allocate(z2(nof),stat=alloc_stat)
2637 allocate(paz(nof),stat=alloc_stat)
2643 allocate(
fissrate(pos)%channelprob(nof))
2644 allocate(
fissrate(pos)%q_value(nof))
2645 dimens = 2 *
fissrate(pos)%channels + 2
2647 allocate(
fissrate(pos)%fissparts(dimens))
2648 allocate(
fissrate(pos)%ch_amount(dimens))
2650 fissrate(pos)%ch_amount(1) = float(nemiss) - 1.d0
2657 read(neutfission,*,iostat=read_stat) &
2658 & a1(i),z1(i),paz(i)
2659 if (read_stat /= 0)
then
2660 call raise_exception(
"Could not read fission file.",
"abla_nfiss",190004)
2663 if (a1(i).gt.
minmax(z1(i),2))
then
2664 nemiss = nemiss + a1(i) -
minmax(z1(i),2)
2666 else if (a1(i).lt.
minmax(z1(i),1))
then
2667 print *,
'a1 error:'
2669 a2(i) = mass + 1 - a1(i) - nemiss
2671 psum = psum + paz(i)
2674 if (a2(i).gt.
minmax(z2(i),2))
then
2675 nemiss = nemiss + a2(i) -
minmax(z2(i),2)
2677 else if (a2(i).lt.
minmax(z2(i),1))
then
2678 print *,
'a2 error:', a2(i), z2(i), a1(i), z1(i), mass, pnr
2683 paz(i) = paz(i)/psum
2684 fissrate(pos)%channelprob(i) = paz(i)
2699 qvalue:
do i=1,
fissrate(pos)%channels
2711 rewind(neutfission,iostat=read_stat)
2712 if (read_stat /= 0)
then
2714 "abla_nfiss",190005)
2721 read(neutfission,*,iostat=read_stat) dummy
2722 if (read_stat /= 0)
then
2724 "abla_nfiss",190004)
2733 allocate(a1(1),stat=alloc_stat)
2734 allocate(a2(1),stat=alloc_stat)
2735 allocate(z1(1),stat=alloc_stat)
2736 allocate(z2(1),stat=alloc_stat)
2742 a2(1) = nint(fmass/2.d0)
2743 z2(1) = nint(fpnr/2.d0)
2744 a1(1) = fmass - a2(1)
2745 z1(1) = fpnr - z2(1)
2747 a2(1) = nint(fmass/2.d0)
2748 z2(1) = nint(fpnr/2.d0)
2749 a1(1) = fmass - a2(1)
2750 z1(1) = fpnr - z2(1)
2753 z2(1) = nint(52.01 - (fpnr - 80)/1.d1)
2756 a1(1) = fmass - a2(1)
2757 z1(1) = fpnr - z2(1)
2762 if (a1(1).gt.
minmax(z1(1),2))
then
2763 nemiss = a1(1) -
minmax(z1(1),2)
2765 else if (a1(1).lt.
minmax(z1(1),1))
then
2766 print *,
'a1 error:'
2769 if (a2(1).gt.
minmax(z2(1),2))
then
2770 nemiss = nemiss + a2(1) -
minmax(z2(1),2)
2772 else if (a2(1).lt.
minmax(z2(1),1))
then
2773 print *,
'a2 error:'
2780 allocate(
fissrate(pos)%channelprob(1))
2785 fissrate(pos)%channelprob(1) = 1.d0
2788 fissrate(pos)%ch_amount(1) = float(nemiss) - 1.d0
2808 rewind(neutfission,iostat=read_stat)
2809 if (read_stat /= 0)
then
2811 "abla_nfiss",190005)
2814 info_exit(
"abla_nfiss")
2827 integer,
intent(in) :: mass,pnr
2828 integer,
intent(in) :: pos
2829 real(
r_kind),
intent(out) :: qval
2830 integer :: nemiss,fmass,fpnr
2831 integer :: read_stat
2832 integer :: alloc_stat
2834 integer,
dimension(:),
allocatable :: a1,z1
2835 integer,
dimension(:),
allocatable :: a2,z2
2836 integer,
intent(in) :: betafission
2839 real(
r_kind) :: nrate,npre,nafter
2840 real(
r_kind),
dimension(:),
allocatable :: paz
2843 character(2) :: dummy
2845 info_entry(
"abla_betafiss")
2849 read(betafission,*, iostat = read_stat) zf, af, nof
2851 if (read_stat /= 0)
exit
2852 read(betafission,*,iostat=read_stat) nrate, npre, nafter
2853 if (read_stat /= 0)
then
2855 "abla_betafiss",190006)
2857 if ((af.eq.mass).and.(zf.eq.pnr).and.(nof.ne.0))
then
2859 n_mult = npre + nafter
2860 nemiss = int(dnint(n_mult))
2863 allocate(a1(nof),stat=alloc_stat)
2864 allocate(a2(nof),stat=alloc_stat)
2865 allocate(z1(nof),stat=alloc_stat)
2866 allocate(z2(nof),stat=alloc_stat)
2867 allocate(paz(nof),stat=alloc_stat)
2877 allocate(
fissrate(pos)%channelprob(nof))
2878 allocate(
fissrate(pos)%q_value(nof))
2879 dimens = 2 *
fissrate(pos)%channels + 1
2880 if (nemiss.gt.0) dimens = dimens + 1
2882 allocate(
fissrate(pos)%fissparts(dimens))
2883 allocate(
fissrate(pos)%ch_amount(dimens))
2887 if (nemiss.gt.0)
then
2889 fissrate(pos)%ch_amount(dimens) = float(nemiss)
2894 read(betafission,
"(I3,1X,I3,2X,F6.4)",iostat=read_stat) a1(i), z1(i), paz(i)
2895 if (read_stat /= 0)
then
2897 "abla_betafiss",190006)
2901 if (a1(i).gt.
minmax(z1(i),2))
then
2902 nemiss = nemiss + a1(i) -
minmax(z1(i),2)
2904 else if (a1(i).lt.
minmax(z1(i),1))
then
2905 print *,
'a1 error:'
2908 a2(i) = mass - a1(i) - nemiss
2910 if (
fissrate(pos)%mode.eq.3) z2(i) = z2(i) + 1
2911 psum = psum + paz(i)
2914 if (a2(i).gt.
minmax(z2(i),2))
then
2915 nemiss = nemiss + a2(i) -
minmax(z2(i),2)
2917 else if (a2(i).lt.
minmax(z2(i),1))
then
2918 print *,
'a2 error:',a2(i),
minmax(z2(i),1)
2923 paz(i) = paz(i)/psum
2925 fissrate(pos)%channelprob(i) = paz(i)
2940 qvalue:
do i=1,
fissrate(pos)%channels
2951 rewind(betafission,iostat=read_stat)
2952 if (read_stat /= 0)
then
2954 "abla_betafiss",190007)
2961 read(betafission,*,iostat=read_stat) dummy
2962 if (read_stat /= 0)
then
2964 "abla_betafiss",190007)
2973 allocate(a1(1),stat=alloc_stat)
2974 allocate(a2(1),stat=alloc_stat)
2975 allocate(z1(1),stat=alloc_stat)
2976 allocate(z2(1),stat=alloc_stat)
2989 a2(1) = nint(fmass/2.d0)
2990 z2(1) = nint(fpnr/2.d0)
2991 a1(1) = fmass - a2(1)
2992 z1(1) = fpnr - z2(1)
2994 a2(1) = nint(fmass/2.d0)
2995 z2(1) = nint(fpnr/2.d0)
2996 a1(1) = fmass - a2(1)
2997 z1(1) = fpnr - z2(1)
3000 z2(1) = nint(52.01 - (fpnr - 80)/1.d1)
3003 a1(1) = fmass - a2(1)
3004 z1(1) = fpnr - z2(1)
3009 if (a1(1).gt.
minmax(z1(1),2))
then
3010 nemiss = a1(1) -
minmax(z1(1),2)
3012 else if (a1(1).lt.
minmax(z1(1),1))
then
3013 print *,
'a1 error:'
3016 if (a2(1).gt.
minmax(z2(1),2))
then
3017 nemiss = nemiss + a2(1) -
minmax(z2(1),2)
3019 else if (a2(1).lt.
minmax(z2(1),1))
then
3020 print *,
'a2 error:',a2(1),
minmax(z2(1),1)
3024 if (nemiss .eq. 0)
then
3032 allocate(
fissrate(pos)%channelprob(1))
3036 fissrate(pos)%channelprob(1) = 1.d0
3045 if (nemiss.gt.0)
then
3047 fissrate(pos)%ch_amount(4) = float(nemiss)
3061 rewind(betafission,iostat=read_stat)
3062 if (read_stat /= 0)
then
3064 "abla_betafiss",190007)
3067 info_exit(
"abla_betafiss")