93 integer :: c_snapshots
95 integer :: file_length
106 read(c_snapshots,*,iostat=rstat)
107 if (rstat .ne. 0)
exit
108 file_length = file_length + 1
113 if (rstat /= 0)
call raise_exception(
'Allocation of "snapshot_time" failed.',
"read_custom_snapshots",&
121 if (rstat .ne. 0)
call raise_exception(
"Unable to read custom snapshots."//new_line(
"A")//&
122 'Check the input file given with the parameter "snapshot_file".',&
123 "read_custom_snapshots",&
133 do while (.not. sorted)
189 integer :: file_length
191 integer :: debug_track
192 character*5 :: nam_tmp
194 info_entry(
"read_track_nuclei")
197 if (verbose_level .gt. 2)
then
200 write(debug_track,
'(A)') &
201 '# Debugging info for read_track_nuclei() from readini.f90'
214 read(track_id,
'(a5)',iostat=istat) nam_tmp
215 if (istat .ne. 0)
exit
217 ind_tmp =
benam(nam_tmp)
220 file_length = file_length + 1
225 if (istat /= 0)
call raise_exception(
'Allocation of "track_nuclei_indices" failed.',
"read_track_nuclei",&
235 read(track_id,
'(a5)',iostat=istat)nam_tmp
237 ind_tmp =
benam(nam_tmp)
239 if (verbose_level .gt. 2)
then
241 write(debug_track,
'("Reading",A,7x,"Index: ",I10)') nam_tmp,ind_tmp
244 if (ind_tmp .ne. 0)
then
249 if (verbose_level .gt. 2)
then
250 write(debug_track,
'("Nucleus",2x,A,2x,"is not contained in network")') nam_tmp
258 if (verbose_level .gt. 2)
then
263 info_exit(
"read_track_nuclei")
314 real(
r_kind),
dimension(net_size),
intent(out) :: iniab
316 character(max_fname_len) :: current_col,col_name,col_unit
317 character(max_fname_len) :: help_reader
320 integer :: a_i,z_i,n_i,x_i,y_i,name_i
323 integer :: skip_count
326 real(
r_kind) :: mafra_norm
327 integer,
dimension(:),
allocatable :: a,z,n
328 real(
r_kind),
dimension(:),
allocatable :: y,x
329 character*5,
dimension(:),
allocatable :: name
330 character(max_fname_len),
dimension(:),
allocatable :: row_read
332 info_entry(
"read_seed")
335 a_i = -1; z_i = -1; n_i = -1; x_i = -1; y_i = -1; name_i = -1
340 if (j>= iachar(
"A") .and. j<=iachar(
"Z") )
then
351 current_col = trim(adjustl(current_col))//
seed_format(i-1:i-1)
354 col_count = col_count +1
358 if ((current_col(j:j) .eq.
':' ) .or. (current_col(j:j) .eq.
' ' ))
exit name_loop
359 col_name = trim(adjustl(col_name))//current_col(j:j)
365 if ((current_col(j:j) .eq.
' ' ))
exit unit_loop
366 col_unit = trim(adjustl(col_unit))//current_col(j:j)
371 select case (trim(adjustl(col_name)))
388 trim(adjustl(
seed_format))//
'". '//new_line(
'A')//&
389 'Can not read column "'//trim(adjustl(col_name))//
'".'//&
390 new_line(
'A')//
'Column type unknown.',
"read_seeds",&
406 read(seed_unit,
"(A)",iostat=istat)help_reader
407 if (istat .ne. 0)
exit
408 help_reader = adjustl(help_reader)
411 if ((skipping .eqv. .true.) .and. (len_trim(help_reader) .eq. 0))
then
412 skip_count = skip_count+1
414 elseif ((skipping .eqv. .true.) .and. (help_reader(1:1) .eq.
"#"))
then
415 skip_count = skip_count+1
422 if ((skipping .eqv. .false.) .and. (len_trim(help_reader) .eq. 0))
then
423 if (verbose_level .gt. 1)
write(*,*)
"Warning, seed file ended unexpectedly."
432 allocate(row_read(col_count),stat=istat)
433 if (istat /= 0)
call raise_exception(
'allocation failed.',
"read_seeds",390001)
434 allocate(a(l_file),z(l_file),n(l_file),y(l_file),x(l_file),name(l_file),stat=istat)
435 if (istat /= 0)
call raise_exception(
'allocation failed.',
"read_seeds",390001)
444 a(:) = 0; z(:) = 0; n(:) = 0; y(:) = 0; x(:) = 0 ; name(:) =
" "
447 read(seed_unit,*)row_read
448 if (a_i .ne. -1) a(i) =
str_to_int(row_read(a_i))
449 if (z_i .ne. -1) z(i) =
str_to_int(row_read(z_i))
450 if (n_i .ne. -1) n(i) =
str_to_int(row_read(n_i))
453 if (name_i .ne. -1) name(i) = trim(adjustl(row_read(name_i)))
458 if ((a_i .eq. -1) .and. (z_i .ne. -1) .and. (n_i .ne. -1))
then
460 elseif ((a_i .ne. -1) .and. (z_i .eq. -1) .and. (n_i .ne. -1))
then
462 elseif ((a_i .ne. -1) .and. (z_i .ne. -1) .and. (n_i .eq. -1))
then
464 elseif ((a_i .ne. -1) .and. (z_i .ne. -1) .and. (n_i .ne. -1))
then
467 if (name_i .ne. -1)
then
470 if(trim(adjustl(name(j))).eq.trim(adjustl(
isotope(i)%name)))
then
485 if ((y_i .ne. -1) .and. (x_i .eq. -1))
then
487 elseif ((y_i .eq. -1) .and. (x_i .ne. -1))
then
490 if (a(i) .eq. 0) a(i) = 1
493 elseif ((y_i .ne. -1) .and. (x_i .ne. -1))
then
496 call raise_exception(
"Not possible to read seeds. Give either Y or X!",&
504 if (abs(mafra_norm-1d0) .gt. 0.1 )
then
505 call raise_exception(
"Norm of seed nuclei was terrible ("//num_to_str(abs(mafra_norm-1d0))//
")! "//&
506 "Check your initial abundances or seed format!",&
511 x(:) = x(:)/mafra_norm
512 y(:) = y(:)/mafra_norm
521 if (name_i .ne. -1)
then
523 if(trim(adjustl(name(j))).eq.trim(adjustl(
isotope(i)%name)))
then
529 if ((z(j) .eq.
isotope(i)%p_nr) .and. (a(j) .eq.
isotope(i)%mass))
then
539 info_exit(
"read_seed")
560 character(len=*),
intent(in) :: unit
563 select case (trim(adjustl(unit)))
579 trim(adjustl(unit))//
'" unknown.',
"time_unit_conversion",&
600 character(len=*),
intent(in) :: unit
603 select case (trim(adjustl(unit)))
621 trim(adjustl(unit))//
'" unknown.',
"temp_unit_conversion",&
642 character(len=*),
intent(in) :: unit
645 select case (trim(adjustl(unit)))
661 trim(adjustl(unit))//
'" unknown.',
"dens_unit_conversion",&
682 character(len=*),
intent(in) :: unit
685 select case (trim(adjustl(unit)))
699 trim(adjustl(unit))//
'" unknown.',
"dist_unit_conversion",&
721 character(len=*),
intent(in) :: unit
724 select case (trim(adjustl(unit)))
734 'Neutrino temperature unit "'//&
735 trim(adjustl(unit))//
'" unknown.',
"nutemp_unit_conversion",&
757 character(len=*),
intent(in) :: unit
760 select case (trim(adjustl(unit)))
770 'Neutrino energy unit "'//&
771 trim(adjustl(unit))//
'" unknown.',
"nuenergy_unit_conversion",&
792 character(len=*),
intent(in) :: unit
795 select case (trim(adjustl(unit)))
805 'Neutrino luminosity unit "'//&
806 trim(adjustl(unit))//
'" unknown.',
"nulumin_unit_conversion",&
871 integer :: traj_unit, i,j, istat
873 integer :: time_i,temp_i,dens_i,rad_i,ye_i
874 integer :: x_i,y_i,z_i
875 real(
r_kind) :: conv_time,conv_temp,conv_dens
876 real(
r_kind) :: conv_rad,conv_ye
877 real(
r_kind) :: conv_x,conv_y,conv_z
878 real(
r_kind) :: x_tmp,y_tmp,z_tmp
879 integer :: nuetemp_i,anuetemp_i
880 integer :: lnue_i,lanue_i
881 real(
r_kind) :: conv_tnue,conv_tanue
882 real(
r_kind) :: conv_lnue,conv_lanue
883 integer :: nuxtemp_i,anuxtemp_i
884 integer :: lnux_i,lanux_i
885 real(
r_kind) :: conv_tnux,conv_tanux
886 real(
r_kind) :: conv_lnux,conv_lanux
887 character(max_fname_len) :: current_col,col_name,col_unit
888 real(
r_kind),
dimension(:),
allocatable :: row_read
890 logical :: log_switch
891 logical :: ls_time,ls_temp,ls_dens,ls_rad
892 logical :: ls_x,ls_y,ls_z,ls_ye
893 logical :: ls_tnue,ls_tanue,ls_lnue,ls_lanue
894 logical :: ls_tnux,ls_tanux,ls_lnux,ls_lanux
895 integer :: skip_count
897 character(max_fname_len) :: help_reader
899 info_entry(
"custom_read")
909 if (j>= iachar(
"A") .and. j<=iachar(
"Z") )
then
922 read(traj_unit,
"(A)",iostat=istat)help_reader
924 if (istat .ne. 0)
exit
926 help_reader = adjustl(help_reader)
928 if ((skipping .eqv. .true.) .and. (len_trim(help_reader) .eq. 0))
then
929 skip_count = skip_count+1
931 elseif ((skipping .eqv. .true.) .and. (help_reader(1:1) .eq.
"#"))
then
932 skip_count = skip_count+1
943 if (istat /= 0)
call raise_exception(
'allocation failed.',
"custom_read",390001)
946 if (((nuflag.ge.1)) .and. (neutrino_mode .eq.
'from_file'))
then
952 if (istat /= 0)
call raise_exception(
'allocation failed.',
"custom_read",390001)
965 nuetemp_i = 0; anuetemp_i = 0
966 lnue_i = 0; lanue_i = 0
968 nuxtemp_i = 0; anuxtemp_i = 0
969 lnux_i = 0; lanux_i = 0
978 col_count = col_count +1
982 if ((current_col(j:j) .eq.
':' ) .or. (current_col(j:j) .eq.
' ' ))
exit name_loop
983 col_name = trim(adjustl(col_name))//current_col(j:j)
989 if ((current_col(j:j) .eq.
' ' ))
exit unit_loop
990 col_unit = trim(adjustl(col_unit))//current_col(j:j)
994 select case (col_name(1:4))
1002 if (log_switch)
then
1003 col_name = col_name(5:)
1007 select case (trim(adjustl(col_name)))
1049 nuetemp_i = col_count
1050 ls_tnue = log_switch
1054 anuetemp_i = col_count
1055 ls_tanue = log_switch
1059 nuetemp_i = col_count
1060 ls_tnue = log_switch
1064 anuetemp_i = col_count
1065 ls_tanue = log_switch
1075 ls_lanue= log_switch
1079 nuxtemp_i = col_count
1080 ls_tnux = log_switch
1084 anuxtemp_i = col_count
1085 ls_tanux = log_switch
1089 nuxtemp_i = col_count
1090 ls_tnux = log_switch
1094 anuxtemp_i = col_count
1095 ls_tanux = log_switch
1105 ls_lanux= log_switch
1113 'Can not read column "'//trim(adjustl(col_name))//
'".'//&
1114 new_line(
'A')//
'Column type unknown.',
"custom_read",&
1123 if ((time_i .eq. 0) .or. (temp_i .eq. 0) .or. (dens_i .eq. 0))
then
1126 'Necessary column is missing.',
"custom_read",&
1134 'Ye was missing.',
"custom_read",&
1139 if (((rad_i .eq. 0) .and. (x_i .eq. 0)) .and. (nuflag.ge.1) )
then
1142 'Radius was missing.',
"custom_read",&
1147 if (((nuflag.ge.1)) .and. (neutrino_mode .eq.
'from_file'))
then
1148 if ((nuetemp_i .eq. 0) .or. (anuetemp_i .eq. 0) .or. (lnue_i .eq. 0) .or. &
1149 (lanue_i .eq. 0))
then
1152 'Necessary column with neutrino information is missing.',
"custom_read",&
1159 if (((nuflag .eq. 4) .or. (nuflag .eq. 5)) .and. (neutrino_mode .eq.
'from_file'))
then
1160 if ((nuxtemp_i .eq. 0) .or. (anuxtemp_i .eq. 0) .or. (lnux_i .eq. 0) .or. &
1161 (lanux_i .eq. 0))
then
1164 'Necessary column with (heavy) neutrino information is missing.',
"custom_read",&
1177 allocate(row_read(col_count),stat=istat)
1178 if (istat /= 0)
call raise_exception(
'Allocation failed.',
"custom_read",390001)
1182 read(traj_unit,*,iostat=istat)row_read
1184 if (istat .ne. 0)
then
1185 call raise_exception(
"Could not read trajectory file."//new_line(
'A')//&
1186 "Line "//
int_to_str(skip_count+i)//
" raised a problem.",&
1187 "custom_read",390024)
1191 if (ls_time)
ztime(i) = 10**(row_read(time_i))
1192 if (.not. ls_time)
ztime(i) = row_read(time_i)
1196 if (ls_dens)
zdens(i) = 10**(row_read(dens_i))
1197 if (.not. ls_dens)
zdens(i) = row_read(dens_i)
1201 if (ls_temp)
ztemp(i) = 10**(row_read(temp_i))
1202 if (.not. ls_temp)
ztemp(i) = row_read(temp_i)
1206 if (ye_i .ne. 0)
then
1207 if (ls_ye)
zye(i) = 10**(row_read(ye_i))
1208 if (.not. ls_ye)
zye(i) = row_read(ye_i)
1215 if (rad_i .ne. 0)
then
1216 if (ls_rad)
zrad(i) = 10**(row_read(rad_i))
1217 if (.not. ls_rad)
zrad(i) = row_read(rad_i)
1219 elseif ((rad_i .eq. 0) .and. (x_i .ne. 0) .and. (y_i .eq. 0) .and. (z_i .eq. 0))
then
1220 if (ls_x) x_tmp = 10**(row_read(x_i))
1221 if (.not. ls_x) x_tmp = row_read(x_i)
1222 zrad(i) = x_tmp*conv_x
1223 elseif ((rad_i .eq. 0) .and. (x_i .ne. 0) .and. (y_i .ne. 0) .and. (z_i .eq. 0))
then
1225 if (ls_x) x_tmp = 10**(row_read(x_i))
1226 if (.not. ls_x) x_tmp = row_read(x_i)
1227 if (ls_y) y_tmp = 10**(row_read(y_i))
1228 if (.not. ls_y) y_tmp = row_read(y_i)
1230 zrad(i) = sqrt((x_tmp*conv_x)**2+(y_tmp*conv_y)**2)
1231 elseif ((rad_i .eq. 0) .and. (x_i .ne. 0) .and. (y_i .ne. 0) .and. (z_i .ne. 0))
then
1233 if (ls_x) x_tmp = 10**(row_read(x_i))
1234 if (.not. ls_x) x_tmp = row_read(x_i)
1235 if (ls_y) y_tmp = 10**(row_read(y_i))
1236 if (.not. ls_y) y_tmp = row_read(y_i)
1237 if (ls_z) z_tmp = 10**(row_read(z_i))
1238 if (.not. ls_z) z_tmp = row_read(z_i)
1239 zrad(i) = sqrt((x_tmp*conv_x)**2+(y_tmp*conv_y)**2+(z_tmp*conv_z)**2)
1248 if ((nuflag.ge.1) .and. (neutrino_mode .eq.
'from_file'))
then
1251 if (ls_tnue)
tnue(i) = 10**row_read(nuetemp_i)
1252 if (.not. ls_tnue)
tnue(i) = row_read(nuetemp_i)
1256 if (ls_tanue)
tnuebar(i) = 10**row_read(anuetemp_i)
1257 if (.not. ls_tanue)
tnuebar(i) = row_read(anuetemp_i)
1261 if (ls_lnue)
nlume(i) = 10**row_read(lnue_i)
1262 if (.not. ls_lnue)
nlume(i) = row_read(lnue_i)
1265 if (ls_lanue)
nlumebar(i) = 10**row_read(lanue_i)
1266 if (.not. ls_lanue)
nlumebar(i) = row_read(lanue_i)
1276 if ( ((nuflag .eq. 4) .or. (nuflag .eq. 5)) .and. (neutrino_mode .eq.
'from_file'))
then
1278 if (ls_tnux)
tnux(i) = 10**row_read(nuxtemp_i)
1279 if (.not. ls_tnux)
tnux(i) = row_read(nuxtemp_i)
1283 if (ls_tanux)
tnuxbar(i) = 10**row_read(anuxtemp_i)
1284 if (.not. ls_tanux)
tnuxbar(i) = row_read(anuxtemp_i)
1288 if (ls_lnux)
nlumx(i) = 10**row_read(lnux_i)
1289 if (.not. ls_lnux)
nlumx(i) = row_read(lnux_i)
1293 if (ls_lanux)
nlumxbar(i) = 10**row_read(lanux_i)
1294 if (.not. ls_lanux)
nlumxbar(i) = row_read(lanux_i)
1311 if ((nuflag.ge.1) .and. (neutrino_mode .eq.
'from_file'))
then
1318 if ( ((nuflag .eq. 4) .or. (nuflag .eq. 5)) .and. &
1319 (neutrino_mode .eq.
'from_file'))
then
1329 info_exit(
"custom_read")
1353 call raise_exception(
"Last point of trajectory had negative time ("//&
1355 ")!"//new_line(
'A')//
'Please check your input trajectory.',&
1356 "consistency_check",&
1359 elseif ((maxval(
zye) .gt. 1) .or. (minval(
zye) .lt. 0))
then
1360 call raise_exception(
"The electron fraction was out of bounds (0 < Ye < 1)! "//&
1361 new_line(
'A')//
'Please check your input trajectory.',&
1362 "consistency_check",&
1370 if (isnan(dexp(
zrad(i))))
then
1372 'The radius was below zero."'//new_line(
'A')//&
1373 'Please check your input trajectory.',
"consistency_check",&
1376 elseif (isnan(dexp(
ztemp(i))))
then
1378 'The temperature was below zero".'//new_line(
'A')//&
1379 'Please check your input trajectory.',
"consistency_check",&
1382 elseif (isnan(dexp(
zdens(i))))
then
1384 'The density was below zero".'//new_line(
'A')//&
1385 'Please check your input trajectory.',
"consistency_check",&
1393 new_line(
'A')//
"Check your trajectory!",
"consistency_check",&