Skip to content

Commit d4fd221

Browse files
whaeckwhaeck
committed
Updating ...
2 parents 9b73318 + db71977 commit d4fd221

2 files changed

Lines changed: 107 additions & 22 deletions

File tree

‎src/groupr.f90‎

Lines changed: 67 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -251,6 +251,8 @@ subroutine groupr
251251
! 32 ukaea 1102-group structure (1 GeV)
252252
! 33 ukaea 142-group structure (200 MeV)
253253
! 34 lanl 618-group structure
254+
! 35 apollo 99-group structure
255+
! 36 ecco 1962-group structure
254256
!
255257
! igg meaning
256258
! --- -------
@@ -1635,6 +1637,8 @@ subroutine gengpn(ign,ngn,egn)
16351637
! 32 UKAEA 1102-group structure
16361638
! 33 UKAEA 142-group structure
16371639
! 34 LANL 618 group structure
1640+
! 35 APOLLO 99-group structure
1641+
! 36 ECCO 1962-group structure
16381642
!
16391643
!-------------------------------------------------------------------
16401644
use mainio ! provides nsyso
@@ -2673,8 +2677,8 @@ subroutine gengpn(ign,ngn,egn)
26732677
6.772865E+02_kr,7.485173E+02_kr,8.322179E+02_kr,9.096813E+02_kr,&
26742678
9.824941E+02_kr,1.064323E+03_kr,1.134667E+03_kr,1.343582E+03_kr,&
26752679
1.586197E+03_kr,1.811833E+03_kr,2.084104E+03_kr,2.397290E+03_kr,&
2676-
2.700236E+03_kr,2.996183E+03_kr,3.481068E+03_kr,4.097345E+03_kr,&
2677-
5.004508E+03_kr,6.112520E+03_kr,7.465848E+03_kr,9.118808E+03_kr,&
2680+
2.700236E+03_kr,2.996183E+03_kr,3.481068E+03_kr,3.936685E+03_kr,&
2681+
4.856602E+03_kr,5.991484E+03_kr,7.391562E+03_kr,9.118808E+03_kr,&
26782682
1.113774E+04_kr,1.360366E+04_kr,1.489967E+04_kr,1.620045E+04_kr,&
26792683
1.858471E+04_kr,2.269941E+04_kr,2.499908E+04_kr,2.610010E+04_kr,&
26802684
2.739441E+04_kr,2.928101E+04_kr,3.345961E+04_kr,3.697859E+04_kr,&
@@ -2765,8 +2769,8 @@ subroutine gengpn(ign,ngn,egn)
27652769
8.322179E+02_kr,9.096813E+02_kr,9.824941E+02_kr,1.064323E+03_kr,&
27662770
1.134667E+03_kr,1.343582E+03_kr,1.586197E+03_kr,1.811833E+03_kr,&
27672771
2.084104E+03_kr,2.397290E+03_kr,2.700236E+03_kr,2.996183E+03_kr,&
2768-
3.481068E+03_kr,4.097345E+03_kr,5.004508E+03_kr,6.112520E+03_kr,&
2769-
7.465848E+03_kr,9.118808E+03_kr,1.113774E+04_kr,1.360366E+04_kr,&
2772+
3.481068E+03_kr,3.936685E+03_kr,4.856602E+03_kr,5.991484E+03_kr,&
2773+
7.391562E+03_kr,9.118808E+03_kr,1.113774E+04_kr,1.360366E+04_kr,&
27702774
1.489967E+04_kr,1.620045E+04_kr,1.858471E+04_kr,2.269941E+04_kr,&
27712775
2.499908E+04_kr,2.610010E+04_kr,2.739441E+04_kr,2.928101E+04_kr,&
27722776
3.345961E+04_kr,3.697859E+04_kr,4.086766E+04_kr,4.991587E+04_kr,&
@@ -2843,8 +2847,8 @@ subroutine gengpn(ign,ngn,egn)
28432847
1.343584E+03_kr,1.586199E+03_kr,1.811835E+03_kr,2.034684E+03_kr,&
28442848
2.284941E+03_kr,2.423809E+03_kr,2.571117E+03_kr,2.768596E+03_kr,&
28452849
2.951579E+03_kr,3.146656E+03_kr,3.354626E+03_kr,3.707435E+03_kr,&
2846-
4.097350E+03_kr,4.528272E+03_kr,5.004514E+03_kr,5.530844E+03_kr,&
2847-
6.112528E+03_kr,6.755388E+03_kr,7.465858E+03_kr,8.251049E+03_kr,&
2850+
3.936685E+03_kr,4.372518E+03_kr,4.856602E+03_kr,5.394280E+03_kr,&
2851+
5.991484E+03_kr,6.654805E+03_kr,7.391562E+03_kr,8.209886E+03_kr,&
28482852
9.118820E+03_kr,1.007785E+04_kr,1.113775E+04_kr,1.360368E+04_kr,&
28492853
1.503439E+04_kr,1.620047E+04_kr,1.858473E+04_kr,2.269944E+04_kr,&
28502854
2.478752E+04_kr,2.610013E+04_kr,2.739445E+04_kr,2.928104E+04_kr,&
@@ -4100,6 +4104,32 @@ subroutine gengpn(ign,ngn,egn)
41004104
1.92500000000000e+07_kr,1.93750000000000e+07_kr,1.95000000000000e+07_kr,&
41014105
1.96250000000000e+07_kr,1.97500000000000e+07_kr,1.98750000000000e+07_kr,&
41024106
2.00000000000000e+07_kr/)
4107+
real(kr),parameter::eg35(100)=(/&
4108+
1.100000E-04_kr,3.000000E-03_kr,5.500000E-03_kr,1.000000E-02_kr,&
4109+
1.500000E-02_kr,2.000000E-02_kr,3.000000E-02_kr,4.300000E-02_kr,&
4110+
5.900000E-02_kr,7.700000E-02_kr,9.500000E-02_kr,1.150000E-01_kr,&
4111+
1.340000E-01_kr,1.600000E-01_kr,1.890000E-01_kr,2.200000E-01_kr,&
4112+
2.480000E-01_kr,2.825000E-01_kr,3.145000E-01_kr,3.520000E-01_kr,&
4113+
3.910000E-01_kr,4.330000E-01_kr,4.850000E-01_kr,5.400000E-01_kr,&
4114+
6.250000E-01_kr,7.050000E-01_kr,7.900000E-01_kr,8.600000E-01_kr,&
4115+
9.300000E-01_kr,9.860001E-01_kr,1.035000E+00_kr,1.070000E+00_kr,&
4116+
1.110000E+00_kr,1.170000E+00_kr,1.235000E+00_kr,1.305000E+00_kr,&
4117+
1.370000E+00_kr,1.440000E+00_kr,1.510000E+00_kr,1.590000E+00_kr,&
4118+
1.670000E+00_kr,1.755000E+00_kr,1.840000E+00_kr,1.930000E+00_kr,&
4119+
2.020000E+00_kr,2.130000E+00_kr,2.360000E+00_kr,2.767920E+00_kr,&
4120+
3.380745E+00_kr,4.129250E+00_kr,5.043477E+00_kr,6.160121E+00_kr,&
4121+
7.523987E+00_kr,9.189817E+00_kr,1.122447E+01_kr,1.370959E+01_kr,&
4122+
1.674495E+01_kr,2.045232E+01_kr,2.498051E+01_kr,3.051126E+01_kr,&
4123+
3.726653E+01_kr,4.551748E+01_kr,5.559517E+01_kr,6.790408E+01_kr,&
4124+
9.166093E+01_kr,1.367420E+02_kr,2.039952E+02_kr,3.043250E+02_kr,&
4125+
4.539993E+02_kr,6.772877E+02_kr,1.010394E+03_kr,1.507332E+03_kr,&
4126+
2.248674E+03_kr,3.354626E+03_kr,5.004517E+03_kr,7.465859E+03_kr,&
4127+
1.113776E+04_kr,1.661558E+04_kr,2.478752E+04_kr,3.697866E+04_kr,&
4128+
5.516566E+04_kr,8.229753E+04_kr,1.227735E+05_kr,1.831564E+05_kr,&
4129+
2.732374E+05_kr,4.076221E+05_kr,6.081011E+05_kr,9.071799E+05_kr,&
4130+
1.108032E+06_kr,1.353353E+06_kr,1.652990E+06_kr,2.018966E+06_kr,&
4131+
2.465971E+06_kr,3.011943E+06_kr,3.678794E+06_kr,4.493290E+06_kr,&
4132+
5.488117E+06_kr,6.703201E+06_kr,8.187308E+06_kr,1.000000E+07_kr/)
41034133
real(kr),parameter::ezero=1.e7_kr
41044134
real(kr),parameter::tenth=0.10e0_kr
41054135
real(kr),parameter::eighth=0.125e0_kr
@@ -4499,6 +4529,30 @@ subroutine gengpn(ign,ngn,egn)
44994529
egn(ig)=eg618(ig)
45004530
enddo
45014531

4532+
!--apollo 99-group structure
4533+
else if (ign.eq.35) then
4534+
ngn=99
4535+
ngp=ngn+1
4536+
allocate(egn(ngp))
4537+
do ig=1,ngp
4538+
egn(ig)=eg35(ig)
4539+
enddo
4540+
4541+
!--ecco 1962-group structure
4542+
else if (ign.eq.36) then
4543+
ngn=1962
4544+
ngp=ngn+1
4545+
allocate(egn(ngp))
4546+
do ig=1,392
4547+
egn(ig)=eg20a(ig)
4548+
enddo
4549+
do ig=1,392
4550+
egn(ig+392)=eg20b(ig)
4551+
enddo
4552+
do ig=785,ngp
4553+
egn(ig)=egn(ig-1)*exp(1.0d0/120.0d0)
4554+
enddo
4555+
45024556
!--illegal ign
45034557
else
45044558
call error('gengpn','illegal group structure.',' ')
@@ -4579,6 +4633,12 @@ subroutine gengpn(ign,ngn,egn)
45794633
& '' neutron group structure......ukaea 1102-group'')')
45804634
if (ign.eq.33) write(nsyso,'(/&
45814635
& '' neutron group structure......ukaea 142-group'')')
4636+
if (ign.eq.34) write(nsyso,'(/&
4637+
& '' neutron group structure......lanl 618-group'')')
4638+
if (ign.eq.35) write(nsyso,'(/&
4639+
& '' neutron group structure......apollo 99-group'')')
4640+
if (ign.eq.36) write(nsyso,'(/&
4641+
& '' neutron group structure......ecco 1962-group'')')
45824642
if (ign.ne.-1) then
45834643
do ig=1,ngn
45844644
write(nsyso,'(1x,i5,2x,1p,e12.5,'' - '',e12.5)')&
@@ -11805,7 +11865,7 @@ subroutine getsed(ed,enext,idis,sed,eg,ng,nk,matd,mfd,mtd,nin)
1180511865
ethi=0
1180611866
if (ed.eq.zero) then
1180711867
ier=1
11808-
ntmp=250000
11868+
ntmp=300000
1180911869
do while (ier.ne.0)
1181011870
if (allocated(tmp)) deallocate(tmp)
1181111871
allocate(tmp(ntmp),stat=ier)

‎src/purr.f90‎

Lines changed: 40 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -1910,7 +1910,7 @@ subroutine unrest(bkg,sig0,sigf,tabl,tval,er,gnr,gfr,ggr,gxr,gt,&
19101910
els(itemp,ie)=spot
19111911
enddo
19121912
enddo
1913-
call fsort(es,xs,ne,1)
1913+
call fsort(es,ne)
19141914

19151915
!--loop over sequences
19161916
do 170 k=1,nseq0
@@ -2277,7 +2277,7 @@ subroutine unrest(bkg,sig0,sigf,tabl,tval,er,gnr,gfr,ggr,gxr,gt,&
22772277
do ie=1,ne
22782278
es(ie)=els(itemp,ie)+fis(itemp,ie)+cap(itemp,ie)+bkg(1)
22792279
enddo
2280-
call fsort(es,xs,ne,1)
2280+
call fsort(es,ne)
22812281
tmin(itemp)=es(1)
22822282
tmax(itemp)=es(ne)
22832283
nebin=int(nsamp/(nbin-10+1.76))
@@ -2780,7 +2780,7 @@ subroutine uw2(rez,aim1,rew,aimw)
27802780
return
27812781
end subroutine uw2
27822782

2783-
subroutine fsort(x,y,n,i)
2783+
subroutine fsort(x,n)
27842784
!-------------------------------------------------------------------
27852785
! Floating-point sort routine.
27862786
! Sort x and y into increasing x order.
@@ -2792,21 +2792,46 @@ subroutine fsort(x,y,n,i)
27922792
integer::k,j
27932793
real(kr)::xt,yt
27942794

2795-
do k=1,n-1
2796-
do j=k+1,n
2797-
if (x(k).gt.x(j)) then
2798-
xt=x(k)
2799-
yt=y(k)
2800-
x(k)=x(j)
2801-
y(k)=y(j)
2802-
x(j)=xt
2803-
y(j)=yt
2804-
endif
2805-
enddo
2806-
enddo
2795+
if (n <= 1) return
2796+
call quicksort(x,1,n)
2797+
28072798
return
28082799
end subroutine fsort
28092800

2801+
recursive subroutine quicksort(a,l,r)
2802+
real(kr), intent(inout) :: a(:)
2803+
integer, intent(in) :: l, r
2804+
integer :: i, j
2805+
real(kr) :: pivot, ta
2806+
2807+
i = l
2808+
j = r
2809+
pivot = a((l+r)/2)
2810+
2811+
do
2812+
do while (a(i) < pivot)
2813+
i = i + 1
2814+
end do
2815+
do while (a(j) > pivot)
2816+
j = j - 1
2817+
end do
2818+
2819+
if (i <= j) then
2820+
ta = a(i)
2821+
a(i) = a(j)
2822+
a(j) = ta
2823+
2824+
i = i + 1
2825+
j = j - 1
2826+
end if
2827+
2828+
if (i > j) exit
2829+
end do
2830+
2831+
if (l < j) call quicksort(a,l,j)
2832+
if (i < r) call quicksort(a,i,r)
2833+
end subroutine quicksort
2834+
28102835
subroutine fsrch(x,xarray,n,i,k)
28112836
!-------------------------------------------------------------------
28122837
! Floating-point search routine.

0 commit comments

Comments
 (0)