diff --git a/sammy/src/ang/mang0.f b/sammy/src/ang/mang0.f
index 4ff442bf3d2e5a863f661e0819bd10f0a58cadef..86b73827d6c3745baba485752310fcb48db4213b 100644
--- a/sammy/src/ang/mang0.f
+++ b/sammy/src/ang/mang0.f
@@ -66,7 +66,7 @@ C ### two
Iruth = Idimen (Nangle, 1, 'I_Ruth Nangle, 1')
C
C *** Generate differential elastic cross sections from Coefficients of P_L
- CALL Diffee (I_Inent , I_Ilspin , A_Izke ,
+ CALL Diffee (A_Izke ,
* A_Izeta , A_Iccoul , A_Idcoul , A_Iangle , A_Idangl , A_Iprmsc ,
* I_Iflmsc , A_Iprnbk , I_Iflnbk , A(Ie ), A(Ieb ),
* A(Ith ), I_Iisopa , A(Iwsigx), A(Iwdasi), A_Iwdbsi , A(Isigxx),
diff --git a/sammy/src/ang/mang1.f b/sammy/src/ang/mang1.f
index c28132bd7e5ed4d93b7cadfa7ec4a7afb0cbaa60..72eed77f99469b2980775cb98cf5fb1fe191d310 100644
--- a/sammy/src/ang/mang1.f
+++ b/sammy/src/ang/mang1.f
@@ -2,7 +2,7 @@ C
C
C ______________________________________________________________________
C
- SUBROUTINE Diffee (Nent , Lspin , Zke , Zeta ,
+ SUBROUTINE Diffee (Zke , Zeta ,
* Ccoul , Dcoul , Angle , Dangle, Parmsc, Iflmsc, Parnbk, Iflnbk,
* Energy, Energb, Theory, Isopar, Wsigxx, Wdasig, Wdbsig,
* Sigxxx, Dasigx, Dbsigx, Vsigxx, Vdasig, Vdbsig, Ccclll, Poly ,
@@ -25,7 +25,7 @@ C
IMPLICIT DOUBLE PRECISION (a-h,o-z)
LOGICAL Another_Process_Will_Happen, Need_Isotopes
C
- DIMENSION Nent(*), Lspin(Ntotc,*),
+ DIMENSION
* Zke(Ntotc,*), Zeta(Ntotc,*), Ccoul(2,Ntotc,Ngroup,*),
* Dcoul(2,Ntotc,Nnpar,Ngroup,*), Iruth(*)
DIMENSION Angle(*), Dangle(*), Parmsc(*), Iflmsc(*), Parnbk(*),
@@ -183,7 +183,7 @@ C ****** summed over all Q for this isotope
C
C ****** If (elastic, and Coulomb must be included) Then (do so)
IF (IfCoul.GT.0) THEN
- CALL Include_Coulomb (Nent, Lspin, Zke,
+ CALL Include_Coulomb (Zke,
* Zeta, Ccoul, Dcoul, Sigxxx, Dasigx, Dbsigx, Angle,
* Polyx, Comang, Iruth, Em, Jjdat, Isox, Np)
END IF
@@ -731,7 +731,7 @@ C
C
C ______________________________________________________________________
C
- SUBROUTINE Include_Coulomb (Nent, Lspin, Zke,
+ SUBROUTINE Include_Coulomb (Zke,
* Zeta, Ccoul, Dcoul, Sigxxx, Dasigx, Dbsigx, Angle,
* Polyx, Comang, I_Rutherford, Ee, Jjdat, Isox, Np)
use fixedi_m
@@ -740,7 +740,7 @@ C
use EndfData_common_m
use SammySpinGroupInfo_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
- DIMENSION Nent(*), Lspin(Ntotc,*),
+ DIMENSION
* Zke(Ntotc,*), Zeta(Ntotc,*), Ccoul(2,Ntotc,Ngroup,*),
* Dcoul(2,Ntotc,Nnpar,Ngroup,*), Sigxxx(*),
* Dasigx(Nangle,*), Dbsigx(Nangle,*), Angle(*),
@@ -749,6 +749,8 @@ C
c
c
type(SammySpinGroupInfo)::spinIg, spinIsox
+ type(RMatChannelParams)::channel
+ type(SammyChannelInfo)::channelInfo
DATA One /1.0d0/, Two /2.0d0/
DATA Fff /0.0025d0/
C / 0.01 over 4 /
@@ -762,9 +764,11 @@ C
call resParData%getSpinGroupInfo(spinIg, Igroup)
Kgriso = spinIg%getIsotopeIndex()
IF (Niniso.EQ.1 .OR. Kgriso.EQ.Isox) THEN
- DO Ich=1,Nent(Igroup)
+ DO Ich=1,spinIg%getNumEntryChannels()
+ call spinIg%getChannelInfo(channelInfo, Ich)
+ call resParData%getChannel(channel, channelInfo)
Eta = Zeta(Ich,Igroup)/Dsqrt(Ee)
- L = Lspin(Ich,Igroup)
+ L = channel%getL()
call resParData%getSpinGroupInfo(spinIsox, Isox)
Ab = spinIsox%getAbundance() *
diff --git a/sammy/src/avg/mavg0.f b/sammy/src/avg/mavg0.f
index 01b5e861fec82dfce160a06dc75a19596ad813b9..d7e50913bd7a4ae7815b3f778deb468370bd51bf 100755
--- a/sammy/src/avg/mavg0.f
+++ b/sammy/src/avg/mavg0.f
@@ -201,8 +201,7 @@ C *** routine Thefix finds covariance on theoretical cross sections
C *** using covariance on parameters + avg'd partial derivatives
C
IF (Kpasfe.EQ.1) THEN
- CALL Resetgx (I_Intot , I_Ilpent , I_Ilspin , A_Iechan ,
- * A_Izkte , A(Igq ), Ndatq)
+ CALL Resetgx (A_Iechan , A_Izkte , A(Igq ), Ndatq)
C *** sub Resetgx converts to ENDF-style resonance parameters,
C *** and prints the partial derivatives (sensitivities) into
C *** file SAMSEN.DAT
diff --git a/sammy/src/avg/mavg6.f b/sammy/src/avg/mavg6.f
index 2f8383d39fa21ea96a3e5bcbca0a55ea90c9c13c..22c80b361a41908cb39d5dfbf0a30abcc6e21045 100644
--- a/sammy/src/avg/mavg6.f
+++ b/sammy/src/avg/mavg6.f
@@ -138,8 +138,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Resetgx (Ntot, Lpent, Lspin, Echan,
- * Zkte, Wdasig, Ndatq)
+ SUBROUTINE Resetgx (Echan, Zkte, Wdasig, Ndatq)
C
C *** PURPOSE -- Debug printout of partial derivatives
C *** for comparison with ErrorJ and PUPP codes
@@ -152,11 +151,15 @@ C
IMPLICIT DOUBLE PRECISION (a-h,o-z)
CHARACTER*11 Gam
C
- DIMENSION Ntot(*), Lpent(Ntotc,*), Lspin(Ntotc,*), Echan(Ntotc,*),
- * Zkte(Ntotc,*),
+ DIMENSION Echan(Ntotc,*), Zkte(Ntotc,*),
* Wdasig(Nvpall,*), Gnx(5), Gny(5)
C
type(SammyResonanceInfo)::resInfo
+ type(SammySpinGroupInfo)::spinInfo
+ type(SammyChannelInfo)::channelInfo
+ type(RMatChannelParams)::channel
+ type(SammyParticlePairInfo)::pairInfo
+ type(RMatParticlePair)::pair
type(RMatResonance)::resonance, resonanceRed
DATA Zero /0.0d0/, Half /0.5d0/, Thous /1000.0d0/
DATA Gam /' Gamma_'/
@@ -176,7 +179,8 @@ C
call resParData%getResonance(resonance, resInfo)
call resParData%getRedResonance(resonanceRed, resInfo)
Igrp = resInfo%getSpinGroupIndex()
- Ntotik = Ntot(Igrp)
+ call resParData%getSpinGroupInfo(spinInfo, Igrp)
+ Ntotik = spinInfo%getNumChannels()
IF (Ntotik.GT.5) Ntotik = 5
WRITE (29,10200) K, (Gam, J, J=1,Ntotik)
10200 FORMAT ('Resonance number', I2, /,
@@ -190,16 +194,25 @@ C
Eey = -Eex
C *** June 4, 2004; signs are correct for negative-energy resonances.
END IF
- IF (Lpent(1,Igrp).NE.0) THEN
+ iela = spinInfo%getElasticChannel()
+ call spinInfo%getChannelInfo(channelInfo, iela)
+ call resParData%getChannel(channel, channelInfo)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ IF (pair%getPnt().NE.0) THEN
Q = dABS(resonance%getEres()-Echan(1,Igrp))
IF (Q.NE.Zero) THEN
Q = dSQRT(Q)
Rho = Zkte(1,Igrp)*Q
- Lsp = Lspin(1,Igrp)
+ Lsp = channel%getL()
cq IF (Zeta(M2,Igrp).EQ.Zero) THEN
cq Assume no Coulomb; also (probably) no threshold cuz that's not right yet
P = Pfd (Rho, Der, Lsp)
- width = resonanceRed%getWidth(2)
+ ichan = spinInfo%getElasticChannel()
+ ichan = spinInfo%getWidthForChannel(ichan)
+ width = resonanceRed%getWidth(ichan)
Eey = - Zkte(1,Igrp) * Eey * Half*width * Der/P
cq END IF
END IF
@@ -207,8 +220,9 @@ cq END IF
C
DO N=1,Ntotik
C *** Particle Width
- Gn = resonance%getWidth(N+1)
- Bn = resonanceRed%getWidth(N+1)
+ ichan = spinInfo%getWidthForChannel(N)
+ Gn = resonance%getWidth(ichan)
+ Bn = resonanceRed%getWidth(ichan)
IF (Gn.GT.Zero) THEN
Gn = Half*Bn/Gn
ELSE IF (Gn.LT.Zero) THEN
@@ -217,11 +231,12 @@ C *** Particle Width
Gnx(N) = Gn*Thous
END DO
C
- Ggx = resonance%getWidth(1)
+ ichan = spinInfo%getGammaWidthIndex()
+ Ggx = resonance%getWidth(ichan)
IF (Ggx.GT.Zero) THEN
- Ggx = Half*resonanceRed%getWidth(1)/Ggx
+ Ggx = Half*resonanceRed%getWidth(ichan)/Ggx
ELSE
- Ggx = - Half*resonanceRed%getWidth(1)/Ggx
+ Ggx = - Half*resonanceRed%getWidth(ichan)/Ggx
END IF
Ggx = Ggx * Thous
C
diff --git a/sammy/src/blk/Exploc_common.f90 b/sammy/src/blk/Exploc_common.f90
index f516aac0144f36cadbb721a2c27804c4d1b6f480..68bae62412e9cafa08d1108aae32f17d67d3f923 100644
--- a/sammy/src/blk/Exploc_common.f90
+++ b/sammy/src/blk/Exploc_common.f90
@@ -10,33 +10,14 @@ module exploc_common_m
real(kind=8),allocatable,dimension(:)::A_Iprbrd
integer,allocatable,dimension(:)::I_Iflbrd
real(kind=8),allocatable,dimension(:)::A_Isiabn
- real(kind=8),allocatable,dimension(:)::A_Igoj
! old group 2
- integer,allocatable,dimension(:)::I_Inent
- integer,allocatable,dimension(:)::I_Inext
- integer,allocatable,dimension(:)::I_Intot
- integer,allocatable,dimension(:)::I_Iishif
- integer,allocatable,dimension(:)::I_Ilpent
integer,allocatable,dimension(:)::I_Ifexcl
- integer,allocatable,dimension(:)::I_Ilspin
- real(kind=8),allocatable,dimension(:)::A_Ichspi
-
+
! old group 3
- real(kind=8),allocatable,dimension(:)::A_Ienbnd
real(kind=8),allocatable,dimension(:)::A_Ibound
real(kind=8),allocatable,dimension(:)::A_Iechan
- real(kind=8),allocatable,dimension(:)::A_Irdeff
- real(kind=8),allocatable,dimension(:)::A_Irdtru
- real(kind=8),allocatable,dimension(:)::A_Iemmm1
- real(kind=8),allocatable,dimension(:)::A_Iemmm2
-
- ! old group 4
- integer,allocatable,dimension(:)::I_Izzzz1
- integer,allocatable,dimension(:)::I_Izzzz2
- integer,allocatable,dimension(:)::I_Ixclud
- real(kind=8),allocatable,dimension(:)::A_Ispinx
-
+
! old group 5
integer,allocatable,dimension(:)::I_Ifcros
real(kind=8),allocatable,dimension(:)::A_Iangle
@@ -162,10 +143,7 @@ module exploc_common_m
! old group 9
integer,allocatable,dimension(:)::I_Iint
real(kind=8),allocatable,dimension(:)::A_Iresol
- integer,allocatable,dimension(:)::I_Iisopa
- integer,allocatable,dimension(:)::I_Ikppai
- real(kind=8),allocatable,dimension(:)::A_Ispnn1
- real(kind=8),allocatable,dimension(:)::A_Ispnn2
+ integer,allocatable,dimension(:)::I_Iisopa
real(kind=8),allocatable,dimension(:)::A_Iccoul
real(kind=8),allocatable,dimension(:)::A_Idcoul
@@ -224,65 +202,11 @@ module exploc_common_m
call allocate_real_data(A_Isiabn,want)
end subroutine make_A_Isiabn
-
- subroutine make_A_Igoj(want)
- integer::want
- call allocate_real_data(A_Igoj,want)
- end subroutine make_A_Igoj
-
-
- subroutine make_I_Inent(want)
- integer::want
- call allocate_integer_data(I_Inent,want)
- end subroutine make_I_Inent
-
-
- subroutine make_I_Inext(want)
- integer::want
- call allocate_integer_data(I_Inext,want)
- end subroutine make_I_Inext
-
-
- subroutine make_I_Intot(want)
- integer::want
- call allocate_integer_data(I_Intot,want)
- end subroutine make_I_Intot
-
-
-
- subroutine make_I_Iishif(want)
- integer::want
- call allocate_integer_data(I_Iishif,want)
- end subroutine make_I_Iishif
-
-
- subroutine make_I_Ilpent(want)
- integer::want
- call allocate_integer_data(I_Ilpent,want)
- end subroutine make_I_Ilpent
-
-
subroutine make_I_Ifexcl(want)
integer::want
call allocate_integer_data(I_Ifexcl,want)
end subroutine make_I_Ifexcl
- subroutine make_I_Ilspin(want)
- integer::want
- call allocate_integer_data(I_Ilspin,want)
- end subroutine make_I_Ilspin
-
-
- subroutine make_A_Ichspi(want)
- integer::want
- call allocate_real_data(A_Ichspi,want)
- end subroutine make_A_Ichspi
-
- subroutine make_A_Ienbnd(want)
- integer::want
- call allocate_real_data(A_Ienbnd,want)
- end subroutine make_A_Ienbnd
-
subroutine make_A_Ibound(want)
integer::want
call allocate_real_data(A_Ibound,want)
@@ -292,46 +216,6 @@ module exploc_common_m
integer::want
call allocate_real_data(A_Iechan,want)
end subroutine make_A_Iechan
-
- subroutine make_A_Irdeff(want)
- integer::want
- call allocate_real_data(A_Irdeff,want)
- end subroutine make_A_Irdeff
-
- subroutine make_A_Irdtru(want)
- integer::want
- call allocate_real_data(A_Irdtru,want)
- end subroutine make_A_Irdtru
-
- subroutine make_A_Iemmm1(want)
- integer::want
- call allocate_real_data(A_Iemmm1,want)
- end subroutine make_A_Iemmm1
-
- subroutine make_A_Iemmm2(want)
- integer::want
- call allocate_real_data(A_Iemmm2,want)
- end subroutine make_A_Iemmm2
-
- subroutine make_I_Izzzz1(want)
- integer::want
- call allocate_integer_data(I_Izzzz1,want)
- end subroutine make_I_Izzzz1
-
- subroutine make_I_Izzzz2(want)
- integer::want
- call allocate_integer_data(I_Izzzz2,want)
- end subroutine make_I_Izzzz2
-
- subroutine make_I_Ixclud(want)
- integer::want
- call allocate_integer_data(I_Ixclud,want)
- end subroutine make_I_Ixclud
-
- subroutine make_A_Ispinx(want)
- integer::want
- call allocate_real_data(A_Ispinx,want)
- end subroutine make_A_Ispinx
subroutine make_I_Ifcros(want)
integer::want
@@ -801,21 +685,6 @@ module exploc_common_m
call allocate_integer_data(I_Iisopa,want)
end subroutine make_I_Iisopa
- subroutine make_I_Ikppai(want)
- integer::want
- call allocate_integer_data(I_Ikppai,want)
- end subroutine make_I_Ikppai
-
- subroutine make_A_Ispnn1(want)
- integer::want
- call allocate_real_data(A_Ispnn1,want)
- end subroutine make_A_Ispnn1
-
- subroutine make_A_Ispnn2(want)
- integer::want
- call allocate_real_data(A_Ispnn2,want)
- end subroutine make_A_Ispnn2
-
subroutine make_A_Iccoul(want)
integer::want
call allocate_real_data(A_Iccoul,want)
diff --git a/sammy/src/cro/mcro0.f b/sammy/src/cro/mcro0.f
index 20061fe6e70b1ba6b8d086dc2771063022010e8b..436b37481f8c0f43d6108e9a7ccf2381f52dfa3a 100644
--- a/sammy/src/cro/mcro0.f
+++ b/sammy/src/cro/mcro0.f
@@ -75,7 +75,7 @@ C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - <
Inpxdr = Idimen (Ngroup, 1, 'Ngroup, 1')
Krext = Nrext
IF (Nrext.EQ.0) Krext = 1
- IF (Ksolve.NE.2) CALL Ppar(I_Intot , I_Iflext ,
+ IF (Ksolve.NE.2) CALL Ppar(I_Iflext ,
* A(Iiuif), A(Inprdr), A(Inpxdr), Krext)
C *** Sbroutine Ppar_Cro Sets Nprdr and Npxdr
C
@@ -90,8 +90,8 @@ C
C - - - - - - - - - - - - - - - - - - - - - - - - - - - <
C *** three ***
Ix1 = Idimen (NA, 1, 'NA, 1')
- IF (Nres.GT.0) CALL Fixx (I_Intot , I_Iishif , I_Ilspin ,
- * A_Ibound , A_Iechan , I_Ixclud ,
+ IF (Nres.GT.0) CALL Fixx (
+ * A_Ibound , A_Iechan ,
* A_Izkte , A(Ixx ), A(Ix1 ), Mxany)
C *** Sbroutine Fixx sets Xx = energy shift
I = Idimen (Ix1, -1, 'Ix1, -1')
@@ -99,7 +99,7 @@ C - - - - - - - - - - - - - - - - - - - - - - - - - - - >
C
C
c Fals is passed to babb since it is used to set parameters NOT for numerical differentiation
- IF (Ksolve.NE.2 .AND. Napres.NE.0) CALL Babb(I_Intot ,
+ IF (Ksolve.NE.2 .AND. Napres.NE.0) CALL Babb(
* A_Ipolar , I_Iflpol , A(Iiuif), A(Ibr), A(Ibi), A(Ixx),.false.)
C *** Sbroutine Babb_cro generates energy-independent portion of
C *** partial derivatives
@@ -181,7 +181,7 @@ C *** eight ***
* A_Iteabg , A(Ienerb), A(Ith ), A(Iwsigx), A(Iwdasi),
* A_Iwdbsi , A(Isigxx), A(Idasig), A(Idbsig), I_Iisopa ,
* A(Ipiece), A(Idum ), A_Iadder , A_Iaddcr ,
- * I_Inbt , I_Iint , I_Intot )
+ * I_Inbt , I_Iint)
C *** Sbroutine Work_Cro generates theory and derivatives
I = Idimen (Inprdr, -1, 'Inprdr, -1')
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - >
diff --git a/sammy/src/cro/mcro1.f b/sammy/src/cro/mcro1.f
index 8799f4924b72444b6351f3ea776b3fb72b6163b7..693074066f037eae153359414ca2f0272cb01968 100644
--- a/sammy/src/cro/mcro1.f
+++ b/sammy/src/cro/mcro1.f
@@ -4,7 +4,7 @@ C
SUBROUTINE Work_Cro (A, Iflmsc, Parnbk, Iflnbk, Parbgf, Iflbgf,
* Kndbgf, Bgfmin, Bgfmax, Texbgf, Teabgf, Energb, Theory, Wsigxx,
* Wdasig, Wdbsig, Sigxxx, Dasigx, Dbsigx, Isopar,
- * Pieces, Dum, Adderg, Addcro, Nbt, Int, Ntot)
+ * Pieces, Dum, Adderg, Addcro, Nbt, Int)
C
C *** PURPOSE -- GENERATE THEORETICAL DATA "theory" AND PARTIAL
C *** DERIVATIVES "GB"
@@ -24,7 +24,7 @@ C
* Kndbgf(*), Bgfmin(*), Bgfmax(*), Texbgf(Ntepnt,*),
* Teabgf(Ntepnt,*), Energb(*),
* Theory(*), Pieces(Ngroup,*), Dum(*), Adderg(*),
- * Addcro(*), Nbt(*), Int(*), Ntot(*)
+ * Addcro(*), Nbt(*), Int(*)
DIMENSION Wsigxx(Nnniso,*), Wdasig(Ndaxxx,*),
* Wdbsig(Ndbxxx,Nnniso,*), Sigxxx(Nnnsig,*),
* Dasigx(Nnnsig,*), Dbsigx(Nnnsig,Ndbxxx,*), Isopar(*)
diff --git a/sammy/src/cro/mcro2.f b/sammy/src/cro/mcro2.f
index 554125ed6d545d95ed5691f62b7340b39e0b8844..93b383ecc7a90c2d14b559fde5d21111ae3ddcbe 100644
--- a/sammy/src/cro/mcro2.f
+++ b/sammy/src/cro/mcro2.f
@@ -25,13 +25,12 @@ C
DIMENSION A(-Msize:Msize)
DIMENSION Pieces(*)
C
- CALL Abpart_Cro (I_Intot ,
+ CALL Abpart_Cro (
* A(Ialphr), A(Ialphi), A(Ibr ), A(Ibi ), A(Ipr),
* A(Ipi ), A(Idifen), A(Ixden ), A(Iupr ), A(Iupi),
* A(Iiuif ), A(Idifma), A(Inot ), A(Inotu), A(Ixx ))
C
- CALL Parsh (A,I_Ixclud , A_Igoj , I_Inent ,
- * I_Inext , I_Intot ,
+ CALL Parsh (A,
* A(Inprdr), A(Inpxdr), A_Izke , A_Izkte ,
* A_Izkfe , I_Ifzke , I_Ifzkte , I_Ifzkfe , Ipoten, Pieces,
* A(Isigxx), A(Idasig), A(Idbsig), I_Iisopa )
@@ -147,7 +146,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Setr_Cro (Ntot, Ishift, Lpent, Lspin, Bound, Echan,
+ SUBROUTINE Setr_Cro (Ntot, Bound, Echan,
* Parext, Iflext, Min, igr, Alphar, Alphai, Not,
* Z, Rmat, Sphr, Sphi, Phr, Phi, Zkte, Krext, Lrmat)
C
@@ -169,7 +168,12 @@ C
C
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
- DIMENSION Ishift(Ntotc,*), Lpent(Ntotc,*), Lspin(Ntotc,*),
+ type(SammySpinGroupInfo)::spinInfo
+ type(SammyChannelInfo)::channelInfo
+ type(RMatChannelParams)::channel
+ type(SammyParticlePairInfo)::pairInfo
+ type(RMatParticlePair)::pair
+ DIMENSION
* Bound(Ntotc,*), Echan(Ntotc,*), Parext(Krext,Ntotc,*),
* Iflext(Krext,Ntotc,*), Alphar(*), Alphai(*),
* Rmat(2,*), Sphr(*), Sphi(*), Phr(*), Phi(*), Not(*), Z(*),
@@ -184,28 +188,30 @@ C * Sphr(Ntotc), Sphi(Ntotc), Phr(Ntotc), Phi(Ntotc),
C * Not(Nres), Z(Ntotc)
DATA Zero /0.0d0/, One /1.0d0/
C
- IF (Ntot.EQ.3 .AND. Su.GT.Zero .AND. Su.LT.Echan(3,Nnnn)) Ntot = 2
- IF (Ntot.EQ.2 .AND. Su.GT.Zero .AND. Su.LT.Echan(2,Nnnn)) Ntot = 1
+ call resParData%getSpinGroupInfo(spinInfo, igr)
+ Ntot = spinInfo%getNumChannels()
+ IF (Ntot.EQ.3 .AND. Su.GT.Zero .AND. Su.LT.Echan(3,igr)) Ntot = 2
+ IF (Ntot.EQ.2 .AND. Su.GT.Zero .AND. Su.LT.Echan(2,igr)) Ntot = 1
C
C *** INITIALIZE Rmat ( = NEGATIVE OF R-MATRIX)
C
Aloge = Zero
KL = 0
DO K=1,Ntot
- IF (Numext.NE.0 .AND. Iflext(1,K,Nnnn).NE.-1) Aloge
- * = dLOG((Parext(2,K,Nnnn)-Su)/ (Su-Parext(1,K,Nnnn)))
+ IF (Numext.NE.0 .AND. Iflext(1,K,igr).NE.-1) Aloge
+ * = dLOG((Parext(2,K,igr)-Su)/ (Su-Parext(1,K,igr)))
DO L=1,K
KL = KL + 1
Rmat(1,KL) = Zero
Rmat(2,KL) = Zero
IF (L.EQ.K .AND. Numext.NE.0 .AND.
- * Iflext(1,K,Nnnn).NE.-1) THEN
- Rmat(1,KL) = -(Parext(3,K,Nnnn)+Parext(4,K,Nnnn)*Su) +
- * Parext(5,K,Nnnn)*Aloge
+ * Iflext(1,K,igr).NE.-1) THEN
+ Rmat(1,KL) = -(Parext(3,K,igr)+Parext(4,K,igr)*Su) +
+ * Parext(5,K,igr)*Aloge
IF (Nrext.EQ.7) Rmat(1,KL) = Rmat(1,KL) -
- * Parext(7,K,Nnnn)*Su**2 + Parext(6,K,Nnnn)*
- * (Parext(2,K,Nnnn)-Parext(1,K,Nnnn)) +
- * Parext(6,K,Nnnn)*Aloge*(Su)
+ * Parext(7,K,igr)*Su**2 + Parext(6,K,igr)*
+ * (Parext(2,K,igr)-Parext(1,K,igr)) +
+ * Parext(6,K,igr)*Aloge*(Su)
END IF
END DO
END DO
@@ -216,9 +222,11 @@ C
call resParData%getRedResonance(resonance, resInfo)
KL = 0
DO K=1,Ntot
- channelWidthC = resonance%getWidth(K+1)
+ ichan = spinInfo%getWidthForChannel(K)
+ channelWidthC = resonance%getWidth(ichan)
DO L=1,K
- channelWidthCPrime = resonance%getWidth(L+1)
+ ichan = spinInfo%getWidthForChannel(L)
+ channelWidthCPrime = resonance%getWidth(ichan)
beta = channelWidthC * channelWidthCPrime
KL = KL + 1
IF (Beta.NE.Zero) THEN
@@ -259,9 +267,17 @@ C
Phr (I) = Zero
Phi (I) = Zero
Z (I) = Zero
+
Iffy = 0
-C
- IF (Su.LE.Echan(I,Nnnn)) THEN
+
+ call spinInfo%getChannelInfo(channelInfo, I)
+ call resParData%getChannel(channel, channelInfo)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+C
+ IF (Su.LE.Echan(I,igr)) THEN
WRITE (21,10000)
WRITE (6,10000)
10000 FORMAT (' Oops -- error in Sub. SETR in mcro2 -- see NML to f
@@ -270,12 +286,18 @@ C
END IF
C
C
- IF (Lpent(I,Nnnn).EQ.1) THEN
+ IF (pair%getPnt().EQ.1) THEN
C *** HERE penetrability IS TO BE CALCULATED
- L = Lspin(I,Nnnn)
- Rho = Zkte(I)*dSQRT(Su-Echan(I,Nnnn))
- CALL Pgh (Rho, L, Bound(I,Nnnn), Hr, Hi, P, Dp, Ds,
- * Ishift(I,Nnnn), Iffy)
+ L = channel%getL()
+ if (pair%getCalcShift()) then
+ Ishift = 1
+ else
+ Ishift = 0
+ end if
+
+ Rho = Zkte(I)*dSQRT(Su-Echan(I,igr))
+ CALL Pgh (Rho, L, Bound(I,igr), Hr, Hi, P, Dp, Ds,
+ * Ishift, Iffy)
C HR AND HI ARE REAL AND IMAG PARTS OF 1/(S-B+IP)
C *** except when S-B+iP=Zero, in which case iffy=1
IF (Iffy.EQ.0) THEN
diff --git a/sammy/src/cro/mcro2a.f b/sammy/src/cro/mcro2a.f
index 5bd3770f2015df6d98bc30a730837fa124c010be..5daea4b8854f64ce89b39df5bba7386ee12d9440 100644
--- a/sammy/src/cro/mcro2a.f
+++ b/sammy/src/cro/mcro2a.f
@@ -2,7 +2,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Abpart_Cro (Ntot, Alphar,
+ SUBROUTINE Abpart_Cro (Alphar,
* Alphai, Br, Bi, Pr, Pi, Difen, Xden, Upr, Upi, Iuif, Difmax,
* Not, Notu, Xx)
C
@@ -22,12 +22,12 @@ C
type(SammyResonanceInfo)::resInfo
type(SammySpinGroupInfo)::spinInfo
type(RMatResonance)::resonance
- DIMENSION Ntot(*),
+ DIMENSION
* Alphar(*),Alphai(*), Br(Ntriag,*), Bi(Ntriag,*),
* Pr(Ntriag,*), Pi(Ntriag,*), Difen(*), Xden(*), Upr(*), Upi(*),
* Iuif(*), Difmax(*), Not(*), Notu(*), Xx(*)
C
-C DIMENSION Ntot(Ngroup),
+C DIMENSION
C * Alphar(Nres), Alphai(Nres),
C * BR(Ntriag,nyyres), BI(Ntriag,nyyres), Pr(Ntriag,nyyres),
C * PI(Ntriag,nyyres), Difen(Nres), Xden(Nres), Upr(napres),
@@ -52,11 +52,10 @@ C
call resParData%getResonanceInfo(resInfo, I)
igr = resInfo%getSpinGroupIndex()
- if (.not.resInfo%getIncludeInCalc()) then
- igr = -1 * igr
- end if
IF (resInfo%getIncludeInCalc()) THEN
- G2 = resonance%getWidth(1)**2
+ call resParData%getSpinGroupInfo(spinInfo, igr)
+ igam = spinInfo%getGammaWidthIndex()
+ G2 = resonance%getWidth(igam)**2
G3 = G2**2
Aa = Difen(I)**2 + G3
Xden(I) = 1.0D0/Aa
@@ -83,7 +82,8 @@ C
IF (resInfo%getEnergyFitOption().GE.0) THEN
C "if (Igr.GE.0)" but "resInfo%getEnergyFitOption().LT.0" means
C "Igr.LT.0" so it's OK
- N2 = Ntot(Igr) + 2
+ call resparData%getSpinGroupInfo(spinInfo, Igr)
+ N2 = spinInfo%getNumResPar()
DO M=1,N2
if (m.eq.1) then
Ipar = resInfo%getEnergyFitOption()
@@ -145,7 +145,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Parsh (A, Jxclud, Goj, Nent, Next, Ntot,
+ SUBROUTINE Parsh (A,
* Nprdr, Npxdr, Zke, Zkte, Zkfe, If_Zke,
* If_Zkte, If_Zkfe, Ipoten, Pieces, Sigxxx, Dasigx, Dbsigx,
* Isopar)
@@ -179,7 +179,7 @@ C
* Ixxxxi, Ixx
C
DIMENSION A(-Msize:Msize)
- DIMENSION Jxclud(*), GOJ(*), Nent(*), Next(*), Ntot(*),
+ DIMENSION
* Nprdr(*), Npxdr(*),
* Zke(Ntotc,*), Zkte(Ntotc,*), Zkfe(Ntotc,*), If_Zke(*),
* If_Zkte(Ntotc,*), If_Zkfe(Ntotc,*), Pieces(Ngroup),
@@ -189,8 +189,7 @@ C
type(SammySpinGroupInfo)::spinInfo
type(RMatResonance)::resonance
C
-C DIMENSION jxclud(Ngroup), GOJ(Ngroup), Nent(Ngroup),
-C * Next(Ngroup), Ntot(Ngroup),
+C DIMENSION
C * Nprdr(Ngroup), npxdr(Ngroup),
C * Zke(Ntotc,Ngroup), Zkte(Ntotc,Ngroup), zkfe(Ntotc,Ngroup),
C * If_Zke(Ngroup), If_Zkte(Ntotc,Ngroup), If_zkfe(Ntotc,Ngroup),
@@ -220,7 +219,7 @@ C
end do
call resParData%getSpinGroupInfo(spinInfo, N)
- IF (Jxclud(N).EQ.1) THEN
+ IF (.not.spinInfo%getIncludeInCalc()) THEN
IF (Ksolve.NE.2) Kstart = Kstart + Nprdr(N)
ELSE
IF (Numiso.GT.0) THEN
@@ -235,14 +234,15 @@ C
IF (Ksolve.NE.2) Npr = Nprdr(N)
IF (Ksolve.NE.2) Npx = Npxdr(N)
Nnf1 = Nnf1 + Nn2
- Nn2 = Ntot(N)*(Ntot(N)+1)
+ ntot = spinInfo%getNumChannels()
+ Nn2 = Ntot*(Ntot+1)
NN = Nn2/2
C
C
IF (Kcros.LE.2) THEN
C *** CALCULATE SIN AND COS OF POTENTIAL SCATTERING PHASE SHIFT,
C *** AND R-EXTERNAL PHASE SHIFT
- CALL Cossin (Nent(Nnnn), I_Ilspin , Zke(1,N), Zkfe(1,N),
+ CALL Cossin (Zke(1,N), Zkfe(1,N),
* A(Ics), A(Isi), A(Idphi), Nnnn, Ipoten)
END IF
C
@@ -250,9 +250,9 @@ C
C *** SET R-MATRIX
C
- Ntotnn = Ntot(Nnnn)
+ Ntotnn = spinInfo%getNumChannels()
Lrmat = 0
- CALL Setr_Cro (Ntotnn, I_Iishif , I_Ilpent , I_Ilspin ,
+ CALL Setr_Cro (Ntotnn,
* A_Ibound , A_Iechan , A_Iprext , I_Iflext , Min, n,
* A(Ialphr), A(Ialphi), A(Inot),
* A(IZ), A(Irmat), A(Isphr), A(Isphi), A(Iphr), A(Iphi),
@@ -276,9 +276,11 @@ C *** THE CROSS SECTIONS
* A(Iz), A(Ixxxxr), A(Ixxxxi), A(Ipwrr), A(Ipwri),
* A(Ixqr), A(Ixqi), A(Iphr), A(Iphi), A(Iqr), A(Iqi))
C
- Agoj = VarAbn*goj(n)
+ Agoj = VarAbn*spinInfo%getGFactor()
C *** TOTAL CROSS SECTIONS
- IF (Kcros.EQ.1) CALL Total (Agoj, Nent(Nnnn), Ntotnn,
+ nent = spinInfo%getNumEntryChannels()
+ next = spinInfo%getNumExitChannels()
+ IF (Kcros.EQ.1) CALL Total (Agoj, nent, Ntotnn,
* A_Iprext , I_Iflext , A(Ipr), A(Ipi), A(Ics), A(Isi),
* A(Idphi), A(Iwr), A(Iwi), A(Ipwrr), A(Ipwri), A(Itr),
* A(Iti), A(Iqr), A(Iqi), A(Inotu), Krext, Lrmat,
@@ -287,7 +289,7 @@ C *** TOTAL CROSS SECTIONS
* Dbsigx, Isopar, Iso)
C
C *** SCATTERING (ELASTIC) CROSS SECTION
- IF (Kcros.EQ.2) CALL Elastc (Agoj, Nent(Nnnn), Ntotnn,
+ IF (Kcros.EQ.2) CALL Elastc (Agoj, Nent, Ntotnn,
* A_Iprext , I_Iflext , A(Ipr), A(Ipi), A(Ics),
* A(Isi), A(Idphi), A(Iwr), A(Iwi), A(Ipwrr), A(Ipwri),
* A(Itr), A(Iti), A(Iqr), A(Iqi), A(Inotu), Krext, Lrmat,
@@ -297,7 +299,7 @@ C *** SCATTERING (ELASTIC) CROSS SECTION
C
C *** REACTION (FISSION, INELASTIC SCATTERING, ETC.) CROSS SECTIONS
IF (Kcros.EQ.3 .OR. Kcros.EQ.5 .OR. Kcros.EQ.6) CALL Reactn
- * ( Agoj, Nent(Nnnn), Next(Nnnn), Ntotnn, A_Iprext ,
+ * ( Agoj, Nent, Next, Ntotnn, A_Iprext ,
* I_Iflext , A(Ipr), A(Ipi), A(Iwr), A(Iwi), A(Ipwrr),
* A(Ipwri), A(Itr), A(Iti), A(Iqr), A(Iqi), A(Inotu),
* Krext, Lrmat, Min , N,
@@ -306,7 +308,7 @@ C *** REACTION (FISSION, INELASTIC SCATTERING, ETC.) CROSS SECTIONS
C
C *** CAPTURE CROSS SECTION
IF (Kcros.EQ.4 .OR. Kcros.EQ.5 .OR. Kcros.EQ.6) CALL Captur
- * ( Agoj, Nent(Nnnn), Next(Nnnn), Ntotnn, A_Iprext ,
+ * ( Agoj, Nent, Next, Ntotnn, A_Iprext ,
* I_Iflext , A(Ipr), A(Ipi), A(Iwr), A(Iwi), A(Ipwrr),
* A(Ipwri), A(Itr), A(Iti), A(Iqr), A(Iqi), A(Inotu),
* Krext, Lrmat,Min, N,
diff --git a/sammy/src/cro/mcro8.f b/sammy/src/cro/mcro8.f
index bd5a34dc76ac87ed0c2f13a63466c5eda25c2c5f..8249416b39e999037d8cf89919ee98d54575e2a5 100755
--- a/sammy/src/cro/mcro8.f
+++ b/sammy/src/cro/mcro8.f
@@ -37,7 +37,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Fixx (Ntot, Ishift, Lspin, Bound, Echan, Ixclud,
+ SUBROUTINE Fixx (Bound, Echan,
* Zkte, Xx, X1, Mxany)
C
C *** PURPOSE -- set Xx(I) = shift for resonance I when shift factors are
@@ -50,15 +50,20 @@ C
use RMatResonanceParam_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
- DIMENSION Ntot(*), Ishift(Ntotc,*), Lspin(Ntotc,*),
- * Bound(Ntotc,*), Echan(Ntotc,*), Ixclud(*),
+ DIMENSION
+ * Bound(Ntotc,*), Echan(Ntotc,*),
* Zkte(Ntotc,*), Xx(Mres), X1(Mres)
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
+ type(SammySpinGroupInfo)::spinInfo
+ type(SammyParticlePairInfo)::pairInfo
+ type(RMatParticlePair)::pair
+ type(RMatChannelParams)::channel
+ type(SammyChannelInfo)::channelInfo
real(kind=8),allocatable::resTmp(:)
C
-C DIMENSION Ntot(Ngroup), Ishift(Ntotc,Ngroup), Lspin(Ntotc,Ngroup),
-C * Bound(Ntotc,Ngroup), Echan,(Ntotc,Ngroup), Ixclud(Ngroup),
+C DIMENSION Ntot(Ngroup),
+C * Bound(Ntotc,Ngroup), Echan,(Ntotc,Ngroup),
C * Zkte(Ntotc,Ngroup), Xx(Nres), X1(Nres)
C
EXTERNAL Sf
@@ -82,6 +87,7 @@ C
Jsmall = 0
maxr = 0
DO K=1,Ngroup
+ call resParData%getSpinGroupInfo(spinInfo, K)
minr = maxr + 1
do i = minr, resParData%getNumResonances()
call resParData%getResonanceInfo(resInfo, i)
@@ -89,7 +95,7 @@ C
maxr = i
end do
- IF (Ixclud(K).NE.1) THEN
+ IF (spinInfo%getIncludeInCalc()) THEN
KI = 0
Nnnn = K
DO I=minr, maxr
@@ -99,16 +105,23 @@ C
II = 0
KI = KI + 1
X1(I) = Zero
- DO Ich=1,Ntot(Nnnn)
+ DO Ich=1,spinInfo%getNumChannels()
II = II + Ich
- beta = resonance%getWidth(ich+1)
- beta = beta * beta
- IF (Ishift(Ich,Nnnn).NE.0) THEN
+ ichan = spinInfo%getWidthForChannel(ich)
+ call spinInfo%getChannelInfo(channelInfo, Ich)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ call resParData%getChannel(channel, channelInfo)
+ IF (pair%getCalcShift()) THEN
IF (dABS(eres).GE.Echan(Ich,Nnnn)) THEN
- L = Lspin(Ich,Nnnn)
+ L = channel%getL()
Rho = Zkte(Ich,Nnnn)*dSQRT(
* dABS(eres)+xx(I)-Echan(Ich,Nnnn) )
X = Sf (Rho, L, Bound(Ich,Nnnn))
+ beta = resonance%getWidth(ichan)
+ beta = beta * beta
X1(I) = X1(I) + X*Beta
END IF
END IF
diff --git a/sammy/src/dat/mdat0.f90 b/sammy/src/dat/mdat0.f90
index 547f1c1e972b863ff93e10ccea863b9eecd00099..f6103fb3d3f75188451dd040c135faa825542f43 100644
--- a/sammy/src/dat/mdat0.f90
+++ b/sammy/src/dat/mdat0.f90
@@ -67,7 +67,7 @@ module Samdat_0_M
Krext = Nrext
IF (Nrext.EQ.0) Krext = 1
call reader%initialize()
- CALL Read00 (I_Intot , A_Ibcf , A_Icf2 , A_Idpiso , &
+ CALL Read00 (A_Ibcf , A_Icf2 , A_Idpiso , &
A_Iprext , I_Iflext , A_Iprorr , A_Icrnch , A_Iedets , &
A_Iseses , A_Iesese , A_Iprrpi , A_Iedrpi, A_Ixxrpi , &
A_Iprudr , I_Inud_E , I_Inud_T , A_Iude , A_Iudr , A_Iudt , &
@@ -139,10 +139,8 @@ module Samdat_0_M
Ihsx = Idimen (Ntotc, 1, 'Ntotc, 1')
Ir0m = Idimen (Ntotc, 1, 'Ntotc, 1')
Ir0x = Idimen (Ntotc, 1, 'Ntotc, 1')
- CALL Phase (A(Ienerg), I_ILspin , A_Ichspi , &
- I_Inent , I_Iishif , &
- A_Ibound , A(Ipm), A(Ipx), &
- A(Ism), A(Isx), A(Ihsm), A(Ihsx), A(Ir0m), A(Ir0x))
+ CALL Phase (A(Ienerg), A_Ibound , A(Ipm), A(Ipx), &
+ A(Ism), A(Isx), A(Ihsm), A(Ihsx), A(Ir0m), A(Ir0x))
! *** PRINT HARD SPHERE AND RESONANCE PHASE SHIFTS
I = Idimen (Ipm, -1, 'Ipm, -1')
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - >
@@ -192,7 +190,7 @@ module Samdat_0_M
Mnr = 100*Mnr
IF (Nr.EQ.0) Mnr = 1
Idum = Idimen (Mnr, 1, 'Mnr, 1')
- CALL Escale ( I_Ixclud , &
+ CALL Escale ( &
A(Ienerg), A(Ie), A(Ienerb), A(Ispken), &
A(Iswidt), A(Ienerm), A(Isadd), A_Iadder , A_Iaddcr , &
I_Inbt , I_Iint , A(Idum), Ndatbm, Nr, Np)
diff --git a/sammy/src/dat/mdat1.f b/sammy/src/dat/mdat1.f
index 97e69d38a2b72f3623bc95d8201ca46d13658d18..b26bf37c299c4be263040a3a8f97bd8a5615693d 100644
--- a/sammy/src/dat/mdat1.f
+++ b/sammy/src/dat/mdat1.f
@@ -2,7 +2,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Limits (Ntot, Bcf, Cf2, Dopwid, Parext, Iflext, Parorr,
+ SUBROUTINE Limits (Bcf, Cf2, Dopwid, Parext, Iflext, Parorr,
* Ecrnch, Endets, Sesese, Eseses, Parrpi, Edxrpi, Xxxrpi, Parudr,
* Nud_E, Nud_T, UdE, UdR, UdT, UdR_E, UdT_E, Krext)
C
@@ -28,7 +28,7 @@ C
use Wdsint_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
- DIMENSION Ntot(*), Bcf(*), Cf2(*), Dopwid(*),
+ DIMENSION Bcf(*), Cf2(*), Dopwid(*),
* Parext(Krext,Ntotc,*), Iflext(Krext,Ntotc,*), Parorr(*),
* Ecrnch(*), Endets(*), Sesese(*), Eseses(*), Parrpi(*),
* Edxrpi(Kxxrpi,*), Xxxrpi(Kmmrpi,*)
@@ -228,7 +228,7 @@ cx V = V + Brdlim*1.001d0*Dopple
C
END IF
C
- IF (Numext.GT.0) CALL Testxt (Ntot, Parext, Iflext, Krext)
+ IF (Numext.GT.0) CALL Testxt (Parext, Iflext, Krext)
CALL Wwrite (Bcf, Cf2, Dopwid)
RETURN
C
@@ -376,16 +376,21 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Testxt (Ntot, Parext, Iflext, Krext)
+ SUBROUTINE Testxt (Parext, Iflext, Krext)
C
use fixedi_m
use fixedr_m
+ use SammyResonanceInfo_M
+ use RMatResonanceParam_M
+ use EndfData_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
- DIMENSION Ntot(*), Parext(Krext,Ntotc,*), Iflext(Krext,Ntotc,*)
+ type(SammySpinGroupInfo)::spinInfo
+ DIMENSION Parext(Krext,Ntotc,*), Iflext(Krext,Ntotc,*)
Ii = 0
- DO N=1,Ngroup
- Ntotn = Ntot(Ngroup)
+ DO N=1,resparData%getNumSpinGroups()
+ call resparData%getSpinGroupInfo(spinInfo, N)
+ Ntotn = spinInfo%getNumChannels()
DO M=1,Ntotn
IF (Iflext(1,M,N).NE.-1) THEN
IF (Parext(1,M,N).GT.Emind) THEN
diff --git a/sammy/src/dat/mdat2.f90 b/sammy/src/dat/mdat2.f90
index 0afc487dccf5b12f07dff5f0ee3d8859a22bb4ad..3cbc60cdae14435173bc578790523173b79d672b 100644
--- a/sammy/src/dat/mdat2.f90
+++ b/sammy/src/dat/mdat2.f90
@@ -5,7 +5,7 @@ module mdat2_m
!
! ______________________________________________________________
!
- SUBROUTINE Read00 (Ntot, Bcf, Cf2, Dopwid, Parext, Jflext, &
+ SUBROUTINE Read00 (Bcf, Cf2, Dopwid, Parext, Jflext, &
Parorr, Ecrnch, Endets, Sesese, Eseses, Parrpi, Edxrpi, Xxxrpi, &
Parudr, Nud_E, Nud_T, UdE, UdR, UdT, UdR_E, UdT_E, E, Krext, &
Ii, Iwhich, Mind, Mine, Maxe, Maxd, Nmax, reader)
@@ -23,7 +23,7 @@ module mdat2_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
COMMON /Odfspc/ Nsect, Nch
type(EndfData)::reader
- DIMENSION Ntot(*), Bcf(*), Cf2(*), Dopwid(*), &
+ DIMENSION Bcf(*), Cf2(*), Dopwid(*), &
Parext(Krext,Ntotc,*), Jflext(Krext,Ntotc,*), Parorr(*), &
Ecrnch(*), Endets(*), Sesese(*), Eseses(*), Parrpi(*), &
Edxrpi(*), Xxxrpi(*), Parudr(*)
@@ -48,7 +48,7 @@ module mdat2_m
IF (Kartgd.EQ.1) THEN
ELSE
! *** find energy limits for the various processes --
- CALL Limits (Ntot, Bcf, Cf2, Dopwid, Parext, Jflext, Parorr, &
+ CALL Limits (Bcf, Cf2, Dopwid, Parext, Jflext, Parorr, &
Ecrnch, Endets, Sesese, Eseses, Parrpi, Edxrpi, Xxxrpi, &
Parudr, Nud_E, Nud_T, UdE, UdR, UdT, UdR_E, UdT_E, Krext)
END IF
@@ -223,7 +223,7 @@ module mdat2_m
END IF
!
! *** find Energy limits for the various processes --
- CALL Limits (Ntot, Bcf, Cf2, Dopwid, Parext, Jflext,Parorr, &
+ CALL Limits (Bcf, Cf2, Dopwid, Parext, Jflext,Parorr, &
Ecrnch, Endets, Sesese, Eseses, Parrpi, Edxrpi, Xxxrpi, Parudr, &
Nud_E, Nud_T, UdE, UdR, UdT, UdR_E, UdT_E, Krext)
!
diff --git a/sammy/src/dat/mdat4.f b/sammy/src/dat/mdat4.f
index 66c4ac5c566d555b9e479fd25a34d4f7229253e6..ba4a7e3194e1d1b269108689c9cc0b8f23db15e4 100644
--- a/sammy/src/dat/mdat4.f
+++ b/sammy/src/dat/mdat4.f
@@ -2,7 +2,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Escale (Ixclud, Energy, Ee,
+ SUBROUTINE Escale (Energy, Ee,
* Energb, Spken, Swidth, Energm, Sadd, Adder, Addcr, Nbt, Int,
* Dum, Ndatbm, Nr, Np)
C
@@ -15,12 +15,12 @@ C
use broad_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
- DIMENSION Ixclud(*),
+ DIMENSION
* Energy(*), Ee(*), Energb(*), Spken(*), Swidth(*), Energm(*),
* Sadd(*), Addcr(*), Adder(*), Nbt(*), Int(*), Dum(*)
C
C DIMENSION
-C * Ixclud(Ngroup), Energy(Ndat), Ee(Ndatb),
+C * Energy(Ndat), Ee(Ndatb),
C * Energb(Ndatbm), Spken(Nres), Swidth(Nres), Energm(Ndatbm),
C * Sadd(*), Addcr(Np), Adder(Nr), Nbt(Nr), Int(Nr), Dum(Nr)
C
@@ -130,12 +130,10 @@ C
IF (Kkkclq.EQ.0 .AND. Iptdop.GT.0 .AND. Iptwid.GT.0) THEN
C *** Add points for resonances with small widths *****
IF (Nogeom.EQ.0) THEN
- CALL Fspken (Ixclud, Energb,
- * Spken, Swidth, lres)
+ CALL Fspken (Energb, Spken, Swidth, lres)
CALL Tinyrs (Energb, Spken, Swidth, Energm, Lres)
ELSE
- CALL Weeres (Ixclud, Energb,
- * Spken, Swidth, Energm, Sadd)
+ CALL Weeres (Energb, Spken, Swidth, Energm, Sadd)
END IF
END IF
C
@@ -179,8 +177,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Fspken (Ixclud, Energb,
- * Spken, Swidth, lres)
+ SUBROUTINE Fspken (Energb, Spken, Swidth, lres)
C
C *** PURPOSE -- locate those resonances which require additional points
C
@@ -193,11 +190,11 @@ C
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
type(SammyResonanceInfo)::resInfo
+ type(SammySpinGroupInfo)::spinInfo
type(RMatResonance)::resonance
- DIMENSION Ixclud(*),
- * Energb(*), Spken(*), Swidth(*)
+ DIMENSION Energb(*), Spken(*), Swidth(*)
C
-C DIMENSION Pken(Nres), Ixclud(Ngroup),
+C DIMENSION Pken(Nres),
C * Energb(Ndatbm), Spken(Nres), Swidth(Nres)
C
Kdatb = Ndatb
@@ -206,15 +203,17 @@ C
L = 0
DO 30 J=1,resParData%getNumResonances()
call resParData%getResonanceInfo(resInfo, J)
- IF (.not.resInfo%getIncludeInCalc()) GO TO 30
- IF (Ixclud(resInfo%getSpinGroupIndex()).EQ.1) GO TO 30
+ IF (.not.resInfo%getIncludeInCalc()) GO TO 30
+ igr = resInfo%getSpinGroupIndex()
+ call resParData%getSpinGroupInfo(spinInfo, igr)
+ IF (.not.spinInfo%getIncludeInCalc()) GO TO 30
call resParData%getResonance(resonance, resInfo)
eres = resonance%getEres()
IF (eres.LT.Energb(1) .OR. eres.GT.Energb(Kdatb))
* GO TO 30
- Gd = dABS(resonance%getWidth(1))
- DO N=1,Ntotc
- Gd = Gd + dABS(resonance%getWidth(N+1))
+ Gd = 0.0d0
+ DO N=1,resonance%getNumChan()
+ Gd = Gd + dABS(resonance%getWidth(N))
END DO
Gd = .001d0*Gd
IF (Gd.GT.eres) THEN
@@ -734,8 +733,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Weeres (Ixclud, Energb,
- * Spken, Swidth, Energm, Sadd)
+ SUBROUTINE Weeres (Energb, Spken, Swidth, Energm, Sadd)
C
C *** PURPOSE -- ADD ENERGIES CORRESPONDING TO VERY Small RESONANCES
C
@@ -749,10 +747,10 @@ C
C
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
- DIMENSION Ixclud(*),
- * Energb(*), Spken(*), Swidth(*), Energm(*), Sadd(*)
+ type(SammySpinGroupInfo)::spinInfo
+ DIMENSION Energb(*), Spken(*), Swidth(*), Energm(*), Sadd(*)
C
-C DIMENSION Ixclud(Ngroup),
+C DIMENSION
C * Energb(Ndatbm), Spken(Nres), Swidth(Nres),
C * Energm(*), Sadd(*)
C
@@ -763,14 +761,16 @@ C
DO 30 J=1,resParData%getNumResonances()
call resParData%getResonanceInfo(resInfo, J)
IF (.not.resInfo%getIncludeInCalc()) GO TO 30
- IF (Ixclud(resInfo%getSpinGroupIndex()).EQ.1) GO TO 30
+ igr = resInfo%getSpinGroupIndex()
+ call resParData%getSpinGroupInfo(spinInfo, igr)
+ IF (.not.spinInfo%getIncludeInCalc()) GO TO 30
call resParData%getResonance(resonance, resInfo)
eres = resonance%getEres()
IF (eres.LT.Energb(1) .OR. eres.GT.Energb(Kdatb))
* GO TO 30
- Gd = dABS(resonance%getWidth(1))
- DO N=1,Ntotc
- Gd = Gd + dABS(resonance%getWidth(N+1))
+ Gd = 0.0d0
+ DO N=1,resonance%getNumChan()
+ Gd = Gd + dABS(resonance%getWidth(N))
END DO
Gd = .001d0*GD
Xmin = eres - Gd
diff --git a/sammy/src/end/mout.f b/sammy/src/end/mout.f
index ffa046f68bda49836d933cb2066082420aae7b48..6acc5a8a52acc9732dcefb53f34d5b98d76f64a2 100644
--- a/sammy/src/end/mout.f
+++ b/sammy/src/end/mout.f
@@ -3,7 +3,6 @@ C
C --------------------------------------------------------------
C
SUBROUTINE Outpar (Iftit , Nunit , Parbrd, Iflbrd,
- * Goj , Ntot , Lspin , Chspin,
* Pareff, Ifleff, Partru, Ifltru, Igrrad,
* Ifliso,
* Pardet, Ifldet, Igrdet, Parext, Iflext,
@@ -15,7 +14,7 @@ C
* Pardtp, Ifldtp, Parusd, Iflusd, Parbag, Iflbag,
* Zke , Zkte , Zkfe , If_Zke , If_Zkte, If_Zkfe, Dump,
* Avga , Avgb , Va, Vb, Xa, Xb, Allkkk,
- * Allxxx, Xxxxxx, Xxxstd, Kkkxxx, Kij, K1, Kppair,
+ * Allxxx, Xxxxxx, Xxxstd, Kkkxxx, Kij, K1,
* Iffff , reduced)
C
C *** Purpose -- Write resonance parameters into SAMMY.LPT, and
@@ -40,11 +39,11 @@ C
logical::reduced
type(SammyResonanceInfo)::resInfo
type(ResonanceCovariance)::physCov
- DIMENSION Parbrd(*), Iflbrd(*), Goj(*),
- * Ntot(*), Igrrad(Ntotc,*), Pareff(*), Ifleff(*), Partru(*),
+ DIMENSION Parbrd(*), Iflbrd(*),
+ * Igrrad(Ntotc,*), Pareff(*), Ifleff(*), Partru(*),
* Ifltru(*), Ifliso(*),
- * Pardet(*), Ifldet(*), Igrdet(*), Lspin(Ntotc,*),
- * Chspin(Ntotc,*), Parext(Nrext,Ntotc,*), Iflext(Nrext,Ntotc,*),
+ * Pardet(*), Ifldet(*), Igrdet(*),
+ * Parext(Nrext,Ntotc,*), Iflext(Nrext,Ntotc,*),
* Polar(2,*), Iflpol(2,*), Parmsc(*),
* Iflmsc(*), Iradms(*), Ijkmsc(*), Etaeee(*),
* Parpmc(4,*), Iflpmc(4,*), Isopmc(*), Parorr(*), Iflorr(*),
@@ -57,15 +56,13 @@ C
* Zkfe(Ntotc,*), If_Zke(*), If_Zkte(Ntotc,*), If_Zkfe(Ntotc,*),
* Dump(*), Avga(*), Avgb(*), Xa(*), Xb(*), Va(*),
* Vb(*), Allkkk(*), Allxxx(*), Xxxxxx(*),
- * Xxxstd(*), Kkkxxx(*), Kij(*), K1(*), Kppair(Ntotc,*)
+ * Xxxstd(*), Kkkxxx(*), Kij(*), K1(*)
C
C DIMENSION Parbrd(Numbrd), Iflbrd(Numbrd),
-C * Goj(Ngroup), Ntot(Ngroup),
C * Igrrad(Ntotc,Ngroup), Pareff(Numrad), Ifleff(Numrad),
C * Partru(Numrad), Ifltru(Numrad),
C * Ifliso(Numiso),
c * Pardet(Numdet), Ifldet(Numdet), Igrdet(Ngroup),
-C * Lspin(Ntotc,Ngroup), Chspin(Ntotc,Ngroup),
C * Parext(Nrext,Ntotc,Ngroup), Iflext(Nrext,Ntotc,Ngroup),
C * Polar(2,Nres), Iflpol(2,Nres),
C * Parmsc(Nummsc), Iflmsc(Nummsc), Iradms(Ngroup), Ijkmsc(Nummsc),
@@ -84,6 +81,10 @@ C
type(SammySpinGroupInfo)::spinInfo
type(RMatSpinGroup)::spinGroup
type(RMatResonance)::resonance
+ type(SammyParticlePairInfo)::pairInfo
+ type(RMatParticlePair)::pair
+ type(RMatChannelParams)::channel
+ type(SammyChannelInfo)::channelInfo
integer,allocatable,dimension(:)::fitFlags
DIMENSION Iif(7)
logical::haveRes
@@ -118,9 +119,9 @@ C
Ipar = 0
IF (Nres.LE.0) GO TO 140
IF (Ntotc.GT.3) THEN
- CALL Oooppp (Nunit, Goj, Ntot, Lspin, Chspin,
+ CALL Oooppp (Nunit,
* Zke, Zkte, Zkfe,
- * If_Zke, If_Zkte, If_Zkfe, Dump, Kppair, Iff, Ipar,
+ * If_Zke, If_Zkte, If_Zkfe, Dump, Iff, Ipar,
* reduced)
GO TO 140
END IF
@@ -132,9 +133,10 @@ C
C
Ipar = 0
maxr = 0
- DO 130 Igroup=1,Ngroup
+ DO 130 Igroup=1,resParData%getNumSpinGroups()
+ call resParData%getSpinGroupInfo(spinInfo, Igroup)
IF (Iftit.EQ.2) CALL Advzer (Avga, Avgb, Va, Vb, Ntotc2)
- Mmax = Ntot(Igroup)
+ Mmax = spinInfo%getNumChannels();
Mmax2 = Mmax + 2
minr = maxr + 1
@@ -173,14 +175,15 @@ C
C
Igr = Igroup
call resParData%getSpinGroupInfo(spinInfo, Igroup)
- call resParData%getSpinGroup(spinGroup, spinInfo)
+ call resParData%getSpinGroup(spinGroup, spinInfo)
+ iwGam = spinInfo%getGammaWidthIndex()
+ iela = spinInfo%getElasticChannel()
+ iela = spinInfo%getWidthForChannel(iela)
CALL Header (Igr, spinGroup%getJ(),
- * Lspin(1,Igroup),
- * Chspin(1,Igroup),
- * spinInfo%getAbundance(), Goj(Igroup),
+ * spinInfo%getAbundance(), spinInfo%getGFactor(),
* If_Zke(Igroup), Zkte(1,Igroup), Zkfe(1,Igroup),
* Zke(1,Igroup), If_Zkte(1,Igroup), If_Zkfe(1,Igroup),
- * Kppair(1,Igroup), Nunit, Mmax, Kredwa)
+ * Nunit, Mmax, Kredwa)
C
IF (Iftit.EQ.2) THEN
C *** Here only if need to calculate averages for final values
@@ -216,8 +219,8 @@ C
fitFlags(nc) = resInfo%getChannelFitOption(nc-1)
end do
CALL Setflg (fitFlags, Mmax2)
- CALL Nwrite (pkenPr, resonance,
- * Goj(Igroup), Nunit, Mmax)
+ CALL Nwrite (pkenPr, resonance, iwGam, iela,
+ * spinInfo%getGFactor(), Nunit, Mmax)
C
DO K=1,Mmax2
if( k.eq.1) then
@@ -280,8 +283,8 @@ C
fitFlags(nc) = resInfo%getChannelFitOption(nc-1)
end do
CALL Setflg (fitFlags, Mmax+2)
- CALL Nwrite (pkenPr, resonance,
- * Goj(Igroup), Nunit, Mmax)
+ CALL Nwrite (pkenPr, resonance, iwGam, iela,
+ * spinInfo%getGFactor(), Nunit, Mmax)
END IF
END DO
END IF
@@ -322,9 +325,7 @@ C *** Here if want fission gamma widths in polar coordinates
call resParData%getSpinGroupInfo(spinInfo, Igroup)
call resParData%getSpinGroup(spinGroup, spinInfo)
CALL Headpc (Igr, spinGroup%getJ(),
- * Lspin(1,Igroup),
- * Chspin(1,Igroup),
- * spinInfo%getAbundance(), Goj(Igroup),
+ * spinInfo%getAbundance(), spinInfo%getGFactor(),
* If_Zke(Igroup), Nunit, Mmax)
Ixx = 0
DO N=Minr,Maxr
@@ -415,7 +416,7 @@ C
140 CONTINUE
Iunit = Nunit
IF (Numext.GT.0) THEN
- CALL Outext (Ntot, Parext, Iflext, Dump, Iunit,
+ CALL Outext (Parext, Iflext, Dump, Iunit,
* Ipar)
END IF
C
@@ -499,9 +500,9 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Header (Ii, SpinjVal, Lspin, Chspin, AbnVal, Goj,
+ SUBROUTINE Header (Ii, SpinjVal, AbnVal, Goj,
* If_Zke,
- * Zkte, Zkfe, Zke, If_Zkte, If_Zkfe, Kppair, Nunit, Mmax,
+ * Zkte, Zkfe, Zke, If_Zkte, If_Zkfe, Nunit, Mmax,
* Kredwa)
use fixedi_m
use Gachmi_common_m
@@ -510,13 +511,18 @@ C
use SammyParticlePairInfo_M
use RMatResonanceParam_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
- DIMENSION Lspin(*), Chspin(*), Zkte(*), Zkfe(*), Zke(*),
- * If_Zkte(*), If_Zkfe(*), Kppair(*)
+ DIMENSION Zkte(*), Zkfe(*), Zke(*),
+ * If_Zkte(*), If_Zkfe(*)
CHARACTER*10 Capt
CHARACTER*8 Area
DIMENSION Aa(3)
character(len=8),allocatable::pname(:)
type(SammyParticlePairInfo)::pairInfo
+ type(SammySpinGroupInfo)::spinInfo
+ type(RMatChannelParams)::channel
+ type(SammyChannelInfo)::channelInfo
+ integer,allocatable,dimension(:)::lspin
+ real(kind=8),allocatable,dimension(:)::chspin
DATA Capt /' capture'/, Area /'area '/
C
IF (If_Zke.EQ.0) THEN
@@ -543,11 +549,23 @@ C
WRITE (Nunit,99996) (Aa(M), (Draw(J,M),J=1,5), M=1,Mmax)
99996 FORMAT (' "true" radius =', 4(1PE12.4,5A1))
C
+ ! fill in pname with the name of the particle pair for the channel
+ ! for printing. Mmax channels are always printed even
+ ! if we only have spinInfo%getNumChannels() channels.
allocate(pname(Mmax))
- do k = 1, Mmax
- call resParData%getParticlePairInfo(pairInfo, Kppair(K))
+ call resParData%getSpinGroupInfo(spinInfo, Ii)
+ nn = spinInfo%getNumChannels()
+ if( nn.gt.Mmax) nn = Mmax
+ do k = 1, nn
+ call spinInfo%getChannelInfo(channelInfo, k)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
call pairInfo%getName(pname(k))
end do
+ do k = nn+1, Mmax
+ pname(k) = ""
+ end do
IF (Kcarea.NE.1) THEN
WRITE (Nunit,99994) (Ga,K=1,Mmax)
WRITE (Nunit,99993) (pname(K),K=1,Mmax)
@@ -561,8 +579,20 @@ C
END IF
deallocate(pname)
C
+ allocate(lspin(Mmax))
+ lspin = 0
+ allocate(chspin(Mmax))
+ chspin = 0.0d0
+ do k = 1, Mmax
+ call spinInfo%getChannelInfo(channelInfo, k)
+ call resParData%getChannel(channel, channelInfo)
+ lspin(k) = channel%getL()
+ chspin(k) = channel%getSch()
+ end do
WRITE (Nunit,99992) (Ellll, Lspin(K), Espin, Chspin(K), K=1,Mmax)
99992 FORMAT ((33x, 5(3X, A2, I1, 2X, A5, F4.1)))
+ deallocate(lspin)
+ deallocate(chspin)
Ntotc1 = Mmax + 1
IF (Kredwa.EQ.0) WRITE (Nunit,99991) (Miev,K=1,Ntotc1)
IF (Kredwa.EQ.1) WRITE (Nunit,99990) (Sqmiev,K=1,Ntotc1)
@@ -574,7 +604,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Nwrite (Pken, resonance, Goj, Nunit, Mmax)
+ SUBROUTINE Nwrite (Pken, resonance, iwGam, iela,Goj,Nunit,Mmax)
use fixedi_m
use ifwrit_m
use RMatResonanceParam_M
@@ -585,7 +615,7 @@ C
type(RMatResonance)::resonance
C
- integer::j,k
+ integer::j,k, iwGam, iela
real(kind=8):: Gt, carea
IF (Kcarea.LE.0) THEN
@@ -601,11 +631,12 @@ C
* (Draw(J,K+2),J=1,5),K=1,Mmax)
END IF
ELSE
- GT = resonance%getWidth(1)
- DO K=1,Mmax
- GT = GT + resonance%getWidth(K+1)
+ GT = 0.0d0
+ DO K=1,resonance%getNumChan()
+ GT = GT + resonance%getWidth(K)
END DO
- Carea = GoJ*resonance%getWidth(1)*resonance%getWidth(2)/GT
+ Carea = GoJ*resonance%getWidth(iwGam)*
+ * resonance%getWidth(iela)/GT
IF (Kshort.EQ.0) THEN
WRITE (Nunit,99990) Pken, (Draw(J,1),J=1,5),
* resonance%getWidth(1),
@@ -628,12 +659,18 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Headpc (Igr, SpinjVal, Lspin, Chspin, AbnVal, Goj,
- * If_Zke,
- * Nunit, Mmax)
+ SUBROUTINE Headpc (Igr, SpinjVal, AbnVal, Goj,
+ * If_Zke, Nunit, Mmax)
use Gachmi_common_m
+ use EndfData_common_m
+ use SammyParticlePairInfo_M
+ use RMatResonanceParam_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
- DIMENSION Lspin(*), Chspin(*)
+ type(SammySpinGroupInfo)::spinInfo
+ type(RMatChannelParams)::channel
+ type(SammyChannelInfo)::channelInfo
+ integer::lspin(3)
+ real(kind=8)::chspin(3)
C
IF (If_Zke.EQ.0) THEN
WRITE (Nunit,99998) Igr, SpinjVal, AbnVal, Goj
@@ -651,6 +688,19 @@ C
WRITE (Nunit,99987) (CH,K,K=1,3)
99987 FORMAT (' GAMMA ', 3(5X, A10, I2),
* ' (RADIANS) AMPLITUDE')
+
+ lspin = 0
+ chspin = 0.0d0
+ call resParData%getSpinGroupInfo(spinInfo, Igr)
+ nn = spinInfo%getNumChannels()
+ if( nn.gt.3) nn = 3
+ do k = 1, nn
+ call spinInfo%getChannelInfo(channelInfo, k)
+ call resParData%getChannel(channel, channelInfo)
+ lspin(k) = channel%getL()
+ chspin(k) = channel%getSch()
+ end do
+
WRITE (Nunit,99992) (ELlll, Lspin(K), Espin, Chspin(K), K=1,3)
99992 FORMAT ((33x, 5(3X, A2, I1, 2X, A5, F4.1)))
WRITE (Nunit,99986) (MIEV,K=1,4)
@@ -761,9 +811,9 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Oooppp (Nunit, Goj, Ntot, Lspin, Chspin,
+ SUBROUTINE Oooppp (Nunit,
* Zke, Zkte, Zkfe,If_Zke,
- * If_Zkte, If_Zkfe, Dump, Kppair, Iff, Ipar, reduced)
+ * If_Zkte, If_Zkfe, Dump, Iff, Ipar, reduced)
C
C *** Purpose -- Write the resonance parameters when there are more
C *** than three channels
@@ -787,9 +837,7 @@ C
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
logical::reduced
- DIMENSION Goj(*), Ntot(*), Lspin(Ntotc,*),
- * Chspin(Ntotc,*),
- * Kppair(Ntotc,*),
+ DIMENSION
* Zke(Ntotc,*), Zkte(Ntotc,*), Zkfe(Ntotc,*),
* If_Zke( *),If_Zkte(Ntotc,*),If_Zkfe(Ntotc,*), Dump(*)
DIMENSION Ii(2)
@@ -797,8 +845,11 @@ C
type(RMatSpinGroup)::spinGroup
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
- character(len=8)::pname
type(SammyParticlePairInfo)::pairInfo
+ type(RMatParticlePair)::pair
+ type(RMatChannelParams)::channel
+ type(SammyChannelInfo)::channelInfo
+ character(len=8)::pname
integer,allocatable,dimension(:)::fitFlags
logical::haveRes
DATA Zero /0.0d0/
@@ -806,7 +857,7 @@ C
C
Ipar = 0
maxr = 0
- DO 150 Igroup=1,Ngroup
+ DO 150 Igroup=1,resParData%getNumSpinGroups()
minr = maxr + 1
haveRes = .false.
do i = minr, resParData%getNumResonances()
@@ -819,8 +870,8 @@ C
call resParData%getSpinGroupInfo(spinInfo, Igroup)
call resParData%getSpinGroup(spinGroup, spinInfo)
- Mmax = Ntot(Igroup)
- Mmax2 = Mmax + 2
+ Mmax = spinInfo%getNumChannels()
+ Mmax2 = spinInfo%getNumResPar()
IF (Iff.EQ.0) GO TO 20
DO N=Minr,Maxr
@@ -834,13 +885,13 @@ C
IF (If_Zke(Igroup).EQ.0) THEN
WRITE (Nunit,99999) Igroup,
* spinGroup%getJ(),
- * AbnVal, Goj(Igroup)
+ * AbnVal, spinInfo%getGFactor()
99999 FORMAT (/, ' SPIN GROUP NUMBER', I3, ' WITH SPIN=',
* F5.1, ', ABUNDANCE=', F8.4, ', AND G=', F7.4)
ELSE
WRITE (Nunit,99998) Igroup,
* spinGroup%getJ(),
- * AbnVal, If_Zke(Igroup), Goj(Igroup)
+ * AbnVal, If_Zke(Igroup), spinInfo%getGFactor()
99998 FORMAT (/, ' SPIN GROUP NUMBER', I3, ' WITH SPIN=',
* F5.1, ', ABUNDANCE=', F8.4, '(', I3, ')',
* ', AND G=', F7.4)
@@ -897,66 +948,85 @@ C
call resParData%getResonance(resonance, resInfo)
end if
pkenPr = getPkenPr(resonance%getEres(), reduced)
- gga = resonance%getWidth(1)
+ ichan = spinInfo%getGammaWidthIndex()
+ gga = resonance%getWidth(ichan)
IF (Kshort.EQ.0) THEN
+ iela = spinInfo%getElasticChannel()
+ call spinInfo%getChannelInfo(channelInfo, iela)
+ call resParData%getChannel(channel, channelInfo)
call resParData%getParticlePairInfo(pairInfo,
- * Kppair(1,Igroup) )
+ * channelInfo%getParticlePairIndex())
call pairInfo%getName(pname)
- IF (Lspin(1,Igroup).LE.9) THEN
+ ichan = spinInfo%getElasticChannel()
+ ichan = spinInfo%getWidthForChannel(ichan)
+ IF (channel%getL().LE.9) THEN
WRITE (Nunit,99992) pkenPr, (Draw(J,1),J=1,5),
- * Gga, (Draw(J,2),J=1,5), resonance%getWidth(2),
- * (Draw(J,3),J=1,5), ELlll, Lspin(1,Igroup),Espin,
- * Chspin(1,Igroup), pname
+ * Gga, (Draw(J,2),J=1,5),resonance%getWidth(ichan),
+ * (Draw(J,3),J=1,5), ELlll, channel%getL(),Espin,
+ * channel%getSch(), pname
ELSE
WRITE (Nunit,79992) pkenPr, (Draw(J,1),J=1,5),
- * Gga, (Draw(J,2),J=1,5), resonance%getWidth(2),
- * (Draw(J,3),J=1,5), Lspin(1,Igroup), Espin,
- * Chspin(1,Igroup), pname
+ * Gga, (Draw(J,2),J=1,5),resonance%getWidth(ichan),
+ * (Draw(J,3),J=1,5), channel%getL(), Espin,
+ * channel%getSch(), pname
END IF
DO K=2,Mmax
+ if (k.eq.spinInfo%getElasticChannel()) cycle
+ call spinInfo%getChannelInfo(channelInfo, K)
+ call resParData%getChannel(channel, channelInfo)
call resParData%getParticlePairInfo(pairInfo,
- * Kppair(k,Igroup) )
+ * channelInfo%getParticlePairIndex())
call pairInfo%getName(pname)
- IF (Lspin(K,Igroup).LE.9) THEN
- WRITE (Nunit,99991) resonance%getWidth(k+1),
+ ichan = spinInfo%getWidthForChannel(K)
+ IF (channel%getL().LE.9) THEN
+ WRITE (Nunit,99991) resonance%getWidth(ichan),
* (Draw(J,K+2),J=1,5),
- * ELlll, Lspin(K,Igroup), Espin,
- * Chspin(K,Igroup), pname
+ * ELlll, channel%getL(), Espin,
+ * channel%getSch(), pname
ELSE
- WRITE (Nunit,79991) resonance%getWidth(k+1),
+ WRITE (Nunit,79991) resonance%getWidth(ichan),
* (Draw(J,K+2),J=1,5),
- * Lspin(K,Igroup), Espin,
- * Chspin(K,Igroup), pname
+ * channel%getL(), Espin,
+ * channel%getSch(), pname
END IF
END DO
ELSE
+ iela = spinInfo%getElasticChannel()
+ call spinInfo%getChannelInfo(channelInfo, iela)
+ call resParData%getChannel(channel, channelInfo)
call resParData%getParticlePairInfo(pairInfo,
- * Kppair(1,Igroup) )
+ * channelInfo%getParticlePairIndex())
call pairInfo%getName(pname)
- IF (Lspin(1,Igroup).LE.9) THEN
+ ichan = spinInfo%getElasticChannel()
+ ichan = spinInfo%getWidthForChannel(ichan)
+ IF (channel%getL().LE.9) THEN
WRITE (Nunit,99990) pkenPr, (Draw(J,1),J=1,5),
- * Gga, (Draw(J,2),J=1,5), resonance%getWidth(2),
- * (Draw(J,3),J=1,5), ELlll, Lspin(1,Igroup),Espin,
- * Chspin(1,Igroup), pname
+ * Gga, (Draw(J,2),J=1,5),resonance%getWidth(ichan),
+ * (Draw(J,3),J=1,5), ELlll, channel%getL(),Espin,
+ * channel%getSch(), pname
ELSE
WRITE (Nunit,79990) pkenPr, (Draw(J,1),J=1,5),
- * Gga, (Draw(J,2),J=1,5), resonance%getWidth(2),
- * (Draw(J,3),J=1,5), Lspin(1,Igroup), Espin,
- * Chspin(1,Igroup), pname
+ * Gga, (Draw(J,2),J=1,5),resonance%getWidth(ichan),
+ * (Draw(J,3),J=1,5), channel%getL(), Espin,
+ * channel%getSch(), pname
END IF
- DO K=2,Mmax
+ DO K=1,Mmax
+ if (k.eq.spinInfo%getElasticChannel()) cycle
+ call spinInfo%getChannelInfo(channelInfo, k)
+ call resParData%getChannel(channel, channelInfo)
call resParData%getParticlePairInfo(pairInfo,
- * Kppair(k,Igroup) )
+ * channelInfo%getParticlePairIndex())
call pairInfo%getName(pname)
- IF (Lspin(K,Igroup).LE.9) THEN
- WRITE (Nunit,99989) resonance%getWidth(k+1),
+ ichan = spinInfo%getWidthForChannel(K)
+ IF (channel%getL().LE.9) THEN
+ WRITE (Nunit,99989) resonance%getWidth(ichan),
* (Draw(J,K+2),
- * J=1,5), ELlll, Lspin(K,Igroup), Espin,
- * Chspin(K,Igroup), pname
+ * J=1,5), ELlll, channel%getL(), Espin,
+ * channel%getSch(), pname
ELSE
- WRITE (Nunit,79989) resonance%getWidth(k+1),
- * (Draw(J,K+2),J=1,5), Lspin(K,Igroup), Espin,
- * Chspin(K,Igroup), pname
+ WRITE (Nunit,79989) resonance%getWidth(ichan),
+ * (Draw(J,K+2),J=1,5), channel%getL(), Espin,
+ * channel%getSch(), pname
END IF
END DO
END IF
@@ -1010,88 +1080,112 @@ C
call resParData%getResonance(resonance, resInfo)
end if
pkenPr = getPkenPr(resonance%getEres(), reduced)
- gga = resonance%getWidth(1)
+ ichan = spinInfo%getGammaWidthIndex()
+ gga = resonance%getWidth(ichan)
IF (Kshort.EQ.0) THEN
+ iela = spinInfo%getElasticChannel()
+ call spinInfo%getChannelInfo(channelInfo, iela)
+ call resParData%getChannel(channel, channelInfo)
call resParData%getParticlePairInfo(pairInfo,
- * Kppair(1,Igroup) )
+ * channelInfo%getParticlePairIndex())
call pairInfo%getName(pname)
- IF (Lspin(1,Igroup).LE.9) THEN
+ ichan = spinInfo%getElasticChannel()
+ ichan = spinInfo%getWidthForChannel(ichan)
+ IF (channel%getL().LE.9) THEN
WRITE (Nunit,99992) pkenPr, (Draw(J,1),J=1,5),
- * Gga, (Draw(J,2),J=1,5),resonance%getWidth(2),
- * (Draw(J,3),J=1,5), ELlll, Lspin(1,Igroup),
- * Espin, Chspin(1,Igroup),
+ * Gga, (Draw(J,2),J=1,5),
+ * resonance%getWidth(ichan),
+ * (Draw(J,3),J=1,5), ELlll, channel%getL(),
+ * Espin, channel%getSch(),
* pname
99992 FORMAT (1PE13.5, 5A1, 2(1PE12.4, 5A1), 3X, A2,
* I1, 2X, A5, 0PF4.1, 1X, A8)
ELSE
WRITE (Nunit,79992) pkenPr, (Draw(J,1),J=1,5),
- * Gga, (Draw(J,2),J=1,5),resonance%getWidth(2),
- * (Draw(J,3),J=1,5), Lspin(1,Igroup),
- * Espin, Chspin(1,Igroup),
+ * Gga, (Draw(J,2),J=1,5),
+ * resonance%getWidth(ichan),
+ * (Draw(J,3),J=1,5), channel%getL(),
+ * Espin, channel%getSch(),
* pname
79992 FORMAT (1PE13.5, 5A1, 2(1PE12.4, 5A1), 3X, 'L',
* I2, 2X, A5, 0PF4.1, 1X, A8)
END IF
- DO K=2,Mmax
+ DO K=1,Mmax
+ if( k.eq.spinInfo%getElasticChannel()) cycle
+ call spinInfo%getChannelInfo(channelInfo, K)
+ call resParData%getChannel(channel, channelInfo)
call resParData%getParticlePairInfo(pairInfo,
- * Kppair(k,Igroup) )
+ * channelInfo%getParticlePairIndex())
call pairInfo%getName(pname)
- IF (Lspin(K,Igroup).LE.9) THEN
- WRITE (Nunit,99991) resonance%getWidth(k+1),
+ ichan = spinInfo%getWidthForChannel(k)
+ IF (channel%getL().LE.9) THEN
+ WRITE (Nunit,99991)resonance%getWidth(ichan),
* (Draw(J,K+2),
- * J=1,5), ELlll, Lspin(K,Igroup),
- * Espin, Chspin(K,Igroup),
+ * J=1,5), ELlll, channel%getL(),
+ * Espin, channel%getSch(),
* pname
-99991 FORMAT (35X, 1PE12.4, 5A1, 3X, A2, I1, 2X,
+99991 FORMAT (35X, 1PE12.4, 5A1, 3X, A2, I1, 2X,
* A5, 0PF4.1, 1X, A8)
ELSE
- WRITE (Nunit,79991) resonance%getWidth(k+1),
- * (Draw(J,K+2),J=1,5), Lspin(K,Igroup),
- * Espin, Chspin(K,Igroup),
+ WRITE (Nunit,79991)resonance%getWidth(ichan),
+ * (Draw(J,K+2),J=1,5), channel%getL(),
+ * Espin, channel%getSch(),
* pname
-79991 FORMAT (35X, 1PE12.4, 5A1, 3X, 'L', I2, 2X,
+79991 FORMAT (35X, 1PE12.4, 5A1, 3X, 'L', I2, 2X,
* A5, 0PF4.1, 1X, A8)
END IF
END DO
ELSE
+ iela = spinInfo%getElasticChannel()
+ call spinInfo%getChannelInfo(channelInfo, iela)
+ call resParData%getChannel(channel, channelInfo)
call resParData%getParticlePairInfo(pairInfo,
- * Kppair(1,Igroup) )
+ * channelInfo%getParticlePairIndex() )
call pairInfo%getName(pname)
- IF (Lspin(1,Igroup).LE.9) THEN
+ ichan = spinInfo%getElasticChannel()
+ ichan = spinInfo%getWidthForChannel(ichan)
+ IF (channel%getL().LE.9) THEN
WRITE (Nunit,99990) pkenPr, (Draw(J,1),J=1,5),
- * Gga, (Draw(J,2),J=1,5),resonance%getWidth(2),
- * (Draw(J,3),J=1,5), ELlll, Lspin(1,Igroup),
- * Espin, Chspin(1,Igroup),
+ * Gga, (Draw(J,2),J=1,5),
+ * resonance%getWidth(ichan),
+ * (Draw(J,3),J=1,5), ELlll, channel%getL(),
+ * Espin, channel%getSch(),
* pname
99990 FORMAT (3(F12.4, 5A1), 3X, A2, I1, 2X, A5, F4.1,
* 1X, A8)
ELSE
WRITE (Nunit,79990) pkenPr, (Draw(J,1),J=1,5),
- * Gga, (Draw(J,2),J=1,5),resonance%getWidth(2),
- * (Draw(J,3),J=1,5), ELlll, Lspin(1,Igroup),
- * Espin, Chspin(1,Igroup),
+ * Gga, (Draw(J,2),J=1,5),
+ * resonance%getWidth(ichan),
+ * (Draw(J,3),J=1,5), ELlll, channel%getL(),
+ * Espin, channel%getSch(),
* pname
79990 FORMAT (3(F12.4, 5A1), 3X, 'L', I2, 2X, A5,
* F4.1, 1X, A8)
END IF
- DO K=2,Mmax
+ DO K=1,Mmax
+ if( k.eq.spinInfo%getElasticChannel()) cycle
+ call spinInfo%getChannelInfo(channelInfo, K)
+ call resParData%getChannel(channel,
+ * channelInfo)
call resParData%getParticlePairInfo(pairInfo,
- * Kppair(k,Igroup) )
+ * channelInfo%getParticlePairIndex())
call pairInfo%getName(pname)
- IF (Lspin(K,Igroup).LE.9) THEN
- WRITE (Nunit,99989) resonance%getWidth(k+1),
+ ichan = spinInfo%getWidthForChannel(k)
+ IF (channel%getL().LE.9) THEN
+ WRITE (Nunit,99989)resonance%getWidth(ichan),
* (Draw(J,K+2),J=1,5), ELlll,
- * Lspin(K,Igroup),
- * Espin, Chspin(K,Igroup),
+ * channel%getL(),
+ * Espin, channel%getSch(),
* pname
-99989 FORMAT (34X, (F12.4, 5A1), 3X, A2, I1, 2X,
+99989 FORMAT (34X, (F12.4, 5A1), 3X, A2, I1, 2X,
* A5, F4.1, 1X, A8)
ELSE
- WRITE (Nunit,79989) resonance%getWidth(k+1),
- * (Draw(J,K+2),J=1,5), Lspin(K,Igroup),
- * Espin, Chspin(K,Igroup),
+ WRITE (Nunit,79989)resonance%getWidth(ichan),
+ * (Draw(J,K+2),J=1,5), channel%getL(),
+ * Espin, channel%getSch(),
* pname
-79989 FORMAT (34X, (F12.4, 5A1), 3X, 'L', I2, 2X,
+79989 FORMAT (34X, (F12.4, 5A1), 3X, 'L', I2, 2X,
* A5, F4.1, 1X, A8)
END IF
END DO
diff --git a/sammy/src/end/mout1.f b/sammy/src/end/mout1.f
index 6c4e5bb53a636e70b7a8f63ba57b8529aefb9913..b21effe1eb5cf96ae745e9f737b4284d36ef7b21 100644
--- a/sammy/src/end/mout1.f
+++ b/sammy/src/end/mout1.f
@@ -52,7 +52,9 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Outred (Goj, Ntot, Lspin, Chspin, Iff)
+C If Iff is not null, we only print the resonance parameters if
+C at least one resonance parameters is adjusted.
+ SUBROUTINE Outred (Iff)
C
C *** PURPOSE -- OUTPUT RESONANCE PARAMETERS (AMPLITUDES)
C
@@ -71,14 +73,13 @@ C
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
logical::haveRes
- DIMENSION Goj(*), Ntot(*), Lspin(Ntotc,*),
- * Chspin(Ntotc,*)
-C
-C DIMENSION Goj(Ngroup),
-C * Ntot(Ngroup), Lspin(Ntotc,Ngroup), Chspin(Ntotc,Ngroup)
-C
+ integer,allocatable,dimension(:)::lspin
+ real(kind=8),allocatable,dimension(:)::chspin
+
type(SammySpinGroupInfo)::spinInfo
type(RMatSpinGroup)::spinGroup
+ type(SammyChannelInfo)::channelInfo
+ type(RMatChannelParams)::channel
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonanceRed
integer,allocatable,dimension(:)::fitFlags
@@ -100,7 +101,7 @@ C
end do
IF (haveRes) THEN
- Mmax = Ntot(I)
+ Mmax = spinInfo%getNumChannels()
IF (Iff.NE.0) THEN
DO N=Minr,Maxr
call resParData%getResonanceInfo(resInfo, N)
@@ -111,14 +112,24 @@ C
20 CONTINUE
WRITE (21,99998) I, spinGroup%getJ(),
* spinInfo%getAbundance(),
- * Goj(I)
+ * spinInfo%getGFactor()
Mmax1 = Mmax
IF (Mmax.GT.5) Mmax1 = 5
+ allocate(lspin(mmax))
+ allocate(chspin(mmax))
+ do k = 1, spinInfo%getNumChannels()
+ call spinInfo%getChannelInfo(channelInfo, K)
+ call resParData%getChannel(channel, channelInfo)
+ lspin(k) = channel%getL()
+ chspin(k) = channel%getSch()
+ end do
WRITE (21,99997) (Red,K=1,Mmax1)
WRITE (21,99996) (Ga,K=1,Mmax1)
WRITE (21,99995) (Ch,K,K=1,Mmax1)
- WRITE (21,99994) (ELlll,Lspin(K,I),Espin,Chspin(K,I),
+ WRITE (21,99994) (ELlll,Lspin(K),Espin,Chspin(K),
* K=1,Mmax)
+ deallocate(lspin)
+ deallocate(chspin)
C
DO N=Minr,Maxr
call resParData%getResonanceInfo(resInfo, N)
@@ -627,8 +638,9 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Outmlb (Goj, Ntot, Ishift, Lspin, Bound,
- * Echan, Zkte, Iff)
+C If Iff is not null, we only print the resonance parameters if
+C at least one resonance parameters is adjusted.
+ SUBROUTINE Outmlb (Bound, Echan, Zkte, Iff)
C
C *** PURPOSE -- OUTPUT EQUIVALENT BREIT-WIGNER PARAMETERS
C
@@ -646,12 +658,10 @@ C
EXTERNAL Sf
C
logical::haveRes
- DIMENSION Goj(*), Ntot(*), Ishift(Ntotc,*),
- * Lspin(Ntotc,*), Bound(Ntotc,*), Echan(Ntotc,*),
+ DIMENSION Bound(Ntotc,*), Echan(Ntotc,*),
* Zkte(Ntotc,*)
C
-C DIMENSION Goj(Ngroup),
-C * Ntot(Ngroup), Ishift(Ntotc,Ngroup), Lspin(Ntotc,Ngroup),
+C DIMENSION
C * Bound(Ntotc,Ngroup), Echan(Ntotc,Ngroup),
C * Zkte(Ntotc,Ngroup)
C
@@ -659,6 +669,10 @@ C
type(RMatSpinGroup)::spinGroup
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance, resonanceRed
+ type(SammyChannelInfo)::channelInfo
+ type(RMatChannelParams)::channel
+ type(SammyParticlePairInfo)::pairInfo
+ type(RMatParticlePair)::pair
integer,allocatable,dimension(:)::fitFlags
DATA Zero /0.0d0/
C
@@ -679,7 +693,7 @@ C
haveRes = .true.
end do
IF (haveRes) THEN
- Mmax = Ntot(I)
+ Mmax = spinInfo%getNumChannels()
IF (Iff.EQ.0) GO TO 20
DO Ires=Minr,Maxr
call resParData%getResonanceInfo(resInfo, Ires)
@@ -689,7 +703,7 @@ C
20 CONTINUE
WRITE (21,99998) I, spinGroup%getJ(),
* spinInfo%getAbundance(),
- * Goj(I)
+ * spinInfo%getGFactor()
WRITE (21,99997)
WRITE (21,99996)
WRITE (21,99995)
@@ -708,14 +722,27 @@ C
call resParData%getResonance(resonanceRed, resInfo)
eres = resonance%getEres()
Emlbw = dABS(eres)
- Gmlbw = dABS(resonance%getWidth(1))
+ ichan = spinInfo%getGammaWidthIndex()
+ Gmlbw = dABS(resonance%getWidth(ichan))
DO K=1,Mmax
- Gmlbw = Gmlbw + dABS(resonance%getWidth(K+1))
- IF (Ishift(K,I).NE.0) THEN
+ call spinInfo%getChannelInfo(channelInfo, K)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ call resParData%getChannel(channel, channelInfo)
+ if (pair%getCalcShift()) then
+ Ishift = 1
+ else
+ Ishift = 0
+ end if
+ ichan = spinInfo%getWidthForChannel(k)
+ Gmlbw = Gmlbw + dABS(resonance%getWidth(ichan))
+ IF (Ishift.NE.0) THEN
Q = dABS(eres-Echan(K,I))
Rho = Zkte(K,I)*dSQRT(Q)
- X = SF(Rho, Lspin(K,I), Bound(K,I))
- X = X*resonanceRed%getWidth(k+1)**2*0.001
+ X = SF(Rho, channel%getL(), Bound(K,I))
+ X = X*resonanceRed%getWidth(ichan)**2*0.001
Emlbw = Emlbw - X
END IF
END DO
diff --git a/sammy/src/end/mout2.f b/sammy/src/end/mout2.f
index 452ee3ae0b28ae6099f079741ed178df356a404f..7b20f8fcd4df8d89e4646f6a62bf912e3bba9119 100644
--- a/sammy/src/end/mout2.f
+++ b/sammy/src/end/mout2.f
@@ -2,7 +2,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Outext (Ntot, Parext, Iflext, Dump,
+ SUBROUTINE Outext (Parext, Iflext, Dump,
* Iunit, Ipar)
C
C *** PURPOSE -- OUTPUT R-EXTERNAL PARAMETERS
@@ -18,7 +18,7 @@ C
use RMatResonanceParam_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
- DIMENSION Ntot(*), Parext(Nrext,Ntotc,*),
+ DIMENSION Parext(Nrext,Ntotc,*),
* Iflext(Nrext,Ntotc,*), Dump(*)
C DIMENSION Ntot(Ngroup), Parext(Nrext,Ntotc,Ngroup),
C * Iflext(Nrext,Ntotc,Ngroup), Dump(Nvpall)
@@ -30,10 +30,10 @@ C
WRITE (Iunit,99999)
IF (Nrext.EQ.5) WRITE (Iunit,99990)
IF (Nrext.EQ.7) WRITE (Iunit,99989)
- DO I=1,Ngroup
+ DO I=1,resParData%getNumSpinGroups()
call resParData%getSpinGroupInfo(spinInfo, I)
call resParData%getSpinGroup(spinGroup, spinInfo)
- Mmax = Ntot(I)
+ Mmax = spinInfo%getNumChannels()
IF (Iflext(1,1,I).NE.-1) CALL Setflg (Iflext(1,1,I),
* Nrext)
IF (Iflext(1,1,I).NE.-1 .AND. Nrext.EQ.5) WRITE (Iunit,99988)
diff --git a/sammy/src/endf/SammySpinGroupInfo.h b/sammy/src/endf/SammySpinGroupInfo.h
index 5ac37165437da32097b252d193d6069097e5fb5c..badf3c6ac27b4f19385b7792c2583f1fb3549789 100644
--- a/sammy/src/endf/SammySpinGroupInfo.h
+++ b/sammy/src/endf/SammySpinGroupInfo.h
@@ -19,7 +19,6 @@ namespace sammy{
entryChannels(0),
exitChannels(0),
gFactor(0),
- bound(0),
gammaWidthMiscParIndex(0){}
SammySpinGroupInfo(const SammySpinGroupInfo& orig):isotopeIndex(orig.isotopeIndex),
resonanceIndex(orig.resonanceIndex),
@@ -30,7 +29,6 @@ namespace sammy{
entryChannels(orig.entryChannels),
exitChannels(orig.exitChannels),
gFactor(orig.gFactor),
- bound(orig.bound),
gammaWidthMiscParIndex(orig.gammaWidthMiscParIndex){
for (auto it = orig.channelInfo.begin(); it != orig.channelInfo.end(); it++){
channelInfo.push_back( std::make_shared<SammyChannelInfo>( *(*it) ) );
@@ -51,6 +49,9 @@ namespace sammy{
for (auto it = info.channelInfo.begin(); it != info.channelInfo.end(); it++){
channelInfo.push_back( std::make_shared<SammyChannelInfo>( *(*it) ) );
}
+
+ gFactor = info.gFactor;
+ gammaWidthMiscParIndex = info.gammaWidthMiscParIndex;
}
/**
@@ -151,13 +152,92 @@ namespace sammy{
}
/**
- * Get the number of channels
+ * Get the number of channels.
+ *
+ * This is the real number of channels. In traditional SAMMY this does not
+ * include the GAMMA channel. Use getAllChannels() to get the
+ * number of channels including the gamma channel if present.
+ *
* @return the number of channels
*/
int getNumChannels() const{
return (int)channelInfo.size();
}
-
+
+ /**
+ * Get the number of channels including the gamma channel if present
+ */
+ int getAllChannels() const{
+ return getNumChannels() + 1; // in SAMMY the gamma channel is special
+ }
+
+ /**
+ * The number of resonance parameters for a given resonance in this channe.
+ * The number includes the energy and all widths
+ */
+ int getNumResPar() const{
+ return getNumChannels() + 2; // in SAMMY the gamma channel is special (+1) and energy (+1)
+ }
+
+ /**
+ * Get the index of the gamma width in the resonance parameters.
+ * If gamma are not treated special, -1 is returned.
+ *
+ * @return the index of the gamma channel.
+ */
+ int getGammaWidthIndex() const{
+ return 0; // in SAMMY that is currently always the first width
+ // Note: currently we don't ever return -1, but will once more than one gamma channel is allowed
+ }
+
+ /**
+ * Get the index to the width that goes with this channel.
+ *
+ * @return the index of the correspinding width for the chhanel
+ */
+ int getWidthForChannel(int channel) const{
+ // in SAMMY that is currently (channel+1) as the gamma chanel is
+ // not included in the number of channels
+ return channel + 1;
+ }
+
+ /**
+ * Get the index of the elastic channel.
+ * If there is no elastic channel return -1
+ *
+ * @return the index of the elastic channel
+ */
+ int getElasticChannel() const{
+ // In SAMMY this is always the first channel and the second width
+ return 0;
+ // Note: currently we don't ever return -1, but might once the SAMMY restrictions on order are lifted
+
+ }
+
+ /**
+ * Get the first fission channel.
+ * If there is no fission channel, return -1.
+ *
+ * @return the first fission channel
+ */
+ int getFirstFissionChannel() const{
+ // In SAMMY the second channel (and the third width) is the first fission channel
+ return 1;
+ // Note: currently we don't ever return -1, but might once the SAMMY restrictions on order are lifted
+ }
+
+ /**
+ * Get the second fission channel.
+ * If there is no fission channel, return -1.
+ *
+ * @return the first fission channel
+ */
+ int getSecondFissionChannel() const{
+ // In SAMMY the third channel (and the fourth width) is the second fission channel
+ return 2;
+ // Note: currently we don't ever return -1, but might once the SAMMY restrictions on order are lifted
+ }
+
/**
* Get the spin group object tor this info
* @param resInfo the backing ResonanceInfo object
@@ -246,23 +326,7 @@ namespace sammy{
void setGFactor(double g){
gFactor = g;
}
-
- /**
- * Get the bound for this spin group
- * @return the bound for this spin group
- */
- double getBound() const{
- return bound;
- }
-
- /**
- * Set the bound for this spin group
- * @param b the bound for this spin group
- */
- void setBound(double b){
- bound = b;
- }
-
+
/**
* If gamma width are linked, the index into miscellaneous parameters
* that gives the value otherwise less than zero
@@ -308,9 +372,6 @@ namespace sammy{
/** THe gFactor for this spin group */
double gFactor;
- /** The bound for this spin group */
- double bound;
-
/** If gamma width are linked, the index into miscellaneous parameters that gives the value */
int gammaWidthMiscParIndex;
};
diff --git a/sammy/src/endf/interface/cix/SammySpinGroupInfo.cpp2f.xml b/sammy/src/endf/interface/cix/SammySpinGroupInfo.cpp2f.xml
index c7eda9eeb287f1b0131fd72e6c2941b9de77c7cd..3424070d628aab3ae07dede74f973e991142cee9 100644
--- a/sammy/src/endf/interface/cix/SammySpinGroupInfo.cpp2f.xml
+++ b/sammy/src/endf/interface/cix/SammySpinGroupInfo.cpp2f.xml
@@ -48,17 +48,22 @@
<param name="g" type="double"/>
</method>
<method name="getGFactor" return_type="double"/>
-
- <method name="setBound">
- <param name="b" type="double"/>
- </method>
- <method name="getBound" return_type="double"/>
-
+
<method name="getChannelInfo" return_type="SammyChannelInfo *">
<param name="index" type="int" offset="-1"/>
</method>
<method name="getNumChannels" return_type="int"/>
-
+
+ <method name="getAllChannels" return_type="int"/>
+ <method name="getNumResPar" return_type="int"/>
+ <method name="getGammaWidthIndex" return_type="int"/>
+ <method name="getElasticChannel" return_type="int"/>
+ <method name="getFirstFissionChannel" return_type="int"/>
+ <method name="getSecondFissionChannel" return_type="int"/>
+ <method name="getWidthForChannel" return_type="int">
+ <param name="channel" type="int" offset="-1"/>
+ </method>
+
<method name="transferData">
<param name="info" type="SammySpinGroupInfo"/>
</method>
diff --git a/sammy/src/endf/interface/cpp/SammySpinGroupInfoInterface.cpp b/sammy/src/endf/interface/cpp/SammySpinGroupInfoInterface.cpp
index 8135bf0c0c9ea6904fcbeb17ff95d9286942914c..d7abe1b86af3b43aea502f0235c9583bf5cc9501 100644
--- a/sammy/src/endf/interface/cpp/SammySpinGroupInfoInterface.cpp
+++ b/sammy/src/endf/interface/cpp/SammySpinGroupInfoInterface.cpp
@@ -2,7 +2,7 @@
* This file has been dynamically generated by Class Interface Xml (CIX)
* DO NOT MODIFY THIS FILE -- CHANGES WILL BE OVERWRITTEN UPON REGENERATION
* If changes need to occur, modify the appropriate CIX xml file
-* Date Generated: Fri Nov 08 10:09:41 EST 2019
+* Date Generated: Mon Mar 23 09:58:11 EDT 2020
* If any issues are experiences with this generated file that cannot be fixed
* with adjustment of the CIX xml file, please contact Robert A. Lefebvre, raq@ornl.gov
*/
@@ -99,24 +99,49 @@ double SammySpinGroupInfo_getGFactor(void * SammySpinGroupInfo_ptr)
return ((SammySpinGroupInfo*)SammySpinGroupInfo_ptr)->getGFactor();
}
-void SammySpinGroupInfo_setBound(void * SammySpinGroupInfo_ptr,double * b)
+void* SammySpinGroupInfo_getChannelInfo(void * SammySpinGroupInfo_ptr,int * index)
{
- ((SammySpinGroupInfo*)SammySpinGroupInfo_ptr)->setBound(*b);
+ return (void*)((SammySpinGroupInfo*)SammySpinGroupInfo_ptr)->getChannelInfo(*index);
}
-double SammySpinGroupInfo_getBound(void * SammySpinGroupInfo_ptr)
+int SammySpinGroupInfo_getNumChannels(void * SammySpinGroupInfo_ptr)
{
- return ((SammySpinGroupInfo*)SammySpinGroupInfo_ptr)->getBound();
+ return ((SammySpinGroupInfo*)SammySpinGroupInfo_ptr)->getNumChannels();
}
-void* SammySpinGroupInfo_getChannelInfo(void * SammySpinGroupInfo_ptr,int * index)
+int SammySpinGroupInfo_getAllChannels(void * SammySpinGroupInfo_ptr)
{
- return (void*)((SammySpinGroupInfo*)SammySpinGroupInfo_ptr)->getChannelInfo(*index);
+ return ((SammySpinGroupInfo*)SammySpinGroupInfo_ptr)->getAllChannels();
}
-int SammySpinGroupInfo_getNumChannels(void * SammySpinGroupInfo_ptr)
+int SammySpinGroupInfo_getNumResPar(void * SammySpinGroupInfo_ptr)
{
- return ((SammySpinGroupInfo*)SammySpinGroupInfo_ptr)->getNumChannels();
+ return ((SammySpinGroupInfo*)SammySpinGroupInfo_ptr)->getNumResPar();
+}
+
+int SammySpinGroupInfo_getGammaWidthIndex(void * SammySpinGroupInfo_ptr)
+{
+ return ((SammySpinGroupInfo*)SammySpinGroupInfo_ptr)->getGammaWidthIndex();
+}
+
+int SammySpinGroupInfo_getElasticChannel(void * SammySpinGroupInfo_ptr)
+{
+ return ((SammySpinGroupInfo*)SammySpinGroupInfo_ptr)->getElasticChannel();
+}
+
+int SammySpinGroupInfo_getFirstFissionChannel(void * SammySpinGroupInfo_ptr)
+{
+ return ((SammySpinGroupInfo*)SammySpinGroupInfo_ptr)->getFirstFissionChannel();
+}
+
+int SammySpinGroupInfo_getSecondFissionChannel(void * SammySpinGroupInfo_ptr)
+{
+ return ((SammySpinGroupInfo*)SammySpinGroupInfo_ptr)->getSecondFissionChannel();
+}
+
+int SammySpinGroupInfo_getWidthForChannel(void * SammySpinGroupInfo_ptr,int * channel)
+{
+ return ((SammySpinGroupInfo*)SammySpinGroupInfo_ptr)->getWidthForChannel(*channel);
}
void SammySpinGroupInfo_transferData(void * SammySpinGroupInfo_ptr,SammySpinGroupInfo * info)
diff --git a/sammy/src/endf/interface/cpp/SammySpinGroupInfoInterface.h b/sammy/src/endf/interface/cpp/SammySpinGroupInfoInterface.h
index bb1f8294ba9b95d103afa1ebf94ebb3d652d7b14..9509faac8f2afedab136740c66983b3254b54007 100644
--- a/sammy/src/endf/interface/cpp/SammySpinGroupInfoInterface.h
+++ b/sammy/src/endf/interface/cpp/SammySpinGroupInfoInterface.h
@@ -2,7 +2,7 @@
* This file has been dynamically generated by Class Interface Xml (CIX)
* DO NOT MODIFY THIS FILE -- CHANGES WILL BE OVERWRITTEN UPON REGENERATION
* If changes need to occur, modify the appropriate CIX xml file
-* Date Generated: Fri Nov 08 10:09:41 EST 2019
+* Date Generated: Mon Mar 23 09:58:11 EDT 2020
* If any issues are experiences with this generated file that cannot be fixed
* with adjustment of the CIX xml file, please contact Robert A. Lefebvre, raq@ornl.gov
*/
@@ -31,10 +31,15 @@ void SammySpinGroupInfo_setNumEntryChannels(void * SammySpinGroupInfo_ptr,int *
int SammySpinGroupInfo_getNumEntryChannels(void * SammySpinGroupInfo_ptr);
void SammySpinGroupInfo_setGFactor(void * SammySpinGroupInfo_ptr,double * g);
double SammySpinGroupInfo_getGFactor(void * SammySpinGroupInfo_ptr);
-void SammySpinGroupInfo_setBound(void * SammySpinGroupInfo_ptr,double * b);
-double SammySpinGroupInfo_getBound(void * SammySpinGroupInfo_ptr);
void* SammySpinGroupInfo_getChannelInfo(void * SammySpinGroupInfo_ptr,int * index);
int SammySpinGroupInfo_getNumChannels(void * SammySpinGroupInfo_ptr);
+int SammySpinGroupInfo_getAllChannels(void * SammySpinGroupInfo_ptr);
+int SammySpinGroupInfo_getNumResPar(void * SammySpinGroupInfo_ptr);
+int SammySpinGroupInfo_getGammaWidthIndex(void * SammySpinGroupInfo_ptr);
+int SammySpinGroupInfo_getElasticChannel(void * SammySpinGroupInfo_ptr);
+int SammySpinGroupInfo_getFirstFissionChannel(void * SammySpinGroupInfo_ptr);
+int SammySpinGroupInfo_getSecondFissionChannel(void * SammySpinGroupInfo_ptr);
+int SammySpinGroupInfo_getWidthForChannel(void * SammySpinGroupInfo_ptr,int * channel);
void SammySpinGroupInfo_transferData(void * SammySpinGroupInfo_ptr,SammySpinGroupInfo * info);
void SammySpinGroupInfo_setGammWidthParIndex(void * SammySpinGroupInfo_ptr,int * index);
int SammySpinGroupInfo_getGammWidthParIndex(void * SammySpinGroupInfo_ptr);
diff --git a/sammy/src/endf/interface/fortran/SammySpinGroupInfo_I.f90 b/sammy/src/endf/interface/fortran/SammySpinGroupInfo_I.f90
index 55584926674e7c0ccc114f3c70943ca5152240d1..5b82f29d00b8b2aed2b9a18a01c49374e133e624 100644
--- a/sammy/src/endf/interface/fortran/SammySpinGroupInfo_I.f90
+++ b/sammy/src/endf/interface/fortran/SammySpinGroupInfo_I.f90
@@ -2,7 +2,7 @@
!! This file has been dynamically generated by Class Interface Xml (CIX)
!! DO NOT MODIFY THIS FILE -- CHANGES WILL BE OVERWRITTEN UPON REGENERATION
!! If changes need to occur, modify the appropriate CIX xml file
-!! Date Generated: Fri Nov 08 10:09:41 EST 2019
+!! Date Generated: Mon Mar 23 09:58:11 EDT 2020
!! If any issues are experiences with this generated file that cannot be fixed
!! with adjustment of the CIX xml file, please contact Robert A. Lefebvre, raq@ornl.gov
!!/
@@ -108,27 +108,52 @@ real(C_DOUBLE) function f_SammySpinGroupInfo_getGFactor(SammySpinGroupInfo_ptr )
implicit none
type(C_PTR), value :: SammySpinGroupInfo_ptr;
end function
-subroutine f_SammySpinGroupInfo_setBound(SammySpinGroupInfo_ptr, b ) BIND(C,name="SammySpinGroupInfo_setBound")
+type(C_PTR) function f_SammySpinGroupInfo_getChannelInfo(SammySpinGroupInfo_ptr, index ) BIND(C,name="SammySpinGroupInfo_getChannelInfo")
use,intrinsic :: ISO_C_BINDING
implicit none
type(C_PTR), value :: SammySpinGroupInfo_ptr;
- real(C_DOUBLE) :: b;
-end subroutine
-real(C_DOUBLE) function f_SammySpinGroupInfo_getBound(SammySpinGroupInfo_ptr ) BIND(C,name="SammySpinGroupInfo_getBound")
+ integer(C_INT) :: index;
+end function
+integer(C_INT) function f_SammySpinGroupInfo_getNumChannels(SammySpinGroupInfo_ptr ) BIND(C,name="SammySpinGroupInfo_getNumChannels")
use,intrinsic :: ISO_C_BINDING
implicit none
type(C_PTR), value :: SammySpinGroupInfo_ptr;
end function
-type(C_PTR) function f_SammySpinGroupInfo_getChannelInfo(SammySpinGroupInfo_ptr, index ) BIND(C,name="SammySpinGroupInfo_getChannelInfo")
+integer(C_INT) function f_SammySpinGroupInfo_getAllChannels(SammySpinGroupInfo_ptr ) BIND(C,name="SammySpinGroupInfo_getAllChannels")
use,intrinsic :: ISO_C_BINDING
implicit none
type(C_PTR), value :: SammySpinGroupInfo_ptr;
- integer(C_INT) :: index;
end function
-integer(C_INT) function f_SammySpinGroupInfo_getNumChannels(SammySpinGroupInfo_ptr ) BIND(C,name="SammySpinGroupInfo_getNumChannels")
+integer(C_INT) function f_SammySpinGroupInfo_getNumResPar(SammySpinGroupInfo_ptr ) BIND(C,name="SammySpinGroupInfo_getNumResPar")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammySpinGroupInfo_ptr;
+end function
+integer(C_INT) function f_SammySpinGroupInfo_getGammaWidthIndex(SammySpinGroupInfo_ptr ) BIND(C,name="SammySpinGroupInfo_getGammaWidthIndex")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammySpinGroupInfo_ptr;
+end function
+integer(C_INT) function f_SammySpinGroupInfo_getElasticChannel(SammySpinGroupInfo_ptr ) BIND(C,name="SammySpinGroupInfo_getElasticChannel")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammySpinGroupInfo_ptr;
+end function
+integer(C_INT) function f_SammySpinGroupInfo_getFirstFissionChannel(SammySpinGroupInfo_ptr ) BIND(C,name="SammySpinGroupInfo_getFirstFissionChannel")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammySpinGroupInfo_ptr;
+end function
+integer(C_INT) function f_SammySpinGroupInfo_getSecondFissionChannel(SammySpinGroupInfo_ptr ) BIND(C,name="SammySpinGroupInfo_getSecondFissionChannel")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammySpinGroupInfo_ptr;
+end function
+integer(C_INT) function f_SammySpinGroupInfo_getWidthForChannel(SammySpinGroupInfo_ptr, channel ) BIND(C,name="SammySpinGroupInfo_getWidthForChannel")
use,intrinsic :: ISO_C_BINDING
implicit none
type(C_PTR), value :: SammySpinGroupInfo_ptr;
+ integer(C_INT) :: channel;
end function
subroutine f_SammySpinGroupInfo_transferData(SammySpinGroupInfo_ptr, info ) BIND(C,name="SammySpinGroupInfo_transferData")
use,intrinsic :: ISO_C_BINDING
diff --git a/sammy/src/endf/interface/fortran/SammySpinGroupInfo_M.f90 b/sammy/src/endf/interface/fortran/SammySpinGroupInfo_M.f90
index 8177b2653ef59b9c65947e5ff08d6bbc74bad8ce..6a99a718859a725b0627b171b4af2d851d50eab9 100644
--- a/sammy/src/endf/interface/fortran/SammySpinGroupInfo_M.f90
+++ b/sammy/src/endf/interface/fortran/SammySpinGroupInfo_M.f90
@@ -2,7 +2,7 @@
!! This file has been dynamically generated by Class Interface Xml (CIX)
!! DO NOT MODIFY THIS FILE -- CHANGES WILL BE OVERWRITTEN UPON REGENERATION
!! If changes need to occur, modify the appropriate CIX xml file
-!! Date Generated: Fri Nov 08 10:09:41 EST 2019
+!! Date Generated: Mon Mar 23 09:58:11 EDT 2020
!! If any issues are experiences with this generated file that cannot be fixed
!! with adjustment of the CIX xml file, please contact Robert A. Lefebvre, raq@ornl.gov
!!/
@@ -31,10 +31,15 @@ type SammySpinGroupInfo
procedure, pass(this) :: getNumEntryChannels => SammySpinGroupInfo_getNumEntryChannels
procedure, pass(this) :: setGFactor => SammySpinGroupInfo_setGFactor
procedure, pass(this) :: getGFactor => SammySpinGroupInfo_getGFactor
- procedure, pass(this) :: setBound => SammySpinGroupInfo_setBound
- procedure, pass(this) :: getBound => SammySpinGroupInfo_getBound
procedure, pass(this) :: getChannelInfo => SammySpinGroupInfo_getChannelInfo
procedure, pass(this) :: getNumChannels => SammySpinGroupInfo_getNumChannels
+ procedure, pass(this) :: getAllChannels => SammySpinGroupInfo_getAllChannels
+ procedure, pass(this) :: getNumResPar => SammySpinGroupInfo_getNumResPar
+ procedure, pass(this) :: getGammaWidthIndex => SammySpinGroupInfo_getGammaWidthIndex
+ procedure, pass(this) :: getElasticChannel => SammySpinGroupInfo_getElasticChannel
+ procedure, pass(this) :: getFirstFissionChannel => SammySpinGroupInfo_getFirstFissionChannel
+ procedure, pass(this) :: getSecondFissionChannel => SammySpinGroupInfo_getSecondFissionChannel
+ procedure, pass(this) :: getWidthForChannel => SammySpinGroupInfo_getWidthForChannel
procedure, pass(this) :: transferData => SammySpinGroupInfo_transferData
procedure, pass(this) :: setGammWidthParIndex => SammySpinGroupInfo_setGammWidthParIndex
procedure, pass(this) :: getGammWidthParIndex => SammySpinGroupInfo_getGammWidthParIndex
@@ -64,7 +69,7 @@ function SammySpinGroupInfo_getResonanceIndex(this) result(result2Return)
implicit none
class(SammySpinGroupInfo)::this
integer(C_INT):: result2Return
- result2Return=f_SammySpinGroupInfo_getResonanceIndex(this%instance_ptr)
+ result2Return=f_SammySpinGroupInfo_getResonanceIndex(this%instance_ptr) + 1
end function
subroutine SammySpinGroupInfo_setSpinGroupIndex(this, index)
implicit none
@@ -150,18 +155,6 @@ function SammySpinGroupInfo_getGFactor(this) result(result2Return)
real(C_DOUBLE):: result2Return
result2Return=f_SammySpinGroupInfo_getGFactor(this%instance_ptr)
end function
-subroutine SammySpinGroupInfo_setBound(this, b)
- implicit none
- class(SammySpinGroupInfo)::this
- real(C_DOUBLE)::b
- call f_SammySpinGroupInfo_setBound(this%instance_ptr, b)
-end subroutine
-function SammySpinGroupInfo_getBound(this) result(result2Return)
- implicit none
- class(SammySpinGroupInfo)::this
- real(C_DOUBLE):: result2Return
- result2Return=f_SammySpinGroupInfo_getBound(this%instance_ptr)
-end function
subroutine SammySpinGroupInfo_getChannelInfo(this, object_ptr, index)
implicit none
class(SammySpinGroupInfo)::this
@@ -175,6 +168,49 @@ function SammySpinGroupInfo_getNumChannels(this) result(result2Return)
integer(C_INT):: result2Return
result2Return=f_SammySpinGroupInfo_getNumChannels(this%instance_ptr)
end function
+function SammySpinGroupInfo_getAllChannels(this) result(result2Return)
+ implicit none
+ class(SammySpinGroupInfo)::this
+ integer(C_INT):: result2Return
+ result2Return=f_SammySpinGroupInfo_getAllChannels(this%instance_ptr)
+end function
+function SammySpinGroupInfo_getNumResPar(this) result(result2Return)
+ implicit none
+ class(SammySpinGroupInfo)::this
+ integer(C_INT):: result2Return
+ result2Return=f_SammySpinGroupInfo_getNumResPar(this%instance_ptr)
+end function
+function SammySpinGroupInfo_getGammaWidthIndex(this) result(result2Return)
+ implicit none
+ class(SammySpinGroupInfo)::this
+ integer(C_INT):: result2Return
+ result2Return=f_SammySpinGroupInfo_getGammaWidthIndex(this%instance_ptr) + 1
+end function
+function SammySpinGroupInfo_getElasticChannel(this) result(result2Return)
+ implicit none
+ class(SammySpinGroupInfo)::this
+ integer(C_INT):: result2Return
+ result2Return=f_SammySpinGroupInfo_getElasticChannel(this%instance_ptr) + 1
+end function
+function SammySpinGroupInfo_getFirstFissionChannel(this) result(result2Return)
+ implicit none
+ class(SammySpinGroupInfo)::this
+ integer(C_INT):: result2Return
+ result2Return=f_SammySpinGroupInfo_getFirstFissionChannel(this%instance_ptr) + 1
+end function
+function SammySpinGroupInfo_getSecondFissionChannel(this) result(result2Return)
+ implicit none
+ class(SammySpinGroupInfo)::this
+ integer(C_INT):: result2Return
+ result2Return=f_SammySpinGroupInfo_getSecondFissionChannel(this%instance_ptr) + 1
+end function
+function SammySpinGroupInfo_getWidthForChannel(this, channel) result(result2Return)
+ implicit none
+ class(SammySpinGroupInfo)::this
+ integer(C_INT)::channel
+ integer(C_INT):: result2Return
+ result2Return=f_SammySpinGroupInfo_getWidthForChannel(this%instance_ptr, channel-1) + 1
+end function
subroutine SammySpinGroupInfo_transferData(this, info)
implicit none
class(SammySpinGroupInfo)::this
diff --git a/sammy/src/fin/mfin0.f b/sammy/src/fin/mfin0.f
index 11e2c3c4950c1c7387cc6ba5144140cb416d0c52..18c19f5360bd1961090baa3e04745cb15d21a94f 100644
--- a/sammy/src/fin/mfin0.f
+++ b/sammy/src/fin/mfin0.f
@@ -75,7 +75,7 @@ C ### two ###
Itempz = Idimen (Kkkkkk, 1, 'Kkkkkk, 1')
Itempr = Idimen (K4, 1, 'Tempr K4, 1')
CALL Convrt ( A_Iprbrd , I_Iflbrd , A_Isiabn ,
- * I_Intot , I_Ilpent , I_Ilspin , A_Iechan , I_Ixclud ,
+ * A_Iechan ,
* A_Ipreff , I_Ifleff , A_Iprtru , I_Ifltru , I_Iigrra ,
* I_Ifliso , A_Idpiso , A_Idsiso ,
* A_Iprdet , I_Ifldet , A_Iprext , I_Iflext ,
@@ -89,7 +89,7 @@ C ### two ###
C *** Routine Convrt converts from U-parameters to physical parameters
C
C *** update Zkte and Zkfe
- CALL Updrad (I_Intot , I_Iigrra , A_Ipreff , A_Iprtru ,
+ CALL Updrad (I_Iigrra , A_Ipreff , A_Iprtru ,
* A_Izke , A_Izkte , A_Izkfe , I_Ifzkte , I_Ifzkfe )
C
C
@@ -215,9 +215,7 @@ C - - - - - - - - - - - - - - - - - - - - - - - - - ->
C
Iux = Idimen (Nres*Ntotc2, 1,'Ux , Nres*Ntotc2, 1')
CALL Oldord ( A_Iprbrd , I_Iflbrd , A_Idebrd ,
- * I_Inent , I_Inext , I_Intot , I_Iishif ,
- * I_Ilpent , I_Ifexcl , I_Ilspin , A_Ichspi , A_Ienbnd ,
- * I_Ikppai , I_Ixclud ,
+ * I_Ifexcl ,
* A_Ipreff , I_Ifleff , A_Ideeff ,
* A_Iprtru , I_Ifltru , A_Idetru , I_Iigrra ,
* I_Ifliso , A_Ideiso ,
@@ -380,16 +378,13 @@ C
END IF
C
IF ((Iterat.EQ.Itmax .OR. Ksuppr.EQ.2) .AND. Kreduc.NE.0) THEN
- CALL Outred ( A_Igoj , I_Intot ,
- * I_Ilspin , A_Ichspi , 1)
+ CALL Outred (1)
C
IF (Iterat.EQ.Itmax) CALL Outvr (A(Idum3))
END IF
C
IF ((Iterat.EQ.Itmax .OR. Ksuppr.EQ.2) .AND. Kmlbw.NE.0) THEN
- CALL Outmlb( A_Igoj , I_Intot , I_Iishif ,
- * I_Ilspin , A_Ibound , A_Iechan ,
- * A_Izeta , 1)
+ CALL Outmlb(A_Ibound , A_Iechan , A_Izeta , 1)
END IF
C
RETURN
diff --git a/sammy/src/fin/mfin1.f b/sammy/src/fin/mfin1.f
index 1e233b5e7d946460d28cea3fe8fc2b313f14c355..6ac1590933d93cd7ca6c23b674ca1bbedebbff62 100644
--- a/sammy/src/fin/mfin1.f
+++ b/sammy/src/fin/mfin1.f
@@ -57,8 +57,8 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Convrt ( Parbrd, Iflbrd, Siabnd, Ntot ,
- * Lpent , Lspin , Echan , Ixclud,
+ SUBROUTINE Convrt ( Parbrd, Iflbrd, Siabnd,
+ * Echan ,
* Pareff, Ifleff, Partru, Ifltru, Igrrad,
* Ifliso, Dopwid, Doswid,
* Pardet, Ifldet, Parext, Iflext,
@@ -78,8 +78,8 @@ C
use namfil_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
- DIMENSION Parbrd(*), Iflbrd(*), Siabnd(*), Ntot(*),
- * Lpent(Ntotc,*), Lspin(Ntotc,*), Echan(Ntotc,*), Ixclud(*),
+ DIMENSION Parbrd(*), Iflbrd(*), Siabnd(*),
+ * Echan(Ntotc,*),
* Pareff(*), Ifleff(*), Partru(*), Ifltru(*), Igrrad(Ntotc,*),
* Ifliso(*), Dopwid(*), Doswid(*),
* Pardet(*), Ifldet(*),
@@ -94,8 +94,7 @@ C
* Itempx(*), Tempx(*), Tempy(*), Tempz(*), Temprd(Nvpall,*)
C
C DIMENSION Parbrd(Numbrd), Iflbrd(Numbrd), Ntot(Ngroup),
-C * Lpent(Ntotc,Ngroup), Lspin(Ntotc,Ngroup),
-C * Echan(Ntotc,Ngroup), Ixclud(Ngroup),
+C * Echan(Ntotc,Ngroup),
C * Pareff(Numrad), Ifleff(Numrad),
C * Partru(Numrad), Ifltru(Numrad), Igrrad(Ntotc,Ngroup),
C * Ifliso(Numiso),
@@ -121,7 +120,7 @@ C
CALL Zero_Array (Tempz, Nvpall)
END IF
C
- CALL Fxcrfn (Iflbrd, Ntot, Pareff, Ifleff, Partru, Ifltru, Igrrad,
+ CALL Fxcrfn (Iflbrd, Pareff, Ifleff, Partru, Ifltru, Igrrad,
* Zke, Zkte, Zkfe, Icrfn)
C
Ipar = 0
@@ -129,7 +128,7 @@ C
Nvp = 0
C
IF (Nres.GT.0) THEN
- CALL Cnvres (Ntot, Lpent, Lspin, Echan, Ixclud, Igrrad,
+ CALL Cnvres (Echan, Igrrad,
* Polar, Zke, Zkte, Zeta, If_Zkte, Itempx, Tempx, Tempy,
* Tempz, Temprd, Icrfn, Ipar)
END IF
@@ -137,7 +136,7 @@ C
IF (Nvp.EQ.Nvpall) RETURN
C
IF (Nvpext.NE.0) THEN
- CALL Cnvext(Ntot, Parext, Iflext, Tempy, Ipar)
+ CALL Cnvext(Parext, Iflext, Tempy, Ipar)
END IF
CALL Update (Ipar, Kpar, Nvp, Nfpext, Nvpext)
IF (Nvp.EQ.Nvpall) RETURN
@@ -225,7 +224,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Fxcrfn (Iflbrd, Ntot, Pareff, Ifleff, Partru, Ifltru,
+ SUBROUTINE Fxcrfn (Iflbrd, Pareff, Ifleff, Partru, Ifltru,
* Igrrad, Zke, Zkte, Zkfe, Icrfn)
C
use fixedi_m
@@ -233,12 +232,15 @@ C
use fixedr_m
use broad_common_m
use EndfData_common_m
+ use SammyChannelInfo_M
+ use ResonanceParameterIO_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
- DIMENSION Iflbrd(*), Ntot(*), Pareff(*), Ifleff(*), Partru(*),
+ type(SammySpinGroupInfo)::spinInfo
+ DIMENSION Iflbrd(*), Pareff(*), Ifleff(*), Partru(*),
* Ifltru(*), Igrrad(Ntotc,*), Zke(Ntotc,*), Zkte(Ntotc,*),
* Zkfe(Ntotc,*)
-C DIMENSION Iflbrd(Numbrd), Ntot(Ngroup), Pareff(Numrad),
+C DIMENSION Iflbrd(Numbrd), Pareff(Numrad),
C * Ifleff(Numrad), Partru(Numrad), Ifltru(Numrad),
C * Igrrad(Ntotc,Ngroup), Zke(Ntotc,Ngroup), Zkte(Ntotc,Ngroup),
C * Zkfe(Ntotc,Ngroup)
@@ -253,7 +255,8 @@ C
Cycrfn = Cycrfn*val/Crfn
Crfn = covData%getUParamValue(Icrfn)
DO Ig=1,resParData%getNumSpinGroups()
- Ntotig = Ntot(Ig)
+ call resParData%getSpinGroupInfo(spinInfo, Ig)
+ Ntotig = spinInfo%getNumChannels()
DO M=1,Ntotig
Zkte(M,Ig) = Zke(M,Ig)*Crfn
Zkfe(M,Ig) = Zke(M,Ig)*Crfn
@@ -293,7 +296,8 @@ C
END IF
END DO
DO Ig=1,resParData%getNumSpinGroups()
- Ntotig = Ntot(Ig)
+ call resParData%getSpinGroupInfo(spinInfo, Ig)
+ Ntotig = spinInfo%getNumChannels()
DO M=1,Ntotig
Zkte(M,Ig) = Zke(M,Ig)*Partru(Igrrad(M,Ig))
Zkfe(M,Ig) = Zke(M,Ig)*Pareff(Igrrad(M,Ig))
@@ -319,7 +323,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Cnvres (Ntot, Lpent, Lspin, Echan, Ixclud, Igrrad,
+ SUBROUTINE Cnvres (Echan, Igrrad,
* Polar,
* Zke, Zkte, Zeta, If_Zkte, Itempx, Tempx, Tempy, Tempz,
* Temprd, Icrfn, Ipar)
@@ -341,8 +345,12 @@ C
C
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance, resonanceRed
- DIMENSION Ntot(*), Lpent(Ntotc,*), Lspin(Ntotc,*),
- * Echan(Ntotc,*), Ixclud(*), Igrrad(Ntotc,*),
+ type(SammySpinGroupInfo)::spinInfo
+ type(SammyChannelInfo)::channelInfo
+ type(RMatChannelParams)::channel
+ type(SammyParticlePairInfo)::pairInfo
+ type(RMatParticlePair)::pair
+ DIMENSION Echan(Ntotc,*), Igrrad(Ntotc,*),
* Polar(2,*),
* Zke(Ntotc,*), Zkte(Ntotc,*), Zeta(Ntotc,*), If_Zkte(Ntotc,*),
* Itempx(*), Tempx(*), Tempy(*), Tempz(*),
@@ -365,8 +373,10 @@ C
call resParData%getRedResonance(resonanceRed, resInfo)
Igrp = resInfo%getSpinGroupIndex()
- Ntotn = Ntot(Igrp)
- Ntotn2 = Ntotn + 2
+ call resParData%getSpinGroupInfo(spinInfo, Igrp)
+ Ntotn = spinInfo%getNumChannels()
+ Ntotn2 = spinInfo%getNumResPar()
+ iwGam = spinInfo%getGammaWidthIndex()
DO M=1,Ntotn2
if (m.eq.1) then
IFlr = resInfo%getEnergyFitOption()
@@ -398,36 +408,46 @@ C *** sign is correct 4 June 2004
Tempy(Keep) = F*Two*val
cq IF (Icrfn.GT.0) Tempz(Keep) = Fz
C
- ELSE IF (M.EQ.2) THEN
+ ELSE IF (M.EQ.(iwGam+1)) THEN
C *** Gamma_gamma (eliminated capture width)
F = Twotho
Fz = Zero
- call resonanceRed%setWidth(1, val)
+ call resonanceRed%setWidth(iwGam, val)
G2 = val**2
G3 = G2**2
Gga = F*G2
IF (val.LT.Zero) Gga = -Gga
- call resonance%setWidth(1, gga)
+ call resonance%setWidth(iwGam, gga)
Tempy(Keep) = F*Two*val
cq IF (Icrfn.GT.0) Tempz(Keep) = Fz
C
- ELSE IF (M.GE.3) THEN
+ ELSE
C *** Gamma_N (Particle widths)
M2 = M - 2
+ ichan = spinInfo%getWidthForChannel(M2)
IF (M2.EQ.1 .OR. Kpolar.NE.1) THEN
- call resonanceRed%setWidth(m-1, val)
+ call resonanceRed%setWidth(ichan, val)
P = One
Der = Zero
- Fz = Zero
- IF (resonance%getWidth(m2+1).EQ.Zero) THEN
+ Fz = Zero
+ IF (resonance%getWidth(ichan).EQ.Zero) THEN
ELSE
- IF (Lpent(M2,Igrp).NE.0) THEN
+ call spinInfo%getChannelInfo(channelInfo,
+ * M2)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair,
+ * pairInfo)
+ IF (pair%getPnt().NE.0) THEN
eres = resonance%getEres()
Q = dABS(eres-Echan(M2,Igrp))
IF (Q.NE.Zero) THEN
Q = dSQRT(Q)
Rho = Zkte(M2,Igrp)*Q
- Lsp = Lspin(M2,Igrp)
+ call resParData%getChannel(channel,
+ * channelInfo)
+ Lsp = channel%getL()
IF (Zeta(M2,Igrp).EQ.Zero) THEN
P = Pfd (Rho, Der, Lsp)
ELSE
@@ -458,19 +478,19 @@ C *** The following line takes care of negative sign for negative Pken
END IF
F = Twotho*P
C
- call resonance%setWidth(m2+1,F*val**2)
+ call resonance%setWidth(ichan,F*val**2)
IF (Nvprad.GT.0 .AND.
* If_Zkte(M2,Igrp).GT.0) Temprd(Keep,
* If_Zkte(M2,Igrp)-Iiirad) = Fz
Tempy(Keep) = F*Two*val
IF (Jpken.NE.0) THEN
Tempx(Keep) = Fx *
- * resonance%getWidth(m2+1)
+ * resonance%getWidth(ichan)
END IF
IF (Icrfn.GT.0) Tempz(Keep) = Fz
- G1 = resonance%getWidth(m2+1)
+ G1 = resonance%getWidth(ichan)
IF (val.LT.Zero) g1 = -g1
- call resonance%setWidth(m2+1,g1)
+ call resonance%setWidth(ichan,g1)
END IF
C
ELSE
@@ -504,8 +524,7 @@ C ************* Here for Polar coordinates
END DO
C
C
- CALL Fxgamn (Ntot, Lpent, Lspin, Echan, Ixclud,
- * Zkte, Zeta)
+ CALL Fxgamn (Echan, Zkte, Zeta)
C
C
IF (Icrfn.NE.0) THEN
@@ -518,23 +537,31 @@ C *** before do all this !
DO Ires=1,resParData%getNumResonances()
call resParData%getResonanceInfo(resInfo, Ires)
Igrp = resInfo%getSpinGroupIndex()
+ call resparData%getSpinGroupInfo(spinInfo, Igrp)
IF (resInfo%getIncludeInCalc()) THEN
- IF (Ixclud(Igrp).LE.0) THEN
+ IF (spinInfo%getIncludeInCalc()) THEN
call resParData%getResonance(resonance, resInfo)
- call resParData%getRedResonance(resonanceRed, resInfo)
- Ntotn = Ntot(Igrp)
+ call resParData%getRedResonance(resonanceRed, resInfo)
+ Ntotn = spinInfo%getNumChannels()
DO M2=1,Ntotn
M = M2 + 2
+ ichan = spinInfo%getWidthForChannel(M2)
ifl = resInfo%getChannelFitOption(m-1)
- IF (Ifl.EQ.0 .AND. Lpent(M2,Igrp).NE.0
- * .AND. resonanceRed%getWidth(M2+1).NE.Zero ) THEN
+ call spinInfo%getChannelInfo(channelInfo, M2)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ IF (Ifl.EQ.0 .AND. pair%getPnt().NE.0
+ * .AND. resonanceRed%getWidth(ichan).NE.Zero ) THEN
P = One
eres = resonance%getEres()
Q = dABS(eres-Echan(M2,Igrp))
IF (Q.NE.Zero) THEN
Q = dSQRT(Q)
Rho = Zkte(M2,Igrp)*Q
- Lsp = Lspin(M2,Igrp)
+ call resParData%getChannel(channel, channelInfo)
+ Lsp = channel%getL()
IF (Zeta(M2,Igrp).EQ.Zero) THEN
P = Pf (Rho, Lsp)
ELSE
@@ -548,11 +575,12 @@ C *** before do all this !
END IF
F = Twotho*P
C keep unvaried Gammas fixed
- A = dABS(resonance%getWidth(M2+1))
+ A = dABS(resonance%getWidth(ichan))
redWidth = dSQRT(A/F)
- IF (resonance%getWidth(M2+1).LT.Zero) redWidth =
- * -redWidth
- call resonanceRed%setWidth(M2+1, redWidth)
+ IF (resonance%getWidth(ichan).LT.Zero) then
+ redWidth = -redWidth
+ END IF
+ call resonanceRed%setWidth(ichan, redWidth)
END IF
END IF
END DO
@@ -568,8 +596,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Fxgamn (Ntot, Lpent, Lspin, Echan, Ixclud,
- * Zkte, Zeta)
+ SUBROUTINE Fxgamn (Echan, Zkte, Zeta)
C
C *** PURPOSE -- Fix up the particle widths to correspond to the
C *** updated energies (cuz is reduced widths that are
@@ -587,11 +614,15 @@ C
C
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance,resonanceRed
- DIMENSION Ntot(*), Lpent(Ntotc,*), Lspin(Ntotc,*), Echan(Ntotc,*),
- * Ixclud(*), Zkte(Ntotc,*), Zeta(Ntotc,*)
-C
-C DIMENSION Ntot(Ngroup), Lpent(Ntotc,Ngroup),
-C * Lspin(Ntotc,Ngroup), Echan(Ntotc,Ngroup), Ixclud(Ngroup),
+ type(SammySpinGroupInfo)::spinInfo
+ type(SammyParticlePairInfo)::pairInfo
+ type(RMatParticlePair)::pair
+ type(RMatChannelParams)::channel
+ type(SammyChannelInfo)::channelInfo
+ DIMENSION Echan(Ntotc,*), Zkte(Ntotc,*), Zeta(Ntotc,*)
+C
+C DIMENSION
+C * Echan(Ntotc,Ngroup),
C * Zkte(Ntotc,Ngroup), Zeta(Ntotc,Ngroup)
C
DATA Zero /0.0d0/, One /1.0d0/, Twotho /2000.0d0/
@@ -605,8 +636,10 @@ C
call resParData%getResonance(resonance, resInfo)
call resParData%getRedResonance(resonanceRed, resInfo)
Igrp = resInfo%getSpinGroupIndex()
- Ntotn = Ntot(Igrp)
- Ntotn2 = Ntotn + 2
+ call resparData%getSpinGroupInfo(spinInfo, Igrp)
+ Ntotn = spinInfo%getNumChannels()
+ Ntotn2 = spinInfo%getNumResPar()
+ iwGam = spinInfo%getGammaWidthIndex()
DO M=1,Ntotn2
if(m.eq.1) then
ifl = resInfo%getEnergyFitOption()
@@ -615,7 +648,7 @@ C
end if
IF (Ifl.NE.0) THEN
Iiipar = Iiipar + 1
- IF (Ixclud(Igrp).EQ.0 .AND.
+ IF (spinInfo%getIncludeInCalc() .AND.
* .not.covData%isPupedParameter(Iiipar)) THEN
IF (M.LE.1) THEN
C *** IF (varied parameter is resonance energy) THEN
@@ -623,12 +656,19 @@ C
C *** DO loop over Gamma_N (particle widths)
DO M2=1,Ntotn
P = One
- IF (Lpent(M2,Igrp).NE.0 .AND.
- * resonanceRed%getWidth(M2+1).NE.Zero) THEN
+ call spinInfo%getChannelInfo(channelInfo, M2)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ ichan = spinInfo%getWidthForChannel(M2)
+ IF (pair%getPnt().NE.0 .AND.
+ * resonanceRed%getWidth(ichan).NE.Zero) THEN
eres = resonance%getEres()
Q = dSQRT ( dABS ( eres-Echan(M2,Igrp) ) )
Rho = Zkte(M2,Igrp)*Q
- Lsp = Lspin(M2,Igrp)
+ call resParData%getChannel(channel, channelInfo)
+ Lsp = channel%getL()
C
IF (Zeta(M2,Igrp).EQ.Zero) THEN
P = Pf (Rho, Lsp)
@@ -642,10 +682,10 @@ C
& Sinphi, Cosphi, Dphi)
END IF
C
- width = resonanceRed%getWidth(m2+1)
+ width = resonanceRed%getWidth(ichan)
G1 = Twotho*P*width**2
IF (width.LT.Zero) g1 = -g1
- call resonance%setWidth(m2+1, G1)
+ call resonance%setWidth(ichan, G1)
END IF
END DO
END IF
@@ -661,7 +701,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Cnvext (Ntot, Parext, Iflext, Tempy, Ipar)
+ SUBROUTINE Cnvext (Parext, Iflext, Tempy, Ipar)
C
C *** PURPOSE --CONVERT FROM NEW U-PARAMETERS TO PHYSICAL
C *** R-EXTERNAL PARAMETERS
@@ -671,19 +711,23 @@ C
use fixedr_m
use broad_common_m
use EndfData_common_m
+ use SammyResonanceInfo_M
+ use RMatResonanceParam_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
- DIMENSION Ntot(*), Parext(Nrext,Ntotc,*),
+ type(SammySpinGroupInfo)::spinInfo
+ DIMENSION Parext(Nrext,Ntotc,*),
* Iflext(Nrext,Ntotc,*), Tempy(*)
C
-C DIMENSION Ntot(Ngroup), Parext(Nrext,Ntotc,Ngroup),
+C DIMENSION Parext(Nrext,Ntotc,Ngroup),
C * Iflext(Nrext,Ntotc,Ngroup), Tempy(Nvpall)
C
DATA One /1.0d0/, Two /2.0d0/
C
C
DO Igrp=1,resParData%getNumSpinGroups()
- Ntotn = Ntot(Igrp)
+ call resparData%getSpinGroupInfo(spinInfo, Igrp)
+ Ntotn = spinInfo%getNumChannels()
DO I=1,Ntotn
IF (Iflext(1,I,Igrp).GE.0) THEN
DO J=1,Nrext
@@ -960,6 +1004,8 @@ C
Parmsc(I) = val
Tempy(Ipar) = One
DO J=1,resParData%getNumSpinGroups()
+ call resParData%getSpinGroupInfo(spinInfo, J)
+ iwGam = spinInfo%getGammaWidthIndex()
IF (Iradms(J).EQ.I) THEN
JGR = J
Ugga = 2.0d+3 * val**2
@@ -977,8 +1023,8 @@ C
* resInfo)
call resParData%getRedResonance(resonanceRed,
* resInfo)
- call resonance%setWidth(1,Ugga)
- call resonanceRed%setWidth(1,Uu)
+ call resonance%setWidth(iwGam,Ugga)
+ call resonanceRed%setWidth(iwGam,Uu)
END IF
END DO
GO TO 40
@@ -1155,16 +1201,19 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Updrad (Ntot, Igrrad, Pareff, Partru, Zke, Zkte, Zkfe,
+ SUBROUTINE Updrad (Igrrad, Pareff, Partru, Zke, Zkte, Zkfe,
* If_Zkte, If_Zkfe)
C
use fixedi_m
use ifwrit_m
use fixedr_m
use EndfData_common_m
+ use SammyRMatrixParameters_M
+ use SammySpinGroupInfo_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
- DIMENSION Ntot(*), Igrrad(Ntotc,*), Pareff(*), Partru(*),
+ type(SammySpinGroupInfo)::spinInfo
+ DIMENSION Igrrad(Ntotc,*), Pareff(*), Partru(*),
* Zkte(Ntotc,Ngroup), Zkfe(Ntotc,Ngroup), Zke(Ntotc,Ngroup),
* If_Zkte(Ntotc,Ngroup), If_Zkfe(Ntotc,Ngroup)
C
@@ -1176,7 +1225,8 @@ c *** with iso
C
C *** here Nvpiso.gt.0 and Nvprad.gt.0
DO N=1,resParData%getNumSpinGroups()
- Ntotnn = Ntot(N)
+ call resParData%getSpinGroupInfo(spinInfo, N)
+ Ntotnn = spinInfo%getNumChannels()
DO I=1,Ntotnn
Ig = Igrrad(I,N)
IF (If_Zkte(I,N).NE.0) Zkte(I,N) = Zke(I,N)*Partru(Ig)
@@ -1192,7 +1242,8 @@ C
C *** Here only Crfn is varied
At = Crfn
DO N=1,resParData%getNumSpinGroups()
- Ntotnn = Ntot(N)
+ call resParData%getSpinGroupInfo(spinInfo, N)
+ Ntotnn = spinInfo%getNumChannels()
DO I=1,Ntotnn
Zkte(I,N) = Zke(I,N)*At
Zkfe(I,N) = Zke(I,N)*At
@@ -1206,7 +1257,8 @@ C ELSE IF (Nvpiso.EQ.0) THEN
IF (Nvprad.GT.0) THEN
C *** here Numiso.EQ.0 but Nvprad.GT.0
DO N=1,resParData%getNumSpinGroups()
- Ntotnn = Ntot(N)
+ call resParData%getSpinGroupInfo(spinInfo, N)
+ Ntotnn = spinInfo%getNumChannels()
DO I=1,Ntotnn
Ig = Igrrad(I,N)
IF (If_Zkte(I,N).NE.0) Zkte(I,N) = Zke(I,N)*Partru(Ig)
@@ -1222,7 +1274,8 @@ C
C *** Here only Crfn is varied
At = Crfn
DO N=1,resParData%getNumSpinGroups()
- Ntotnn = Ntot(N)
+ call resParData%getSpinGroupInfo(spinInfo, N)
+ Ntotnn =spinInfo%getNumChannels()
DO I=1,Ntotnn
Zkte(I,N) = Zke(I,N)*At
Zkfe(I,N) = Zke(I,N)*At
diff --git a/sammy/src/fin/mfin3.f b/sammy/src/fin/mfin3.f
index c2ff9cf34315e9d22e449e55eebcde9ac1e0acfd..352b4f59f4df94e7be3cefb5be55d4a3322212cf 100644
--- a/sammy/src/fin/mfin3.f
+++ b/sammy/src/fin/mfin3.f
@@ -3,9 +3,7 @@ C
C --------------------------------------------------------------
C
SUBROUTINE Oldord (Parbrd, Iflbrd, Delbrd,
- * Nent, Next, Ntot,
- * Ishift, Lpent, If_Excl, Lspin, Chspin, Enbnd, Kppair,
- * Ixclud,
+ * If_Excl,
* Pareff, Ifleff, Deleff, Partru, Ifltru, Deltru, Igrrad,
* Ifliso, Deliso,
* Pardet, Ifldet, Deldet, Igrdet, Parext, Iflext,
@@ -36,9 +34,7 @@ C
type(SammyRMatrixParameters)::relevantData
DIMENSION Parbrd(*), Iflbrd(*), Delbrd(*),
- * Nent(*), Next(*), Ntot(*), Ishift(Ntotc,*), Lpent (Ntotc,*),
- * If_Excl(Ntotc,*), Lspin (Ntotc,*), Chspin(Ntotc,*),
- * Enbnd (Ntotc,*), Kppair(Ntotc,*), Ixclud(*),
+ * If_Excl(Ntotc,*),
* Pareff(*), Ifleff(*), Deleff(*),
* Partru(*), Ifltru(*), Deltru(*), Igrrad(Ntotc,*),
* Ifliso(*), Deliso(*),
@@ -88,13 +84,11 @@ C
C
IF (Kquant.EQ.1 .OR. Kquanx.GT.0) THEN
CALL Wr_Pp_Key_Word ()
- CALL Wr_Spin_Group (Nent, Next, Ntot,
- * If_Excl, Lspin, Chspin, Enbnd, Ixclud, Kppair)
+ CALL Wr_Spin_Group (If_Excl)
END IF
C
IF (resParData%getNumResonances().GT.0) THEN
- CALL Ordres (Ntot, Lspin,
- * Iflpol, Ddcov,
+ CALL Ordres (Iflpol, Ddcov,
* Uncxxx, Ratio, If_Pub,
* relevantData, resetFitFlags)
ELSE
@@ -111,7 +105,7 @@ C
C
IF (Numext.NE.0) CALL Ordext (Parext, Iflext)
C
- IF (Numrad.NE.0) CALL Ordrad (Ntot, Pareff, Ifleff, Deleff,
+ IF (Numrad.NE.0) CALL Ordrad (Pareff, Ifleff, Deleff,
* Partru, Ifltru, Deltru, Igrrad)
C
IF (Numiso.NE.0 .AND. Kipiso.EQ.1) CALL Ordiso (Ifliso,
@@ -220,8 +214,7 @@ C
C
C ----------------------------------------------------------------
C
- SUBROUTINE Ordres ( Ntot, Lspin,
- * Iflpol, Ddcov,
+ SUBROUTINE Ordres ( Iflpol, Ddcov,
* Uncxxx, Ratio,
* If_Pub, relevantData, resetFitFlags)
C
@@ -239,6 +232,8 @@ C
CHARACTER*6 Ww, Uu
type(SammySpinGroupInfo)::spinInfo
type(RMatSpinGroup)::spinGroup
+ type(SammyChannelInfo)::channelInfo
+ type(RMatChannelParams)::channel
type(SammyResonanceInfo)::resInfo,resRelInfo
type(RMatResonance)::resonance, resonanceRel, resonanceRed
logical::resetFitFlags
@@ -247,8 +242,7 @@ C
type(SammyRMatrixParameters)::relevantData
type(ResonanceCovariance)::physCov
integer,allocatable::ifits(:)
- DIMENSION Ntot(*), Lspin(Ntotc,*),
- * Iflpol(2,*),
+ DIMENSION Iflpol(2,*),
* Ddcov(*), Uncxxx(Ntotc2,*), Ratio(*)
C
C
@@ -284,7 +278,8 @@ C insteat of number of varied parameter
END IF
Ig = resInfo%getSpinGroupIndex()
- N2 = Ntot(Ig) + 2
+ call resParData%getSpinGroupInfo(spinInfo, Ig)
+ N2 = spinInfo%getNumChannels() + 2
if( allocated(ifits).and.size(ifits).lt.2*N2) then
deallocate(ifits)
@@ -344,9 +339,9 @@ C insteat of number of varied parameter
if (ig.lt.0) ig = -1 * ig
-
CALL Reswrt (resonance%getEres(), resonance, Ifits(1:N2),
- * IgroupW, Ddcov(N), Ntot(Ig), Kdecpl, Kenunc, Kkkgrp, 38)
+ * IgroupW, Ddcov(N), spinInfo%getNumChannels(),
+ * Kdecpl, Kenunc, Kkkgrp, 38)
C repeat for reduced resonance parameters
call resParData%getRedResonance(resonanceRed, resInfo)
PSQR = resonanceRed%getEres()
@@ -354,9 +349,9 @@ C repeat for reduced resonance parameters
PSQR = dSQRT(resonanceRed%getEres())
ELSE
PSQR = -dSQRT(-resonanceRed%getEres())
- END IF
+ END IF
CALL Reswrt (PSQR, resonanceRed, Ifits,
- * IgroupW, Ddcov(N), Ntot(Ig), Kdecpl,
+ * IgroupW, Ddcov(N), spinInfo%getNumChannels(), Kdecpl,
* Kenunc, Kkkgrp, 36)
IF (Ifrel.EQ.1) then
@@ -366,20 +361,23 @@ C repeat for reduced resonance parameters
call relevantData%getResonanceInfoByInput(resRelInfo, Nn, N)
call relevantData%getResonance(resonanceRel, resRelInfo)
CALL Reswrt (resonanceRel%getEres(),resonanceRel,
- * Ifits(N2+1:2*N2),
- * IgroupW, Ddcov(N), Ntot(Ig), Kdecpl, Kenunc,
+ * Ifits(N2+1:2*N2), IgroupW, Ddcov(N),
+ * spinInfo%getNumChannels(), Kdecpl, Kenunc,
* Kkkgrp, 40)
end if
-C write Fiele 37 data
+C write File 37 data
IF (Ifk.GT.0) THEN
call resParData%getSpinGroupInfo(spinInfo, Ig)
- call resParData%getSpinGroup(spinGroup, spinInfo)
+ call resParData%getSpinGroup(spinGroup, spinInfo)
+ iela = spinInfo%getElasticChannel()
+ call spinInfo%getChannelInfo(channelInfo, iela)
+ call resParData%getChannel(channel, channelInfo)
Write (37,10300) spinGroup%getJ(),
- * Tab, Lspin(1,Ig), Tab, resonance%getEres(),
+ * Tab, channel%getL(), Tab, resonance%getEres(),
* Tab, Uncxxx(1,N), Tab, resonance%getWidth(1),
* Tab, Uncxxx(2,N), (Tab, resonance%getWidth(1+1),
- * Tab, Uncxxx(I+2,N), I=1,Ntot(Ig))
+ * Tab, Uncxxx(I+2,N), I=1,spinInfo%getNumChannels())
10300 FORMAT (F4.1, A1, I1, A1, 1PG20.12, A1, G20.12,
* ( 20 (A1, G14.6) ) )
end if
@@ -707,10 +705,22 @@ C
WRITE(36,10200) pair%getZa(1),pair%getZa(2),pair%getPnt(),icalc
10200 FORMAT (5X, 'Za=', I2, 8X, 'Zb=',I2, 9X, 'Pent=', I1,
* 5X, 'Shift=',I1)
+ Em1 = pair%getMass(1)
+ Em2 = pair%getMass(2)
+C
+C Since the masses in the pair were fixed in
+C Fxradi in mold1.f to get the correct reduced mass
+C we reset the values printed in the parameter files
+C for fission reactions (indicated by pair%getPnt() == 0
+C
+ if ( pair%getPnt().eq.0) then
+ Em1 = 0.0d0
+ Em2 = 0.0d0
+ end if
WRITE (38,10300) pair%getIa(1), pair%getIa(2),
- * pair%getMass(1), pair%getMass(2)
+ * Em1, Em2
WRITE (36,10300) pair%getIa(1), pair%getIa(2),
- * pair%getMass(1), pair%getMass(2)
+ * Em1, Em2
10300 FORMAT (5X, 'Sa=', F5.1, 5X, 'Sb=', F6.1, 5x, 'Ma=', F15.8,
* 5X, 'Mb=', F15.8)
IF (pair%getQ().NE.Zero) THEN
@@ -728,8 +738,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Wr_Spin_Group (Nent, Next, Ntot,
- * If_Excl, Lspin, Chspin, Enbnd, Ixclud, Kppair)
+ SUBROUTINE Wr_Spin_Group (If_Excl)
use fixedi_m
use ifwrit_m
use constn_common_m
@@ -739,12 +748,12 @@ C
use RMatResonanceParam_M
use SammyParticlePairInfo_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
- DIMENSION Nent(*), Next(*), Ntot(*),
- * If_Excl(Ntotc,*), Lspin (Ntotc,*), Chspin(Ntotc,*),
- * Enbnd (Ntotc,*), Kppair(Ntotc,*), Ixclud(*)
+ DIMENSION If_Excl(Ntotc,*)
CHARACTER*3 Qif, Qif1, Qifx, Qbbb
type(SammySpinGroupInfo)::spinInfo
type(SammyParticlePairInfo)::pairInfo
+ type(SammyChannelInfo)::channelInfo
+ type(RMatChannelParams)::channel
type(RMatSpinGroup)::spinGroup
character(len=8)::pname
DATA Qif1 /' 1'/, Qifx /' X'/, Qbbb /' '/
@@ -766,26 +775,31 @@ C
call resParData%getSpinGroup(spinGroup, spinInfo)
spinjVal = spinGroup%getJ()
abnVal = spinInfo%getAbundance()
- IF (Ixclud(Igr).EQ.0) THEN
+ nent = spinInfo%getNumEntryChannels()
+ next = spinInfo%getNumExitChannels()
+ IF (spinInfo%getIncludeInCalc()) THEN
IF (Iabn.EQ.1) THEN
- WRITE (38,10100) Igr, Nent(Igr), Next(Igr),
+ WRITE (38,10100) Igr, Nent, Next,
* SpinjVal, AbnVal
- WRITE (36,10100) Igr, Nent(Igr), Next(Igr),
+ WRITE (36,10100) Igr, Nent, Next,
* SpinjVal, AbnVal
ELSE IF (Iabn.EQ.0) THEN
- WRITE (38,10100) Igr, Nent(Igr), Next(Igr), SpinjVal
- WRITE (36,10100) Igr, Nent(Igr), Next(Igr), SpinjVal
+ WRITE (38,10100) Igr, Nent, Next, SpinjVal
+ WRITE (36,10100) Igr, Nent, Next, SpinjVal
END IF
10100 FORMAT (I3, 4X, I3, 2X, I3, F5.1, F10.7)
ELSE
- WRITE (38,10200) Igr, Nent(Igr), Next(Igr),
+ WRITE (38,10200) Igr, Nent, Next,
* SpinjVal, AbnVal
- WRITE (36,10200) Igr, Nent(Igr), Next(Igr),
+ WRITE (36,10200) Igr, Nent, Next,
* SpinjVal, AbnVal
10200 FORMAT (I3, 1X, 'X', 2X, I3, 2X, I3, F5.1, F10.7)
END IF
- Ntotg = Ntot(Igr)
+ Ntotg = spinInfo%getNumChannels()
DO N=1,Ntotg
+ call spinInfo%getChannelInfo(channelInfo, N)
+ call resParData%getChannel(channel, channelInfo)
+
Qif = Qbbb
C
C Added 1/24/17 to maintain SAMMY convention of using
@@ -794,7 +808,8 @@ C physical meaning and it is not allowed by ENDF, but
C simply to maintain SAMMY convention for the time being.
C
C Chspns = Chspin(N,Igr) with sign restored to correct parity
- Chspns = SIGN(Chspin(N,Igr),((-1)**Lspin(N,Igr))*SpinjVal)
+ Chspns = SIGN(channel%getSch(),
+ * ((-1)**channel%getL())*SpinjVal)
IF (If_Excl(N,Igr).EQ.1) THEN
Qif = Qif1
@@ -802,19 +817,20 @@ C Chspns = Chspin(N,Igr) with sign restored to correct parity
Qif = Qifx
END IF
- call resParData%getParticlePairInfo(pairInfo,Kppair(n,Igr))
+ call resParData%getParticlePairInfo(pairInfo,
+ * channelInfo%getParticlePairIndex())
call pairInfo%getName(pname)
- IF (Enbnd(N,Igr).NE.Zero) THEN
+ IF (channel%getBnd().NE.Zero) THEN
WRITE (38,10300) N, pname, Qif,
- * Lspin(N,Igr), Chspns, Enbnd(N,Igr)
+ * channel%getL(), Chspns, channel%getBnd()
WRITE (36,10300) N, pname, Qif,
- * Lspin(N,Igr), Chspns, Enbnd(N,Igr)
+ * channel%getL(), Chspns, channel%getBnd()
10300 FORMAT (3X, I2, 2X, A8, A3, I2, F5.1, 5X, F10.3)
ELSE
WRITE (38,10300) N, pname, Qif,
- * Lspin(N,Igr), Chspns
+ * channel%getL(), Chspns
WRITE (36,10300) N, pname, Qif,
- * Lspin(N,Igr), Chspns
+ * channel%getL(), Chspns
END IF
END DO
END DO
diff --git a/sammy/src/fin/mfin4.f b/sammy/src/fin/mfin4.f
index 15efd033b10105f124c5d67619d1b0b3ef1870cd..a62fc7156d6bf4ce63eb16a44421783d95f6e24b 100644
--- a/sammy/src/fin/mfin4.f
+++ b/sammy/src/fin/mfin4.f
@@ -57,7 +57,6 @@ C
IF (Kredwa.EQ.0) THEN
C write partial width data (indicated by last .false. in the argument list)
CALL Outpar ( Iftit, Nunit , A_Iprbrd , I_Iflbrd ,
- * A_Igoj , I_Intot , I_Ilspin , A_Ichspi ,
* A_Ipreff , I_Ifleff , A_Iprtru , I_Ifltru , I_Iigrra ,
* I_Ifliso , A_Iprdet , I_Ifldet , I_Iigrde ,
* A_Iprext , I_Iflext ,
@@ -71,12 +70,11 @@ C write partial width data (indicated by last .false. in the argument list)
* A_Izkte , A_Izkfe , I_Ifzke , I_Ifzkte , I_Ifzkfe , A(Idum3 ),
* A_Iavga , A_Iavgb , A_Iva , A_Ivb , A_Ixa ,
* A_Ixb , A_Iallkk , A_Iallkx , A_Ixx , A_Ixxstd ,
- * A_Ikkxxx , A_Ikij , A_Ik1 , I_Ikppai , Iffff ,
+ * A_Ikkxxx , A_Ikij , A_Ik1 , Iffff ,
* .false.)
ELSE
C write reduced width data (indicated by last .true. in the argument list)
CALL Outpar ( Iftit, Nunit , A_Iprbrd , I_Iflbrd ,
- * A_Igoj , I_Intot , I_Ilspin , A_Ichspi ,
* A_Ipreff , I_Ifleff , A_Iprtru , I_Ifltru , I_Iigrra ,
* I_Ifliso , A_Iprdet , I_Ifldet , I_Iigrde ,
* A_Iprext , I_Iflext ,
@@ -90,7 +88,7 @@ C write reduced width data (indicated by last .true. in the argument list)
* A_Izkte , A_Izkfe , I_Ifzke , I_Ifzkte , I_Ifzkfe , A(Idum3 ),
* A_Iavga , A_Iavgb , A_Iva , A_Ivb , A_Ixa ,
* A_Ixb , A_Iallkk , A_Iallkx , A_Ixx , A_Ixxstd ,
- * A_Ikkxxx , A_Ikij , A_Ik1 , I_Ikppai , Iffff ,
+ * A_Ikkxxx , A_Ikij , A_Ik1 , Iffff ,
* .true.)
END IF
IF (Ixxxxx.NE.1) THEN
@@ -114,14 +112,15 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Ordrad (Ntot, Pareff, Ifleff, Deleff, Partru, Ifltru,
+ SUBROUTINE Ordrad (Pareff, Ifleff, Deleff, Partru, Ifltru,
* Deltru, Igrrad)
C *** Write radius parameters, using key-word format
use fixedi_m
use EndfData_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
integer,allocatable, dimension(:)::kchan
- DIMENSION Ntot(*), Igrrad(Ntotc,*), Pareff(*), Ifleff(*),
+ type(SammySpinGroupInfo)::spinInfo
+ DIMENSION Igrrad(Ntotc,*), Pareff(*), Ifleff(*),
* Deleff(*), Partru(*), Ifltru(*), Deltru(*)
DATA Zero /0.0d0/
C
@@ -169,7 +168,8 @@ C
kchan(:) = 0
Ig = 0
Ich = 0
- DO Ichan=1,Ntot(Igr)
+ call resParData%getSpinGroupInfo(spinInfo, Igr)
+ DO Ichan=1,spinInfo%getNumChannels()
IF (Igrrad(Ichan,Igr).EQ.I) THEN
Ig = Igr
Ich = Ich + 1
diff --git a/sammy/src/fin/mfin5.f b/sammy/src/fin/mfin5.f
index f427c2f61ab0d09debe09d8c07db9ef4ee10f32c..2718479b0e870a471112461d68f8fea565aa7a37 100644
--- a/sammy/src/fin/mfin5.f
+++ b/sammy/src/fin/mfin5.f
@@ -580,7 +580,10 @@ C# WRITE (Iu64) 'Gga ', Nres, 0
DO Ires=1,resParData%getNumResonances()
call resParData%getResonanceInfo(resInfo, Ires)
call resParData%getResonance(resonance, resInfo)
- resTmpData(1,ires) = resonance%getWidth(1)
+ igr = resInfo%getSpinGroupIndex()
+ call resParData%getSpinGroupInfo(spinInfo, igr)
+ ichan = spinInfo%getGammaWidthIndex()
+ resTmpData(1,ires) = resonance%getWidth(ichan)
end do
WRITE (Iu64)(resTmpData(1,I),I=1,resParData%getNumResonances())
@@ -589,8 +592,11 @@ C# WRITE (Iu64) 'Gsi ', Nres, Ntotc
DO Ires=1,resParData%getNumResonances()
call resParData%getResonanceInfo(resInfo, Ires)
call resParData%getResonance(resonance, resInfo)
+ igr = resInfo%getSpinGroupIndex()
+ call resParData%getSpinGroupInfo(spinInfo, igr)
do k = 1, ntotc
- resTmpData(k,Ires) = resonance%getWidth(K+1)
+ ichan = spinInfo%getWidthForChannel(k)
+ resTmpData(k,Ires) = resonance%getWidth(ichan)
end do
end do
WRITE (Iu64) ((resTmpData(J,I),J=1,Ntotc),
@@ -614,8 +620,11 @@ C# WRITE (Iu64) 'Betapr', Nres, Ntotc
DO Ires=1,resParData%getNumResonances()
call resParData%getResonanceInfo(resInfo, Ires)
call resParData%getRedResonance(resonance, resInfo)
+ igr = resInfo%getSpinGroupIndex()
+ call resParData%getSpinGroupInfo(spinInfo, igr)
do k = 1, ntotc
- resTmpData(k,Ires) = resonance%getWidth(K+1)
+ ichan = spinInfo%getWidthForChannel(k)
+ resTmpData(k,Ires) = resonance%getWidth(ichan)
end do
end do
WRITE (Iu64) ((resTmpData(J,I),J=1,Ntotc),I=1,
@@ -624,7 +633,10 @@ C# WRITE (Iu64) 'reduced gamma width', Nres, 3
DO Ires=1,resParData%getNumResonances()
call resParData%getResonanceInfo(resInfo, Ires)
call resParData%getRedResonance(resonance, resInfo)
- resTmpData(1,ires) = resonance%getWidth(1)
+ igr = resInfo%getSpinGroupIndex()
+ call resParData%getSpinGroupInfo(spinInfo, igr)
+ ichan = spinInfo%getGammaWidthIndex()
+ resTmpData(1,ires) = resonance%getWidth(ichan)
end do
WRITE (Iu64) ( resTmpData(1,I),
* resTmpData(1,I)*resTmpData(1,I),
@@ -636,11 +648,15 @@ C# WRITE (Iu64) 'reduced gamma width', Nres, 3
DO Ires=1,resParData%getNumResonances()
call resParData%getResonanceInfo(resInfo, Ires)
call resParData%getRedResonance(resonance, resInfo)
+ igr = resInfo%getSpinGroupIndex()
+ call resParData%getSpinGroupInfo(spinInfo, igr)
kl = 0
do k = 1, ntotc
- f1 = resonance%getWidth(K+1)
+ ichan = spinInfo%getWidthForChannel(k)
+ f1 = resonance%getWidth(ichan)
DO L=1,K
- f2 = resonance%getWidth(L+1)
+ ichan = spinInfo%getWidthForChannel(L)
+ f2 = resonance%getWidth(ichan)
KL = KL + 1
resTmpData(KL,Ires) = f1 * f2
END DO
diff --git a/sammy/src/grp/mgrp0.f b/sammy/src/grp/mgrp0.f
index edc54a06ee43ed2c7a77c14d4908e24a9deac8c6..d6816040e5264152f320fae991a2bae06859b161 100644
--- a/sammy/src/grp/mgrp0.f
+++ b/sammy/src/grp/mgrp0.f
@@ -125,8 +125,7 @@ C *** Grpavg calculates group-averaged cross section
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - >
C
IF (Kpasfe.EQ.1) THEN
- CALL Resetgx (I_Intot , I_Ilpent , I_Ilspin , A_Iechan ,
- * A_Izkte , A(Iwdasi), Ndatq)
+ CALL Resetgx (A_Iechan , A_Izkte , A(Iwdasi), Ndatq)
C *** sub Resetgx converts to ENDF-style resonance parameters,
C *** and prints the partial derivatives (sensitivities) into
C *** file SAMSEN.DAT
diff --git a/sammy/src/inp/minp0.f b/sammy/src/inp/minp0.f
index 5b739fbbb6d4ce89847d6b7d347643eaa57fbf6e..c6ab00055141ce171c8df5f910894beeafb8da15 100644
--- a/sammy/src/inp/minp0.f
+++ b/sammy/src/inp/minp0.f
@@ -74,12 +74,9 @@ C
C *** Routine Set_Dimensions sets the dimensions of the various arrays
C
Iq_V00 = Iq_Val
- CALL Inpfil ( A_Iprbrd , I_Iflbrd , A_Igoj ,
- * I_Inent , I_Inext , I_Intot , I_Iishif , I_Ilpent ,
- * I_Ifexcl , I_Ilspin , A_Ichspi , A_Ienbnd , A_Ibound ,
- * A_Iechan , A_Irdeff , A_Irdtru , A_Iemmm1 , A_Iemmm2 ,
- * I_Izzzz1 , I_Izzzz2 , A_Ispnn1 , A_Ispnn2 , I_Ikppai ,
- * I_Ixclud , A_Ispinx , I_Ifcros , A_Iangle , A_Idangl ,
+ CALL Inpfil ( A_Iprbrd , I_Iflbrd ,
+ * I_Ifexcl , A_Ibound , A_Iechan ,
+ * I_Ifcros , A_Iangle , A_Idangl ,
* A_Ibcf , A_Icf2 , A_Iresol ,
* I_Ifliso , A_Ideiso ,
* A_Ispiso , I_Ixciso ,
diff --git a/sammy/src/inp/minp01.f b/sammy/src/inp/minp01.f
index e58596028b2dce74359a818ca110922b8795e99f..fd029a057a6241936f33c95257c284a8772a9d97 100644
--- a/sammy/src/inp/minp01.f
+++ b/sammy/src/inp/minp01.f
@@ -295,30 +295,9 @@ C *** One
IF (Ksindi.NE.0) THEN
call make_A_Isiabn(Ngroup)
END IF
- call make_A_Igoj(Ngroup)
- call make_I_Inent(Ngroup)
- call make_I_Inext(Ngroup)
- call make_I_Intot(Ngroup)
- call make_I_Iishif(Ngroup * Ntotc)
- call make_I_Ilpent(Ngroup * Ntotc)
call make_I_Ifexcl(Ngroup * Ntotc)
- call make_I_Ilspin(Ngroup * Ntotc)
- call make_A_Ichspi(Ngroup * Ntotc)
- call make_A_Ienbnd(Ngroup * Ntotc)
call make_A_Ibound(Ngroup * Ntotc)
call make_A_Iechan(Ngroup * Ntotc)
- call make_A_Irdeff(Ngroup * Ntotc)
- call make_A_Irdtru(Ngroup * Ntotc)
- call make_A_Iemmm1(Ngroup * Ntotc)
- call make_A_Iemmm2(Ngroup * Ntotc)
- call make_I_Izzzz1(Ngroup * Ntotc)
- call make_I_Izzzz2(Ngroup * Ntotc)
- M = Ngroup*Ntotc
- call make_A_Ispnn1(M)
- call make_A_Ispnn2(M)
- call make_I_Ikppai(M)
- call make_I_Ixclud(Ngroup)
- call make_A_Ispinx(Ngroup)
C
C *** three
Ncrsss = Ntotc + 1
diff --git a/sammy/src/inp/minp03.f b/sammy/src/inp/minp03.f
index 4efca8c8ed632647f8f1f95dd0adcc9e6a5a04c5..528c2b61865c2d90f9596da4bd4745a6e2b045df 100644
--- a/sammy/src/inp/minp03.f
+++ b/sammy/src/inp/minp03.f
@@ -3,12 +3,9 @@ C *** THIS FILE CONTAINS ROUTINES FOR READING "INPUT" FILE
C
C --------------------------------------------------------------
C
- SUBROUTINE Inpfil (Parbrd, Iflbrd, Goj ,
- * Nent , Next , Ntot , Ishift, Lpent,
- * If_Excl,Lspin , Chspin, Enbnd , Bound ,
- * Echan , Rdeff , Rdtru , Emmm1 , Emmm2 ,
- * Kzzz1 , Kzzz2 , Spnn1 , Spnn2 , Kppair,
- * Ixclud, Spinx , Ifcros, Angle , Dangle,
+ SUBROUTINE Inpfil (Parbrd, Iflbrd,
+ * If_Excl,Bound , Echan ,
+ * Ifcros, Angle , Dangle,
* Bcf , Cf2 , Eresol,
* Ifliso, Deliso,
* Spniso, Ixciso,
@@ -42,16 +39,8 @@ C
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
C DIMENSION Parbrd(Numbrd), Iflbrd(Numbrd),
-C * Goj(Ngroup), Nent(Ngroup),
-C * Next(Ngroup), Ntot(Ngroup), Ishift(Ntotc,Ngroup),
-C * Lpent(Ntotc,Ngroup), If_Excl(Ntotc,Ngroup),
-C * Lspin(Ntotc,Ngroup),
-C * Chspin(Ntotc,Ngroup), Enbnd(Ntotc,Ngroup),
+C * If_Excl(Ntotc,Ngroup),
C * Bound(Ntotc,Ngroup), Echan(Ntotc,Ngroup),
-C * Rdeff(Ntotc,Ngroup), Rdtru(Ntotc,Ngroup),
-C * Emmm1(Ntotc,Ngroup), Emmm2(Ntotc,Ngroup),
-C * Kppair(Ntotc,Ngroup),
-C * Ixclud(Ngroup), Spinx(Ngroup),
C * Ifcros(Ncrsss), Angle(Nangle), Dangle(Nangle),
C * Bcf(ncf), Cf2(ncf), Eresol(Nresol),
C *Pardet(Numdet), Ifldet(Numdet), Deldet(Numdet), Igrdet(Ngroup),
@@ -59,13 +48,9 @@ C *Parorr(Numorr), Iflorr(Numorr), Delorr(Numorr), Ecrnch(Numorr-11),
C *Endets(Nmdets), Sesese(Nmdets), Eseses(Nmdets), Sigdts(Nmdets),
C *Parrpi(Numrpi), Iflrpi(Numrpi), Delrpi(Numrpi), Ecrnch(Numrpi-?)
C
- DIMENSION Parbrd(*), Iflbrd(*), Goj(*),
- * Nent(*), Next(*), Ntot(*), Ishift(Ntotc,*), Lpent(Ntotc,*),
- * If_Excl(Ntotc,*), Lspin(Ntotc,*), Chspin(Ntotc,*),
- * Enbnd(Ntotc,*), Bound(Ntotc,*), Echan(Ntotc,*), Ixclud(*),
- * Spinx(*), Rdeff(Ntotc,*), Rdtru(Ntotc,*), Emmm1(Ntotc,*),
- * Emmm2(Ntotc,*), Kzzz1(Ntotc,*), Kzzz2(Ntotc,*),
- * Spnn1(Ntotc,*), Spnn2(Ntotc,*), Kppair(Ntotc,*), Ifcros(*),
+ DIMENSION Parbrd(*), Iflbrd(*),
+ * If_Excl(Ntotc,*),
+ * Bound(Ntotc,*), Echan(Ntotc,*), Ifcros(*),
* Angle (*), Dangle(*), Bcf(*), Cf2(*), Eresol(*),
* Ifliso(*), Deliso(*),
* Spniso(*), Ixciso(*),
@@ -208,28 +193,17 @@ C
END IF
END IF
C
-C
-C *** Zero some of the non-standard stuff
- CALL Zernst (If_Excl, Rdeff, Rdtru, Emmm1, Emmm2, Kzzz1, Kzzz2,
- * Ntotc, Ngroup)
-C
C *** Read quantum numbers, other information for spin groups
C
IF (Kquant.EQ.0 .AND. Krdspn.EQ.0) THEN
C *** Card Set 10.1
- CALL Rdspin (Goj, Nent, Next, Ntot, Ishift,
- * Lpent, If_Excl, Lspin, Chspin, Enbnd, Bound, Echan, Rdeff,
- * Rdtru, Emmm1, Emmm2, Kzzz1, Kzzz2, Spnn1, Spnn2, Ixclud,
- * Spinx, Spini, If_9, Kppair)
+ CALL Rdspin (If_Excl, Bound, Echan, Spini, If_9)
ELSE IF (Kquant.EQ.1 .OR.
* (Kquant.EQ.0 .AND. (Krdspn.EQ.2 .OR. Krdspn.EQ.3))) THEN
C *** Card Set 10.2 (particle-pair spin definitions are given)
- CALL Rdspi2 (Goj, Nent, Next, Ntot, Ishift,
- * Lpent, If_Excl, Lspin, Chspin, Enbnd, Bound, Echan, Rdeff,
- * Rdtru, Emmm1, Emmm2, Kzzz1, Kzzz2, Spnn1, Spnn2, Kppair,
- * Ixclud, Spinx, Spini, Ipp_Final, If_9,
- * Ipp_Final_M)
+ CALL Rdspi2 ( If_Excl, Bound, Echan, Spini,
+ * Ipp_Final, If_9,Ipp_Final_M)
END IF
C
C
@@ -239,7 +213,7 @@ C
Iq_Val = 0
END IF
C
- CALL Fissil (Next, Nfissl, Ngroup)
+ CALL Fissil (Nfissl)
C
C
C *** Card Set 11
@@ -261,8 +235,7 @@ C
ELSE IF (Alfnm1.EQ.Endddd) THEN
GO TO 50
ELSE IF (Alfnm1.EQ.Xisoto .OR. Alfnm1.EQ.Xnucli) THEN
- CALL Readis (Goj, Spinx, Ifliso, Deliso,
- * Spniso, Ixclud, Ixciso, Iu22)
+ CALL Readis (Ifliso, Deliso, Spniso, Ixciso, Iu22)
ELSE IF (Alfnm1.EQ.Detect) THEN
CALL Readde (Pardet, Ifldet, Deldet, Igrdet, Iu22)
ELSE IF (Alfnm1.EQ.Broade) THEN
diff --git a/sammy/src/inp/minp06.f b/sammy/src/inp/minp06.f
index 9b4099a109ddabc87ab5a83459efc90af4fa9920..0e9c8fcf3a4de82d79938a033dc3d515aee21012 100644
--- a/sammy/src/inp/minp06.f
+++ b/sammy/src/inp/minp06.f
@@ -405,12 +405,16 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Fissil (Next, Nfissl, Ngroup)
+ SUBROUTINE Fissil (Nfissl)
+ use EndfData_common_m
+ use SammySpinGroupInfo_M
C *** Purpose -- Set Nfissl=0 if non-Fissile, =1 if Fissile
- DIMENSION Next(*)
+ type(SammySpinGroupInfo)::spinInfo
Nfissl = 0
- DO I=1,Ngroup
- IF (Next(I).GT.0) THEN
+ DO I=1,resParData%getNumSpinGroups()
+ call resparData%getSpinGroupInfo(spinInfo, I)
+ next = spinInfo%getNumExitChannels()
+ IF (Next.GT.0) THEN
Nfissl = 1
RETURN
END IF
diff --git a/sammy/src/inp/minp10.f b/sammy/src/inp/minp10.f
index 1db8f4830d509c83a4a49b3fb373c258d1821cd6..7a828d7a24eafde12d0fb8fa4fa74f96af533c89 100644
--- a/sammy/src/inp/minp10.f
+++ b/sammy/src/inp/minp10.f
@@ -411,22 +411,4 @@ C *** Read angles for differential cross section (elastic or reaction)
C
C
RETURN
- END
-C
-C
-C --------------------------------------------------------------
-C
- SUBROUTINE Zernst (If_Excl, Rdeff, Rdtru, Emmm1, Emmm2,
- * Kzzz1, Kzzz2, Ntotc, Ngroup)
- IMPLICIT DOUBLE PRECISION (a-h,o-z)
- DIMENSION If_Excl(Ntotc,*), Rdeff(Ntotc,*), Rdtru(Ntotc,*),
- * Emmm1(Ntotc,*), Emmm2(Ntotc,*), Kzzz1(Ntotc,*), Kzzz2(Ntotc,*)
- CALL Zero_Array (Rdeff, Ngroup*Ntotc)
- CALL Zero_Array (Rdtru, Ngroup*Ntotc)
- CALL Zero_Array (Emmm1, Ngroup*Ntotc)
- CALL Zero_Array (Emmm2, Ngroup*Ntotc)
- CALL Zero_Integer (Kzzz1, Ngroup*Ntotc)
- CALL Zero_Integer (Kzzz2, Ngroup*Ntotc)
- CALL Zero_Integer (If_Excl, Ngroup*Ntotc)
- RETURN
- END
+ END
\ No newline at end of file
diff --git a/sammy/src/inp/minp11.f b/sammy/src/inp/minp11.f
index 14f118dab0ef94a585b8036e66e9386da6d34438..08b02e621bd3309259c5847f715dcb9b5fb6110f 100644
--- a/sammy/src/inp/minp11.f
+++ b/sammy/src/inp/minp11.f
@@ -2,10 +2,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Rdspin ( Goj, Nent, Next, Ntot, Ishift,
- * Lpent, If_Excl, Lspin, Chspin, Enbnd, Bound, Echan, Rdeff,
- * Rdtru, Emmm1, Emmm2, Kzzz1, Kzzz2, Spnn1, Spnn2, Ixclud, Spinx,
- * Spinii, If_9, Kppair)
+ SUBROUTINE Rdspin (If_Excl, Bound, Echan, Spinii, If_9)
C
C *** PURPOSE -- Read resonance quantum numbers and other information,
C *** using "NEW SPIN FORMAT" (which is now old!)
@@ -28,16 +25,8 @@ C
integer::If_9
REAL(KIND=8)::Spinii
- REAL(KIND=8)::
- * Goj(*), Chspin(Ntotc,*), Enbnd(Ntotc,*),
- * Bound(Ntotc,*), Echan(Ntotc,*), Spinx(*),
- * Rdeff(Ntotc,*), Rdtru(Ntotc,*), Emmm1(Ntotc,*), Emmm2(Ntotc,*),
- * Spnn1(Ntotc,*), Spnn2(Ntotc,*)
- INTEGER::
- * Nent(*), Next(*), Kppair(Ntotc,*),
- * Ntot(*), Ishift(Ntotc,*), Lpent(Ntotc,*), If_Excl(Ntotc,*),
- * Lspin(Ntotc,*), Ixclud(*),
- * Kzzz1(Ntotc,*), Kzzz2(Ntotc,*)
+ REAL(KIND=8):: Bound(Ntotc,*), Echan(Ntotc,*)
+ INTEGER::If_Excl(Ntotc,*)
C
type(SammyRMatrixParameters)::reorgResPar
@@ -100,17 +89,9 @@ C *** Now read Card Set 10.1
DO Ig=1,resparData%getNumSpinGroups()
call resparData%getSpinGroupInfo(spinInfo, Ig)
- if (spinInfo%getIncludeInCalc()) then
- Ixclud(Ig) = 0
- else
- Ixclud(Ig) = 1
+ IF (spinInfo%getTargetSpin().NE.0.0d0) then
+ Ifspin = 1
end if
- nent(Ig) = spinInfo%getNumEntryChannels()
- next(Ig) = spinInfo%getNumExitChannels()
- Ntot(Ig) = Nent(Ig) + Next(Ig)
-
- Spinx(Ig) = spinInfo%getTargetSpin()
- IF (Spinx(Ig).NE.0.0d0) Ifspin = 1
Alabcm = 0.0
DO N=1,spinInfo%getNumChannels()
@@ -120,18 +101,6 @@ C *** Now read Card Set 10.1
* channelInfo%getParticlePairIndex())
call resParData%getParticlePair(pair, pairInfo)
call resParData%getChannel(channel, channelInfo)
-
- Kppair(N,Ig) = channelInfo%getParticlePairIndex()
-
- Lpent (N,Ig) = pair%getPnt()
- Kzzz1 (N,Ig) = pair%getZa(2)
- Kzzz2 (N,Ig) = pair%getZa(1)
-
- if (pair%getCalcShift()) then
- Ishift(N,Ig) = 1
- else
- Ishift(N,Ig) = 0
- end if
if (channelInfo%getIncludeInCalc()) then
If_Excl(N,Ig) = 0
@@ -139,16 +108,6 @@ C *** Now read Card Set 10.1
If_Excl(N,Ig) = 1
end if
- Lspin (N,Ig) = channel%getL()
- Chspin(N,Ig) = channel%getSch()
- Enbnd (N,Ig) = channel%getBnd()
-
- Rdeff(N,Ig) = channel%getApe()
- Rdtru(N,Ig) = channel%getApt()
-
- Emmm1 (N,Ig) = pair%getMass(2)
- Emmm2 (N,Ig) = pair%getMass(1)
-
! get the reduced mass ratio from the first channel.
! It is assumed to be the first channel.
! The user supplied value is echan(n,ig)
@@ -164,7 +123,8 @@ C *** Now read Card Set 10.1
if (kz.ne.0.and.Kcolab.EQ.1) CoulombExcitationFlag = .true.
IF (N.EQ.1) THEN
- Alabcm = -(Emmm1(N,Ig)+Emmm2(N,Ig))/Emmm1(N,Ig)
+ Alabcm = -(pair%getMass(2)+pair%getMass(1))/
+ * pair%getMass(2)
END IF
if ( pair%getQ().ne.0.0) then
@@ -176,16 +136,11 @@ C *** Now read Card Set 10.1
else
Echan (N,Ig) = 0.0d0
end if
-
- Spnn1(N,Ig) = pair%getIa(2)
- Spnn2(N,Ig) = pair%getIa(1)
- end do
-
+ end do
+
do N = spinInfo%getNumChannels() + 1, Ntotc
Bound(N,Ig) = 0.0d0
- Enbnd(N,Ig) = 0.0d0
- Lspin(N,Ig) = 0
- Lpent(N,Ig) = 0
+ If_Excl(N,Ig) = 0
END DO
end do
@@ -227,7 +182,8 @@ C
call resParData%getChannel(channel, channelInfo)
IF (N.EQ.1) THEN
- Alabcm = -(Emmm1(N,Ig)+Emmm2(N,Ig))/Emmm1(N,Ig)
+ Alabcm = -(pair%getMass(2)+pair%getMass(1))/
+ * pair%getMass(2)
END IF
if ( pair%getQ().eq.0.0) cycle
@@ -260,7 +216,7 @@ C
Spinii = spinInfo%getTargetSpin()
END IF
- CALL Organize_Bound_Etc (Goj, Bound)
+ CALL Organize_Bound_Etc (Bound)
debug = .false.
diff --git a/sammy/src/inp/minp15.f b/sammy/src/inp/minp15.f
index ebfd01dd9e49c91e36b5da9045e2e16aaa1786c5..5761639c5dc5bf0bf91cddebd2126b289fb2e530 100644
--- a/sammy/src/inp/minp15.f
+++ b/sammy/src/inp/minp15.f
@@ -2,11 +2,8 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Rdspi2 (Goj, Nent, Next, Ntot, Ishift,
- * Lpent, If_Excl, Lspin, Chspin, Enbnd, Bound, Echan, Rdeff,
- * Rdtru, Emmm1, Emmm2, Kzzz1, Kzzz2, Spnn1, Spnn2, Kppair,
- * Ixclud, Spinx, Spinii, Ipp_Final, If_9,
- * Ipp_Final_M)
+ SUBROUTINE Rdspi2(If_Excl, Bound, Echan,
+ * Spinii, Ipp_Final, If_9, Ipp_Final_M)
C
C *** PURPOSE -- Read resonance quantum numbers and other information,
C *** using Card Set 10.2, particle-pair definitions
@@ -28,32 +25,15 @@ C
use, intrinsic :: ISO_C_BINDING
Implicit none
C
-C DIMENSION Goj(Ngroup),
-C * Nent(Ngroup), Next(Ngroup), Ntot(Ngroup),
-C * Ishift(Ntotc,Ngroup), Lpent(Ntotc,Ngroup),
+C DIMENSION
C * If_Excl(Ntotc,Ngroup),
-C * Lspin(Ntotc,Ngroup), Chspin(Ntotc,Ngroup),
-C * Enbnd(Ntotc,Ngroup), Bound(Ntotc,Ngroup),
-C * Echan(Ntotc,Ngroup), Ixclud(Ngroup), Spinx(Ngroup),
-C * Rdeff(Ntotc,Ngroup), Rdtru(Ntotc,Ngroup),
-C * Emmm1(Ntotc,Ngroup), Emmm2(Ntotc,Ngroup),
-C * Kzzz1(Ntotc,Ngroup), Kzzz2(Ntotc,Ngroup)
+C * Bound(Ntotc,Ngroup),
+C * Echan(Ntotc,Ngroup)
C
real(kind=8)::Spinii
integer::If_9, Ipp_Final_M
- REAL(KIND=8)::
- * Goj(*), Chspin(Ntotc,*), Enbnd(Ntotc,*),
- * Bound(Ntotc,*), Echan(Ntotc,*), Spinx(*),
- * Rdeff(Ntotc,*), Rdtru(Ntotc,*),
- * Emmm1(Ntotc,*), Emmm2(Ntotc,*),
- * Spnn1(Ntotc,*), Spnn2(Ntotc,*)
- Integer::
- * Nent(*), Next(*),
- * Ntot(*), Ishift(Ntotc,*),
- * Lpent(Ntotc,*), If_Excl(Ntotc,*),
- * Lspin(Ntotc,*), Ixclud(*),
- * Kzzz1(Ntotc,*), Kzzz2(Ntotc,*),
- * Kppair(Ntotc,*),Ipp_Final(*)
+ REAL(KIND=8):: Bound(Ntotc,*), Echan(Ntotc,*)
+ Integer::If_Excl(Ntotc,*), Ipp_Final(*)
C
type(SammyRMatrixParameters)::reorgResPar
type(SammySpinGroupInfo)::spinInfo
@@ -68,7 +48,7 @@ C
character(len=100)::line
integer::ierr, Ipp, Iux, j, N, nx, num, ll
- integer::Ifspin, Kpound
+ integer::Ifspin, Kpound, lspin, iela
real(kind=8)::Alabcm
C
Iux = Iu22
@@ -136,18 +116,8 @@ C set relevant data
C
DO J=1,resParData%getNumSpinGroups()
call resParData%getSpinGroupInfo(spinInfo, J)
+ iela = spinInfo%getElasticChannel()
- if (spinInfo%getIncludeInCalc()) then
- Ixclud(J) = 0
- else
- Ixclud(J) = 1
- end if
- nent(j) = spinInfo%getNumEntryChannels()
- next(j) = spinInfo%getNumExitChannels()
- Spinx(j) = spinInfo%getTargetSpin()
-
- Ntot(J) = Nent(J) + Next(J)
-
DO N=1,spinInfo%getNumChannels()
call spinInfo%getChannelInfo(channelInfo, N)
call resParData%getParticlePairInfo(
@@ -155,7 +125,12 @@ C
* channelInfo%getParticlePairIndex())
call resParData%getParticlePair(pair, pairInfo)
call resParData%getChannel(channel, channelInfo)
-
+
+ ! get the target spin from the elastic channel in the first spin group
+ if (j.eq.1.and.n.eq.iela) then
+ Spninc = pair%getIa(1)
+ end if
+
IF (Ipp_Final_M.EQ.0) THEN ! no particle pairs contribute to final state (see function Final_States )
if ( channelInfo%getExcludeCompletely()) then
If_Excl(N,J) = -1
@@ -183,43 +158,23 @@ C
END IF
- Kzzz1 (N,J) = pair%getZa(2)
- Kzzz2 (N,J) = pair%getZa(1)
- Lpent (N,j) = pair%getPnt()
- if (pair%getCalcShift()) then
- Ishift(N,J) = 1
- else
- Ishift(N,J) = 0
- end if
- Spnn1 (N,J) = pair%getIa(2)
- Spnn2 (N,J) = pair%getIa(1)
- Emmm1 (N,J) = pair%getMass(2)
- Emmm2 (N,J) = pair%getMass(1)
-
- Chspin(N,J) = channel%getSch()
- Lspin (N,J) = channel%getL()
- Enbnd (N,J) = channel%getBnd()
-
- Rdeff(N,J) = channel%getApe()
- Rdtru(N,J) = channel%getApt()
-
IF (N.EQ.1) THEN
- Alabcm = - (Emmm1(N,J)+Emmm2(N,J))/Emmm1(N,J)
+ Alabcm = - (pair%getMass(2)+pair%getMass(1))/
+ * pair%getMass(2)
END IF
Echan (N,J) = pair%getQ() * Alabcm
- Kppair(N,J) = channelInfo%getParticlePairIndex()
-
- IF (Ishift(N,J).NE.0 .AND. Lspin(N,J).NE.0) THEN
- IF (Enbnd(N,J).EQ.0.0d0) Enbnd(N,J) = - Lspin(N,J)
+ lspin = channel%getL()
+ IF (pair%getCalcShift() .AND. Lspin.NE.0) THEN
+ IF (channel%getBnd().EQ.0.0d0) then
+ call channel%setBnd(-1.0d0*Lspin)
+ end if
END IF
END DO
do n = spinInfo%getNumChannels() + 1, Ntotc
Bound(N,j) = 0.0d0
- Enbnd(N,j) = 0.0d0
- Lspin(N,j) = 0
- Lpent(N,j) = 0
+ If_Excl(N,J) = 0
END DO
Nx = 0
@@ -238,8 +193,7 @@ C
END DO
- Spninc = Spnn2(1,1)
- CALL Organize_Bound_Etc (Goj, Bound)
+ CALL Organize_Bound_Etc (Bound)
debug = .false.
@@ -309,7 +263,7 @@ C
type(SammyParticlePairInfo)::pairInfo
type(RMatParticlePair)::pair, pairEl
integer::Iq, Iqx, Iso, n, Ntotn, Nentp
- integer::Ichan
+ integer::Ichan, iela
real(kind=8)::Sin, Sout, Alabcm, echa
CALL Zero_Array (Cmlab, Iq_Val)
@@ -322,7 +276,9 @@ C
IF (Ntotn.GT.spinInfo%getNumEntryChannels()) THEN
Nentp = spinInfo%getNumEntryChannels() + 1
- call spinInfo%getChannelInfo(channelInfo, 1)
+ ! use elastic channel to get masses
+ iela = spinInfo%getElasticChannel()
+ call spinInfo%getChannelInfo(channelInfo, iela)
call resParData%getParticlePairInfo(
* pairInfo,
* channelInfo%getParticlePairIndex())
diff --git a/sammy/src/inp/minp17.f b/sammy/src/inp/minp17.f
index 245a906c1256b8cfacdb7e207e6ad4c6504bd3a7..56cf39b9316c56fc5d3b4b7f9bb7e59630af51ec 100644
--- a/sammy/src/inp/minp17.f
+++ b/sammy/src/inp/minp17.f
@@ -2,7 +2,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Organize_Bound_Etc (Goj, Bound)
+ SUBROUTINE Organize_Bound_Etc (Bound)
C
C *** PURPOSE -- Generate Goj and Bound and other things
C
@@ -22,7 +22,7 @@ C
IMPLICIT DOUBLE PRECISION (a-h,o-z)
EXTERNAL Sf
C
- DIMENSION Goj(*), Bound(Ntotc,*)
+ DIMENSION Bound(Ntotc,*)
type(SammySpinGroupInfo)::spinInfo
type(RMatSpinGroup)::spinGroup
@@ -39,8 +39,8 @@ C
Spnig = spinInfo%getTargetSpin()
D = Ggginc/(Two*Dabs(Spnig)+One)
call resParData%getSpinGroup(spinGroup, spinInfo)
- Goj(Ig) = D*(Two*Dabs(spinGroup%getJ())+One)
- call spinInfo%setGFactor(Goj(Ig))
+ Goj = D*(Two*Dabs(spinGroup%getJ())+One)
+ call spinInfo%setGFactor(Goj)
IF (spinInfo%getAbundance().EQ.Zero) then
call spinInfo%setAbundance(One)
end if
@@ -56,11 +56,9 @@ C
Bound(N,Ig) = Zero
IF (pair%getCalcShift()) THEN
IF (channel%getBnd().LT.Zero) THEN
- Bound(N,Ig) = channel%getBnd()
- call spinInfo%setBound( Bound(N,Ig))
+ Bound(N,Ig) = channel%getBnd()
ELSE IF (channel%getBnd().EQ.Zero) THEN
Bound(N,Ig) = -channel%getL()
- call spinInfo%setBound( Bound(N,Ig))
ELSE IF (channel%getBnd().GT.Zero) THEN
Docoul = Dfloat(pair%getZa(2)*pair%getZa(1))
Rho = Cycrfn*Dsqrt(channel%getBnd())
@@ -83,7 +81,6 @@ C
IF (Ifail.NE.0) WRITE (6,10400) Ifail
10400 FORMAT(' minp3: PSPCOU ERROR: Ifail =', i2)
END IF
- call spinInfo%setBound( Bound(N,Ig))
END IF
END IF
END DO
diff --git a/sammy/src/mlb/mmlb0.f b/sammy/src/mlb/mmlb0.f
index 5167781d952fa99a3d149e006f27f0af1b17d7ab..53e3b7faf6e1c8213ee10de04f2acff09c9c48ea 100644
--- a/sammy/src/mlb/mmlb0.f
+++ b/sammy/src/mlb/mmlb0.f
@@ -73,7 +73,7 @@ C ### one ###
CALL Set_Kws_Xct
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - <
Inprdr = Idimen (Ngroup, 1, 'Ngroup, 1')
- IF (Ksolve.NE.2) CALL Ppar_Mlb (I_Intot , A(Iiuif), A(Inprdr))
+ IF (Ksolve.NE.2) CALL Ppar_Mlb (A(Iiuif), A(Inprdr))
C *** SUBR Ppar_Mlb sets Nprdr
C
C
diff --git a/sammy/src/mlb/mmlb1.f b/sammy/src/mlb/mmlb1.f
index be3ef8944f466263a00897eb29e4b9c8cc5d7d0e..0c9cf367bb02e2a11b385cfeff50e0d4398a7c8f 100644
--- a/sammy/src/mlb/mmlb1.f
+++ b/sammy/src/mlb/mmlb1.f
@@ -1,7 +1,7 @@
C
C --------------------------------------------------------------
C
- SUBROUTINE Ppar_Mlb (Ntot, Iuif, Nprdr)
+ SUBROUTINE Ppar_Mlb (Iuif, Nprdr)
C
C *** Purpose -- Set Nprdr(K) = Number of varied parameters in group K
C
@@ -12,7 +12,8 @@ C
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
type(SammyResonanceInfo)::resInfo
- DIMENSION Ntot(*), Iuif(*), Nprdr(*)
+ type(SammySpinGroupInfo)::spinInfo
+ DIMENSION Iuif(*), Nprdr(*)
C DIMENSION Ntot(Ngroup),
C * Iuif(Nvpres), Nprdr(Ngroup)
C
@@ -24,9 +25,10 @@ C
DO I=1,resParData%getNumResonances()
call resParData%getResonanceInfo(resInfo, I)
IF (resInfo%getIncludeInCalc()) THEN
- igrp = resInfo%getSpinGroupIndex()
- Mmax = Ntot(Igrp)
- Mmax2 = Mmax + 2
+ igrp = resInfo%getSpinGroupIndex()
+ call resparData%getSpinGroupInfo(spinInfo, igrp)
+ Mmax = spinInfo%getNumChannels()
+ Mmax2 = spinInfo%getNumResPar()
DO M=1,Mmax2
if( m.eq.1) then
Ifl = resInfo%getEnergyFitOption()
diff --git a/sammy/src/mlb/mmlb2.f b/sammy/src/mlb/mmlb2.f
index a49157df797ed48ec1e8bf83569cac69aac03467..05daddf6290c70ef53ce1a5fe4666a87e7167389 100755
--- a/sammy/src/mlb/mmlb2.f
+++ b/sammy/src/mlb/mmlb2.f
@@ -21,13 +21,12 @@ C
* Iplmis, Iplsis, Ipiece
DIMENSION A(-Msize:Msize)
C
- CALL Abpart_Mlb (I_Intot , I_Ilpent , I_Ilspin , A_Iechan ,
+ CALL Abpart_Mlb (A_Iechan ,
* A(Iiuif) , A_Izkte , A(Iaaone), A(Iaatwo), A(Iaathr),
* A(Ipaone), A(Ipatwo), A(Ipathr),
* A(Ip) , A(Igami), A(Idphi))
C
- CALL Parsh_Mlb (A, A_Igoj , I_Inent , I_Inext ,
- * I_Intot , I_Ixclud , A(Inprdr),
+ CALL Parsh_Mlb (A, A(Inprdr),
* A_Izke , A_Izkfe , I_Ifzke , I_Ifzkte , I_Ifzkfe ,
* A(Iaaone), A(Iaatwo), A(Iaathr), A(Ipiece), Ipoten,
* A(Isigxx), A(Idasig), A(Idbsig), I_Iisopa )
diff --git a/sammy/src/mlb/mmlb4.f b/sammy/src/mlb/mmlb4.f
index 26a37009f54afdde9ca73dbabc6e6c68ea8d2002..39b38eefc787981f923992c10378da175fc07a70 100644
--- a/sammy/src/mlb/mmlb4.f
+++ b/sammy/src/mlb/mmlb4.f
@@ -2,8 +2,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Abpart_Mlb (Ntot, Lpent, Lspin, Echan,
- * Iuif, Zkte, Aaaone,
+ SUBROUTINE Abpart_Mlb (Echan, Iuif, Zkte, Aaaone,
* Aaatwo, Aaathr, Paaone, Paatwo, Paathr, P, Gami , Dphi)
C
C *** Purpose -- Generate Aaaone(I ,ig) = Gamma(I)*(E-Pken)/Den
@@ -27,14 +26,16 @@ C
type(SammyResonanceInfo)::resInfo
type(SammySpinGroupInfo)::spinInfo
type(RMatResonance)::resonance
- DIMENSION Ntot(*), Lpent(Ntotc,*), Lspin(Ntotc,*), Echan(Ntotc,*),
- * Iuif(*), Zkte(Ntotc,*),
+ type(SammyParticlePairInfo)::pairInfo
+ type(RMatParticlePair)::pair
+ type(RMatChannelParams)::channel
+ type(SammyChannelInfo)::channelInfo
+ DIMENSION Echan(Ntotc,*), Iuif(*), Zkte(Ntotc,*),
* Aaaone(Ntotc,*), Aaatwo(Ntotc,*), Aaathr(Ntriag,*),
* Paaone(Ntotc,*), Paatwo(Ntotc,*), Paathr(Ntriag,*),
* P(*), Gami(*), Dphi(*)
C
-C DIMENSION Ntot(Ngroup), Lpent(Ntotc,Ngroup),
-C * Lspin(Ntotc,Ngroup), Echan(Ntotc,Ngroup),
+C DIMENSION Ntot(Ngroup), Echan(Ntotc,Ngroup),
C * Iuif(Nvpres), Zkte(ntotc,Ngroup),
C * Aaaone(Ntotc,Ngroup),
C * Aaatwo(Ntotc,Ngroup), Aaathr(Ntriag,Ngroup),
@@ -56,16 +57,24 @@ C
istart = 1
DO Ig=1,resParData%getNumSpinGroups()
+ call resparData%getSpinGroupInfo(spinInfo, Ig)
Nnnn = Ig
Min = istart
Ij = 0
- Ntott = Ntot(Ig)
+ Ntott = spinInfo%getNumChannels()
DO I=1,Ntott
- L = Lspin(I,Nnnn)
+ call spinInfo%getChannelInfo(channelInfo, I)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ call resParData%getChannel(channel, channelInfo)
+
+ L = channel%getL()
Rho = Zkte(I,Ig)*dSQRT(Su-Echan(I,Nnnn))
P(I) = One
Dphi(I) = Zero
- IF (Lpent(I,Nnnn).EQ.1) P(I) = Pfd (Rho, Dphi(I), L)
+ IF (pair%getPnt().EQ.1) P(I) = Pfd (Rho, Dphi(I), L)
END DO
C
DO Ires = Min, resParData%getNumResonances()
@@ -76,11 +85,13 @@ C
IF (resInfo%getIncludeInCalc()) THEN
call resParData%getRedResonance(resonance, resInfo)
- gammaRed = resonance%getWidth(1)
+ ichan = spinInfo%getGammaWidthIndex()
+ gammaRed = resonance%getWidth(ichan)
De = Su - resonance%getEres()
G = gammaRed**2
DO I=1,Ntott
- width = resonance%getWidth(I+1)
+ ichan = spinInfo%getWidthForChannel(I)
+ width = resonance%getWidth(ichan)
G = G + P(I)*width**2
END DO
Gamtot = 2.0D0*G
@@ -89,13 +100,15 @@ C
Gamgam = 2.0D0*gammaRed**2
Ij = 0
DO I=1,Ntott
- width = resonance%getWidth(I+1)
+ ichan = spinInfo%getWidthForChannel(I)
+ width = resonance%getWidth(ichan)
Gami(I) = 2.0*P(I)*width**2
Aaaone(I,Ig) = Aaaone(I,Ig) + Gami(I)*De/Den
Aaatwo(I,Ig) = Aaatwo(I,Ig) + Gami(I)*Gamgam/Den
DO J=1,I
Ij = Ij + 1
- width = resonance%getWidth(J+1)
+ ichan = spinInfo%getWidthForChannel(J)
+ width = resonance%getWidth(ichan)
Gamj = 2.0D0*P(J)*width**2
Aaathr(Ij,Ig) = Aaathr(Ij,Ig) + Gami(I)*Gamj/Den
END DO
@@ -159,7 +172,8 @@ C *** HERE Gamma-CHANNEL-K IS A VARIABLE
Ipar = Ipar + 1
IF (Iuif(Ipar).NE.1) THEN
Iipar = Iipar + 1
- width = resonance%getWidth(K+1)
+ ichan = spinInfo%getWidthForChannel(K)
+ width = resonance%getWidth(ichan)
W = 0.5D0*Gamtot*Gami(K)/Den
X = 2.0D0*De/(width*Den)
Y = 2.0D0*Gamgam/(width*Den)
@@ -193,7 +207,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Parsh_Mlb (A, Goj, Nent, Next, Ntot, Jxclud,
+ SUBROUTINE Parsh_Mlb (A,
* Nprdr, Zke, Zkfe, Jfzke, Jfzkte, Jfzkfe,
* Aaaone, Aaatwo, Aaathr, Pieces, Ipoten, Sigxxx, Dasigx,
* Dbsigx, Isopar)
@@ -220,7 +234,7 @@ C
* Ip, Igami, Ics, Isi, Idphi, Iaaone, Iaatwo, Iaathr, Icayis,
* Iplmis, Iplsis, Ipiece
C
- DIMENSION Goj(*), Nent(*), Next(*), Ntot(*), Jxclud(*),
+ DIMENSION
* Nprdr(*), Zke(Ntotc,*), Zkfe(Ntotc,*),
* Jfzke(*), Jfzkte(Ntotc,*), Jfzkfe(Ntotc,*), Aaaone(Ntotc,*),
* Aaatwo(Ntotc,*), Aaathr(Ntriag,*), Pieces(*), Sigxxx(*),
@@ -228,8 +242,7 @@ C
type(SammySpinGroupInfo)::spinInfo
C
-C DIMENSION Goj(Ngroup), Nent(Ngroup), Next(Ngroup),
-C * Ntot(Ngroup), Jxclud(Ngroup),
+C DIMENSION
C * Nprdr(Ngroup), Aaaone(Ntotc,Ngroup), Aaatwo(Ntotc,Ngroup),
C * Aaathr(ntriag,Ngroup), Cayiso(Numiso), Pilmis(Numiso),
C * Pilsis(Numiso), Pieces(Ngroup)
@@ -246,8 +259,8 @@ C *** Goes to end of sub_routine
C
DO N=1,resParData%getNumSpinGroups()
Kiso = 0
- IF (Jxclud(N).NE.1) THEN
- call resParData%getSpinGroupInfo(spinInfo, N)
+ call resParData%getSpinGroupInfo(spinInfo, N)
+ IF (spinInfo%getIncludeInCalc()) THEN
C
IF (Numiso.GT.0) THEN
isoN = spinInfo%getIsotopeIndex()
@@ -261,33 +274,36 @@ C
Nnnn = N
IF (Ksolve.NE.2) Npr = Nprdr(N)
Nnf1 = Nnf1 + Nn2
- Nn2 = Ntot(N)*(Ntot(N)+1)
+ Ntot = spinInfo%getNumChannels()
+ Nn2 = Ntot*(Ntot+1)
Nn = Nn2/2
C
C
C *** CALCULATE SIN AND COS OF POTENTIAL SCATTERING PHASE
C *** SHIFT, AND DERIVATIVE OF PHI WRT Rho
- IF (Kcros.LE.2) CALL Cossin (Nent(Nnnn), I_Ilspin ,Zke(1,N),
+ IF (Kcros.LE.2) CALL Cossin (Zke(1,N),
* Zkfe(1,N), A(Ics), A(Isi), A(Idphi), Nnnn, Ipoten)
C
C
- Agoj = varAbn*Goj(N)
+ Agoj = varAbn*spinInfo%getGFactor()
C *** SCATTERING CROSS SECTION (IE ELASTIC CROSS SECTION)
+ nent = spinInfo%getNumEntryChannels()
+ next = spinInfo%getNumExitChannels()
IF (Kcros.EQ.1 .OR. Kcros.EQ.2) CALL Elastc_Mlb (Agoj,
- * Nent(N), Next(N), Zke(1,N), Jfzke(N), Jfzkfe(1,N),
+ * Nent, Next, Zke(1,N), Jfzke(N), Jfzkfe(1,N),
* Jfzkfe(1,N), Aaaone(1,N), Aaatwo(1,N), Aaathr(1,N),
* A(Ipaone), A(Ipatwo), A(Ipathr), A(Ics), A(Isi),
* A(Idphi), Sigxxx, Dasigx, Isopar, Iso)
C
C *** REACTION CROSS SECTIONS
IF (Kcros.EQ.1 .OR. Kcros.EQ.3 .OR. Kcros.EQ.5) CALL
- * Reactn_Mlb (Agoj, Nent(N), Next(N), Zke(1,N), Jfzke(N),
+ * Reactn_Mlb (Agoj, Nent, Next, Zke(1,N), Jfzke(N),
* Jfzkte(1,N), Aaathr(1,N), A(Ipathr),
* Sigxxx, Dasigx, Isopar, Iso)
C
C *** CAPTURE CROSS SECTION
IF (Kcros.EQ.1 .OR. Kcros.EQ.4 .OR. Kcros.EQ.5) CALL
- * Captur_Mlb (Agoj, Nent(N), Zke(1,N), Jfzke(N),
+ * Captur_Mlb (Agoj, Nent, Zke(1,N), Jfzke(N),
* Jfzkte(1,N), Aaatwo(1,N), A(Ipatwo),
* Sigxxx, Dasigx, Isopar, Iso)
C
diff --git a/sammy/src/mxw/mmxw5.f b/sammy/src/mxw/mmxw5.f
index 53fc90749ea57c8b2a8e7715586caeb8716a1978..368876c21221667f3461d5036bdba60ff3e3a8aa 100644
--- a/sammy/src/mxw/mmxw5.f
+++ b/sammy/src/mxw/mmxw5.f
@@ -69,7 +69,7 @@ C *** Plotun generates plot and ascii file of unaveraged cross sections
C
C
C *** Findem_Mxw locates the highest energy at which there is a resonance
- CALL Findem_Mxw (I_Intot , Caytmp, Resmax, Ndatq)
+ CALL Findem_Mxw (Caytmp, Resmax, Ndatq)
C
Addcrx = Zero
IF (Kaddcr.EQ.1) CALL Fil3xx (Addcrx, A_Iadder , A_Iaddcr ,Npfil3)
@@ -182,7 +182,7 @@ C
STOP '[STOP in Mxwell in mmxw5.f third time]'
END IF
C
- CALL Approx ( A_Igoj , I_Intot , I_Ixclud,
+ CALL Approx (
* Emx, Emm, Eethrm, Ssthrm, Sum, Isox)
Sumres(J) = Sumres(J) + Sum
END DO
diff --git a/sammy/src/mxw/mmxw6.f b/sammy/src/mxw/mmxw6.f
index 94c1e0c949d3138cebb7f8e9c55f4b0e3908ade3..2d3346789d4d8acb66c938fee39235a72b304379 100644
--- a/sammy/src/mxw/mmxw6.f
+++ b/sammy/src/mxw/mmxw6.f
@@ -2,7 +2,7 @@ C
C
C ------------------------------------------------------------------
C
- SUBROUTINE Findem_Mxw (Ntot, Caytmp, Resmax, Ndatq)
+ SUBROUTINE Findem_Mxw (Caytmp, Resmax, Ndatq)
C
C *** Purpose ... find those resonances for which the Maxwellian varies
C *** significantly over the full-Width-at-half-max of the resonance
@@ -16,7 +16,7 @@ C
use SammySpinGroupInfo_M
use RMatResonanceParam_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
- DIMENSION Ntot(*), Caytmp(*)
+ DIMENSION Caytmp(*)
DIMENSION Ifff(1000)
type(SammyResonanceInfo)::resInfo
type(SammySpinGroupInfo)::spinInfo
@@ -36,10 +36,12 @@ C
call resParData%getResonance(resonance, resInfo)
eres = resonance%getEres()
IF (eres.GT.Emax .OR. eres.LT.Emin) GO TO 40
- Width = resonance%getWidth(1)
- Ntotci = Ntot(resInfo%getSpinGroupIndex())
+ Width = 0.0d0
+ call resParData%getSpinGroupInfo(spinInfo,
+ * resInfo%getSpinGroupIndex())
+ Ntotci = spinInfo%getAllChannels()
DO J=1,Ntotci
- Width = Width + dABS(resonance%getWidth(J+1))
+ Width = Width + dABS(resonance%getWidth(J))
END DO
E = eres + Width*5.0d-3
Ee = eres - Width*5.0d-3
@@ -48,8 +50,6 @@ C *** factor of 1000 is cuz Widths are milli-eV and energies eV
IF (Ee.LT.Emin) Ee = Emin
Jk = 0
IF (Numiso.GT.0) THEN
- call resParData%getSpinGroupInfo(spinInfo,
- * resInfo%getSpinGroupIndex())
Iso = spinInfo%getIsotopeIndex()
Amass = resParData%getMassForIsotope(Iso)
Amass = Amass/(Amass+A_Mass_Small)
@@ -79,14 +79,12 @@ C
C
C ------------------------------------------------------------------
C
- SUBROUTINE Approx (Goj, Ntot, Jxclud,
- * Emx, Emm, Eethrm, Ssthrm, Sumres, Isox)
+ SUBROUTINE Approx (Emx, Emm, Eethrm, Ssthrm, Sumres, Isox)
use fixedi_m
use EndfData_common_m
use SammySpinGroupInfo_M
use RMatResonanceParam_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
- DIMENSION Goj(*), Ntot(*), Jxclud(*)
type(SammyResonanceInfo)::resInfo
type(SammySpinGroupInfo)::spinInfo
type(RMatResonance)::resonance
@@ -100,19 +98,23 @@ C
IF (eres.GE.Zero) THEN
Jgroup = resInfo%getSpinGroupIndex()
call resParData%getSpinGroupInfo(spinInfo, Jgroup)
+ iGam = spinInfo%getGammaWidthIndex()
+ iCap = spinInfo%getElasticChannel()
+ iCap = spinInfo%getWidthForChannel(iCap)
Iso = spinInfo%getIsotopeIndex()
IF (Nnniso.LE.1 .OR. Iso.EQ.Isox) THEN
- IF (Jxclud(Jgroup).NE.1) THEN
+ IF (spinInfo%getIncludeInCalc()) THEN
A = dEXP(-eres/Emm)
- Ntotci = Ntot(Jgroup)
- Width = resonance%getWidth(1)
+ Ntotci = spinInfo%getAllChannels()
+ Width = 0.0d0
DO Ichan=1,Ntotci
- Width = Width + dABS(resonance%getWidth(Ichan+1))
+ Width = Width + dABS(resonance%getWidth(Ichan))
END DO
Sum = Sum +
- * A*Goj(Jgroup)*
+ * A*spinInfo%getGFactor()*
* spinInfo%getAbundance() *
- * resonance%getWidth(2)*resonance%getWidth(1)/Width
+ * resonance%getWidth(iCap)*
+ * resonance%getWidth(iGam)/Width
END IF
END IF
END IF
diff --git a/sammy/src/ndf/mndf0.f b/sammy/src/ndf/mndf0.f
index 553a35406a35a75a98f9f316378efe31eb89b480..96b25678258e8a92439be0d96f99964f57b1b1a0 100644
--- a/sammy/src/ndf/mndf0.f
+++ b/sammy/src/ndf/mndf0.f
@@ -43,7 +43,7 @@ cx10200 FORMAT (' Initialized')
If (Ndfcov.NE.0) THEN
N = (Nvpall*(Nvpall+1))/2
allocate(I_Ix(Nvpall))
- CALL Get_Allvr (I_Intot , I_Ix )
+ CALL Get_Allvr (I_Ix )
deallocate(I_Ix)
allocate(I_Ilocat(nres))
END IF
@@ -62,7 +62,7 @@ C
call allocate_integer_data(I_Isammy,N)
call allocate_integer_data(I_Iisrs,Ngroup)
C
- CALL Pre_Endfb6 (A_Iemmm1 , I_Izzzz1 , A_Ispnn1 ,
+ CALL Pre_Endfb6 (
* A_Ispi , A_Izai , A_Iawri ,
* A_Iabn , I_Nendfg , I_Lendfg , I_Kendfg , I_Ngrpsm,
* I_Isammy , I_Iisrs , Defunc, Awr, Za,
@@ -81,15 +81,12 @@ cx10600 FORMAT (' After Pre_Endfb6')
call allocate_real_data(A_Ivsrs, N)
END IF
C
- CALL Endfb6 ( A_Ksj , I_Intot , I_Inent , I_Iishif ,
- * I_Ilpent , I_Ilspin , A_Ichspi , A_Iechan , A_Iemmm1 , A_Iemmm2 ,
- * I_Izzzz1 , I_Izzzz2 , A_Ispnn1 , A_Ispnn2 , I_Ikppai ,
+ CALL Endfb6 ( A_Ksj ,
* A_Izke , A_Izkte , A_Izkfe , I_ILocat , A_Ispi ,
* A_Izai , A_Iawri , A_Iabn , I_Nendfg , I_Lendfg , I_Kendfg,
* I_Ngrpsm , I_Isammy , I_Kresis , A_Iunc , A_Iunkun , I_Iisrs ,
* A_Iesrs , A_Ivsrs , I_Icov , Num_Res_Parx, Mat, Mf, Mfx, Mt,
- * Ns, Lcomp, If_diag, Lrf, Defunc, Awr, Nsrs, Nisotp, Za, Knofis,
- * A_Ienbnd )
+ * Ns, Lcomp, If_diag, Lrf, Defunc, Awr, Nsrs, Nisotp, Za, Knofis)
deallocate(A_Ksj)
IF (Ndfcov.NE.0) THEN
@@ -100,7 +97,7 @@ C
deallocate(A_Idiag)
ELSE IF (Lcomp.EQ.1 .AND. If_Diag.EQ.0 .AND. Nsrs.LE.0) THEN
CALL Fix_Allvr (I_ILocat)
- CALL Write_Lcomp_1 (I_Intot ,
+ CALL Write_Lcomp_1 (
* A_Iunkun, Num_Res_Parx, Mat, Mfx, Mt, Ns, Nsrs, Knofis,
* Lrf)
ELSE IF (Lcomp.EQ.0 .AND. (Lrf.EQ.1 .OR. Lrf.EQ.2) ) THEN
diff --git a/sammy/src/ndf/mndf1.f b/sammy/src/ndf/mndf1.f
index 9e52d46f9de5883423523d76d69c845c29330e97..edf28a2e0e077c772496bf10a432863da1b27f22 100644
--- a/sammy/src/ndf/mndf1.f
+++ b/sammy/src/ndf/mndf1.f
@@ -1,7 +1,7 @@
C
C ______________________________________________________________
C
- SUBROUTINE Get_Allvr (Ntot, Ix)
+ SUBROUTINE Get_Allvr (Ix)
C
C *** Purpose -- Rewrite Allvr, to be in terms of G=S*Gamma
C *** where S = sign on gamma
@@ -15,7 +15,8 @@ C
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
type(ResonanceCovariance)::physCov
- DIMENSION Ntot(*), Ix(*)
+ type(SammySpinGroupInfo)::spinInfo
+ DIMENSION Ix(*)
DATA Zero /0.0d0/
C
C *** Set Is(Ipar) = 0 if width is positive, 1 if negative
@@ -24,7 +25,8 @@ C *** Set Is(Ipar) = 0 if width is positive, 1 if negative
call resParData%getResonanceInfo(resInfo, N)
call resParData%getResonance(resonance, resInfo)
Igr = resInfo%getSpinGroupIndex()
- DO M=1,Ntot(Igr)+2
+ call resParData%getSpinGroupInfo(spinInfo,Igr)
+ DO M=1,spinInfo%getNumResPar()
if (M.eq.1) then
ifl = resInfo%getEnergyFitOption()
else
@@ -63,7 +65,7 @@ C
C
C ______________________________________________________________
C
- SUBROUTINE Pre_Endfb6 (Emmm1, Kzzz1, Spnn1,
+ SUBROUTINE Pre_Endfb6 (
* Spi, Zai, Awri, Abn, Nendfg,
* Lendfg, Kendfg, Ngrpsm, Isammy, Isrs, Defunc, Awr, Za,
* Mat, Mt, Lcomp, If_Diag, Lrf, Nsrs, Nisotp)
@@ -76,9 +78,20 @@ C
use fixedr_m
use namfil_common_m
use constn_common_m
+ use EndfData_common_m
+ use SammyRMatrixParameters_M
+ use SammySpinGroupInfo_M
+ use SammyParticlePairInfo_M
+ use RMatResonanceParam_M
+ use SammyChannelInfo_M
IMPLICIT DOUBLE PRECISION (A-h,o-z)
C
- DIMENSION Emmm1(Ntotc,*), Kzzz1(Ntotc,*), Spnn1(Ntotc,*),
+ type(SammySpinGroupInfo)::spinInfo
+ type(SammyParticlePairInfo)::pairInfo
+ type(RMatParticlePair)::pair
+ type(RMatChannelParams)::channel
+ type(SammyChannelInfo)::channelInfo
+ DIMENSION
* Spi(*), Zai(*),
* Awri(*), Abn(*), Nendfg(*), Lendfg(Ngroup,*),
* Kendfg(Ngroup,Ngroup,*), Ngrpsm(Ngroup,*), Isammy(*), Isrs(*)
@@ -98,7 +111,14 @@ C ELSE IF (Ndfndf.EQ.1) use file that was made automatically...
CALL Oldopn (10, 'SAMNDF.NDF', 0)
END IF
C
- Kz = Kzzz1(1,1)
+ call resParData%getSpinGroupInfo(spinInfo, 1)
+ iela = spinInfo%getElasticChannel()
+ call spinInfo%getChannelInfo(channelInfo, iela)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ Kz = pair%getZa(2)
C *** Lcomp = 2 => Compact Covariance format = default
Lcomp = 2
C *** Defunc = Default Uncertainty = unknown
@@ -112,7 +132,14 @@ C *** Read first bit of *.ndf file to get Z, A, Mass, etc.
IF (Ndigit.EQ.0 .AND. Lcomp.EQ.2) Ndigit = 2
C
IF (Lrf.NE.7) THEN
- Spix = Spnn1(1,1)
+ call resParData%getSpinGroupInfo(spinInfo, 1)
+ iela = spinInfo%getElasticChannel()
+ call spinInfo%getChannelInfo(channelInfo, iela)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ Spix = pair%getIa(2)
CALL Rdndf (
* Spi, Zai, Awri, Abn, Za, Nendfg, Lendfg, Kendfg,
* Ngrpsm, Isammy, Lrf, Nisotp, Kz, Spix, Nsrs, Isrs, Lcomp,
@@ -124,7 +151,7 @@ C Kendfg(2,J,K) = second SAMMY group # for ENDF grp # J
C Ngrpsm( J,K) = how many SAMMY groups for this ENDF grp J & nuc K
C Isammy( K) = SAMMY nuclide # for ENDF nuclide # K
ELSE
- CALL Rdndf7 (Emmm1, Kzzz1, Spnn1,
+ CALL Rdndf7 (Spnn1,
* Spi, Zai, Awri, Abn, Za, Nendfg, Lrf, Nisotp, Nsrs, Iflag)
END IF
C
@@ -140,13 +167,11 @@ C
C
C ______________________________________________________________
C
- SUBROUTINE Endfb6 (Sj, Ntot, Nent, Ishift, Lpent, Lspin,
- * Chspin, Echan, Emmm1, Emmm2, Kzzz1, Kzzz2, Spnn1, Spnn2, Kppair,
- * Zke, Zkte, Zkfe,
+ SUBROUTINE Endfb6 (Sj, Zke, Zkte, Zkfe,
* Locate, Spi, Zai, Awri, Abn, Nendfg, Lendfg, Kendfg,
* Ngrpsm, Isammy, Kresis, Unc, Unkunc, Isrs, Esrs, Vsrs, Icov,
* Num_Res_Parx, Mat, Mf, Mfx, Mt, Ns, Lcomp, If_Diag, Lrf,
- * Defunc, Awr, Nsrs, Nisotp, Za, Knofis, Bndry)
+ * Defunc, Awr, Nsrs, Nisotp, Za, Knofis)
C
C NML, January 1988
C with a few more modifications March 1991 & Sept 91
@@ -166,17 +191,18 @@ C
use SammyResonanceInfo_M
IMPLICIT DOUBLE PRECISION (A-h,o-z)
C
- DIMENSION Ntot(*), Ishift(Ntotc,*), Lpent(Ntotc,*),
- * Lspin(Ntotc,*), Chspin(Ntotc,*), Echan(Ntotc,*),
- * Emmm1(Ntotc,*), Emmm2(Ntotc,*), Kzzz1(Ntotc,*), Kzzz2(Ntotc,*),
- * Spnn1(Ntotc,*), Spnn2(Ntotc,*), Kppair(Ntotc,*),
- * Zke(Ntotc,*), Zkte(Ntotc,*), Zkfe(Ntotc,*),
+ DIMENSION Zke(Ntotc,*), Zkte(Ntotc,*), Zkfe(Ntotc,*),
* Spi(*), Zai(*), Awri(*), Abn(*), Nendfg(*), Lendfg(Ngroup,*),
* Kendfg(Ngroup,Ngroup,*), Ngrpsm(Ngroup,*), Isammy(*),
* Kresis(*), Sj(*), Locate(*), Unc(*), Unkunc(*),
- * Isrs(*), Esrs(*), Vsrs(*), Icov(*), Bndry(Ntotc,*)
+ * Isrs(*), Esrs(*), Vsrs(*), Icov(*)
C
type(SammyResonanceInfo)::resInfo
+ type(SammySpinGroupInfo)::spinInfo
+ type(SammyChannelInfo)::channelInfo
+ type(SammyParticlePairInfo)::pairInfo
+ type(RMatChannelParams)::channel
+ type(RMatParticlePair)::pair
DIMENSION Lxxx(20), Lyyy(20), Eminxx(20), Appxx(20)
DATA Tenth /0.1d0/, Zero /0.0d0/
DATA Zz8 /0.8d0/, Z123 /1.23d0/, One /1.0d0/, Three /3.0d0/
@@ -224,13 +250,23 @@ C *** first entry in ENDF/B-VI file -- for sample material -- HEAD record
C
C
C *** generate Sj = find ENDF spins
- CALL Findsj (Sj, Chspin, Ntotc)
+ CALL Findsj (Sj)
C
C *** determine Lfw =1 if fission widths are present, =0 if not
C *** Note: ENDF manual says this is for UNresolved region only! Oops.
Lfw = 0
IF (Ntotc.GT.1) THEN
- IF (Lpent(2,1).EQ.0) Lfw = 1
+ call resParData%getSpinGroupInfo(spinInfo, 1)
+ if (spinInfo%getNumChannels().ge.2) then
+ ifis = spinInfo%getFirstFissionChannel()
+ call spinInfo%getChannelInfo(channelInfo, ifis)
+ call resParData%getChannel(channel, channelInfo)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ IF (pair%getPnt().EQ.0) Lfw = 1
+ end if
ELSE
END IF
C
@@ -396,7 +432,8 @@ C = Ifg = 0 if use Gamma, 1 if use gamma
C *** Determine Ngf = number of spin groups with resonances
Ngf = 0
DO Ig=1,resParData%getNumSpinGroups()
- Ntotc2x = Ntot(Ig) + 2
+ call resParData%getSpinGroupInfo(spinInfo, Ig)
+ Ntotc2x = spinInfo%getNumResPar()
DO Ires=1,resParData%getNumResonances()
call resParData%getResonanceInfo(resInfo, Ires)
igrIres = resInfo%getSpinGroupIndex()
@@ -453,31 +490,29 @@ cx * Ndigit, Mat, Mfx, Mt, Ns, Iux)
END IF
C
IF (Lrf.EQ.1. OR. Lrf.EQ.2) THEN
- CALL Wrres2 (Sj, Ntot, Lspin,
+ CALL Wrres2 (Sj,
* Zke, Zkte, Zkfe, Locate, Awri, Lendfg,
* Kendfg, Ngrpsm, Kresis, Unkunc, Icov, Nendfx, Mmsotp,
* Num_Res_Parx, Defunc, Mat, Mf, Mfx, Ns, Iu, Iux, Lcomp,
* If_Diag, Nsrs)
ELSE IF (Lrf.EQ.3) THEN
- CALL Wrres3 (Sj, Ntot, Lspin,
+ CALL Wrres3 (Sj,
* Zke, Zkte, Zkfe, Locate, Awri, Lendfg,
* Kendfg, Ngrpsm, Kresis, Unkunc, Icov, Nendfx, Mmsotp,
* Num_Res_Parx, Defunc, Mat, Mf, Mfx, Ns, Iu, Iux, Lcomp,
* If_Diag, Nsrs, Knofis)
IF (Lcomp.EQ.1 .AND. Nsrs.GT.0) THEN
- CALL Wrres3x (Sj, Ntot,
+ CALL Wrres3x (Sj,
* Locate, Awri, Unkunc, Isrs, Esrs, Vsrs, Icov,
* Defunc, Mat, Mf, Mfx, Ns, Iux, Nsrs, Mmsotp)
END IF
ELSE IF (Lrf.EQ.6) THEN
STOP '[LRF=6 is no longer supported.]'
ELSE IF (Lrf.EQ.7) THEN
- CALL Wrres7 (Ntot, Nent, Ishift, Lpent, Lspin,Chspin,
- * Echan, Emmm1, Emmm2, Kzzz1, Kzzz2, Spnn1, Spnn2, Kppair,
- * Zke, Zkte, Zkfe,
+ CALL Wrres7 (Zke, Zkte, Zkfe,
* Locate, Unc, Unkunc, Icov, Awri, Defunc, Misotp,
* Num_Res_Parx, Mat, Mf, Mfx, Ns, Iu, Iux, Lcomp, If_Diag,
- * Nsrs, Bndry)
+ * Nsrs)
END IF
END DO
C *** End of do=loop on isotopes
diff --git a/sammy/src/ndf/mndf3.f b/sammy/src/ndf/mndf3.f
index d7400f9b4450a0dbaebdbf53c198ee3a5b21fa69..48ec1c133a5a7fc0d3c40f696b335366700df406 100644
--- a/sammy/src/ndf/mndf3.f
+++ b/sammy/src/ndf/mndf3.f
@@ -2,7 +2,7 @@ C
C
C ______________________________________________________________
C
- SUBROUTINE Wrres3 (Sj, Ntot, Lspin,
+ SUBROUTINE Wrres3 (Sj,
* Zke, Zkte, Zkfe, Locate, Awri, Lendfg, Kendfg,
* Ngrpsm, Kresis, Unkunc, Icov, Nendfx, Misotp, Num_Res_Parx,
* Defunc, Mat, Mf, Mfx, Ns, Iu, Iux, Lcomp, If_Diag, Nsrs,Knofis)
@@ -24,7 +24,12 @@ C
C
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
- DIMENSION Sj(*), Ntot(*), Lspin(Ntotc,*),
+ type(SammySpinGroupInfo)::spinInfo
+ type(RMatSpinGroup)::spinGroup
+ type(SammyChannelInfo)::channelInfo
+ type(RMatChannelParams)::channel
+ integer,allocatable,dimension(:)::ntotTmp
+ DIMENSION Sj(*),
* Awri(*), Lendfg(Ngroup,*), Kendfg(Ngroup,Ngroup,*),
* Ngrpsm(Ngroup,*), Kresis(*), Unkunc(*), Icov(*),
* Locate(*)
@@ -33,15 +38,25 @@ C
C
Iparf = 0
Kbegin = 0
- Nt = Ntot(Kendfg(1,1,Misotp))
+ call resParData%getSpinGroupInfo(spinInfo,
+ * Kendfg(1,1,Misotp))
+ Nt = spinInfo%getNumChannels()
Nx = Nt
C *** Check the number of channels
DO Mendfg=1,Nendfx
DO I=1,Ngrpsm(Mendfg,Misotp)
- Nx = Ntot(Kendfg(I,Mendfg,Misotp))
+ call resParData%getSpinGroupInfo(spinInfo,
+ * Kendfg(I,Mendfg,Misotp))
+ Nx = spinInfo%getNumChannels()
IF (Nx.NE.Nt) then
+ allocate(ntotTmp(resParData%getNumSpinGroups()))
+ DO j=1,resParData%getNumSpinGroups()
+ call resParData%getSpinGroupInfo(spinInfo, j)
+ ntotTmp(J) = spinInfo%getNumChannels()
+ end do
WRITE (6,10100)
- * (Ntot(J),J=1,resParData%getNumSpinGroups())
+ * (ntotTmp(J),J=1,resParData%getNumSpinGroups())
+ deallocate(ntotTmp)
end if
END DO
END DO
@@ -51,9 +66,9 @@ C
C *** Find the total number of resonances to be included in file 2
Nrs_File2 = 0
DO Mendfg=1,Nendfx
- CALL Figure_Nmbr_Res (Lspin, Lendfg(Mendfg,Misotp),
+ CALL Figure_Nmbr_Res (Lendfg(Mendfg,Misotp),
* Kendfg(1,Mendfg,Misotp), Ngrpsm(Mendfg,Misotp),
- * Kresis, Nrs, Ntotc)
+ * Kresis, Nrs)
Nrs_File2 = Nrs_File2 + Nrs
END DO
C
@@ -64,8 +79,10 @@ C *** Here only resonances with flags are to be included in File 32,
C *** ergo must count how many resonances have flags
Nres_Included = 0
DO I=1,resParData%getNumResonances()
- call resParData%getResonanceInfo(resInfo, I)
- Ntot2 = Ntot(resInfo%getSpinGroupIndex()) + 2
+ call resParData%getResonanceInfo(resInfo, I)
+ call resParData%getSpinGroupInfo(spinInfo,
+ * resInfo%getSpinGroupIndex())
+ Ntot2 = spinInfo%getNumResPar()
Iflag = 0
if (resInfo%getEnergyFitOption().gt.0) then
Iflag = 1
@@ -86,9 +103,9 @@ C
DO Mendfg=1,Nendfx
C
C *** figure out how many resonances for this ENDF/B-VI spin group
- CALL Figure_Nmbr_Res (Lspin, Lendfg(Mendfg,Misotp),
+ CALL Figure_Nmbr_Res (Lendfg(Mendfg,Misotp),
* Kendfg(1,Mendfg,Misotp), Ngrpsm(Mendfg,Misotp),
- * Kresis, Nrs, Ntotc)
+ * Kresis, Nrs)
Nrs6 = 6*Nrs
CALL Getap (Zke, Zkte, Zkfe, Kendfg(1,Mendfg,Misotp),
* Ngrpsm(Mendfg,Misotp), Apl, Ntotc)
@@ -162,19 +179,21 @@ C *** second part of sixth entry
eres = resonance%getEres()
Nnn = N
Igy = resInfo%getSpinGroupIndex()
+ call resParData%getSpinGroupInfo(spinInfo, Igy)
+ ntotIgy = spinInfo%getNumChannels()
IF (Kresis(N).NE.0) THEN
C ************ Resonance # N is in this ENDF spin group
Lful = Lful + 1
IF (Iux.NE.0) THEN
Locate(N) = Lful
CALL Get_Unc (Unkunc, Icov, K_Unc, E,
- * Ga, Gb, Gc, Gd, Defunc, Ntot(Igy), Nnn, Lcomp,
+ * Ga, Gb, Gc, Gd, Defunc, ntotIgy, Nnn, Lcomp,
* Nsrs, Iparf)
IF (Lcomp.EQ.1 .AND. If_Diag.NE.0) THEN
C ****************** Write File 32 when If_Diag>0 (each resonance alone in
C ****************** its own short-range section)
Kbegin = 1
- Mpar = Ntot(Igy) + 2
+ Mpar = ntotIgy + 2
Nrb = 1
Kkk = Mpar * Nrb
Nvs = (Kkk*(Kkk+1))/2
@@ -204,13 +223,13 @@ C
* (Nsrs.EQ.0 .OR.
* resInfo%getEnergyFitOption().GE.0)) THEN
C ********************* Write uncertainties into File 32 for LCOMP=2
- CALL Write_Lrf3_2 (Ntot(Igy), E, Ax, Ga, Gb, Gc,
+ CALL Write_Lrf3_2 (ntotIgy, E, Ax, Ga, Gb, Gc,
* Gd, Mat, Mfx, Mt, Ns, Iux)
C
ELSE IF (Lcomp.EQ.1 .AND. If_Diag.EQ.1) THEN
C ********************* Write covariance matrix for LCOMP=1 when diagonal
C ********************* wrt resonances
- CALL Write_Lrf3_3 (Ntot(Igy), E, Ax, Ga, Gb, Gc,
+ CALL Write_Lrf3_3 (ntotIgy, E, Ax, Ga, Gb, Gc,
* Gd, Mat, Mfx, Mt, Ns, Iux)
END IF
C
@@ -367,14 +386,17 @@ C
C
C ______________________________________________________________
C
- SUBROUTINE Figure_Nmbr_Res (Lspin, Lendfg, Kendfg, Ngrpsm,
- * Kresis, Nrs, Ntotc)
+ SUBROUTINE Figure_Nmbr_Res (Lendfg, Kendfg, Ngrpsm,
+ * Kresis, Nrs)
C *** Purpose -- Figure out which resonances form this ENDF/B-VI spin group
use EndfData_common_m
use SammyResonanceInfo_M
IMPLICIT DOUBLE PRECISION (A-h,o-z)
type(SammyResonanceInfo)::resInfo
- DIMENSION Lspin(Ntotc,*), Kendfg(*), Kresis(*)
+ type(SammySpinGroupInfo)::spinInfo
+ type(SammyChannelInfo)::channelInfo
+ type(RMatChannelParams)::channel
+ DIMENSION Kendfg(*), Kresis(*)
C Lspin(Ngroup), Kendfg(Ngrpsm), Kresis(Nres)
C
DO N=1,resParData%getNumResonances()
@@ -384,7 +406,12 @@ C
Nrs = 0
DO Mgrpsm=1,Ngrpsm
Kgroup = Kendfg(Mgrpsm)
- IF (Lspin(1,Kgroup).NE.Lendfg) GO TO 40
+ call resParData%getSpinGroupInfo(spinInfo, Kgroup)
+ iela = spinInfo%getElasticChannel()
+ call spinInfo%getChannelInfo(channelInfo, iela)
+ call resParData%getChannel(channel, channelInfo)
+ lspin = channel%getL()
+ IF (lspin.NE.Lendfg) GO TO 40
DO N=1,resParData%getNumResonances()
call resParData%getResonanceInfo(resInfo, N)
IF (resInfo%getSpinGroupIndex().EQ.Kgroup) THEN
@@ -396,7 +423,7 @@ C
RETURN
C
40 CONTINUE
- WRITE (6,99999) Kgroup, Lspin(1,Kgroup), Lendfg
+ WRITE (6,99999) Kgroup, lspin, Lendfg
99999 FORMAT (' SAMMY group #', I3, ' has L of', I3,
* ', which does not correspond to ENDF/B-VI value of', I3)
STOP '[STOP in Figur in ndf/mndf3.f]'
@@ -444,7 +471,7 @@ C
C
C ______________________________________________________________
C
- SUBROUTINE Wrres3x (Sj, Ntot,
+ SUBROUTINE Wrres3x (Sj,
* Locate, Awri, Unkunc, Isrs, Esrs, Vsrs, Icov, Defunc,
* Mat, Mf, Mfx, Ns, Iux, Nsrs, Misotp)
C
@@ -462,7 +489,8 @@ C
C
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
- DIMENSION Sj(*), Ntot(*),
+ type(SammySpinGroupInfo)::spinInfo
+ DIMENSION Sj(*),
* Awri(*), Unkunc(*),
* Locate(*), Isrs(Ngroup,*), Esrs(2,*), Vsrs(*), Icov(*)
real(kind=8)::listData(6)
@@ -558,8 +586,10 @@ C
call resParData%getResonance(resonance, resInfo)
eres = resonance%getEres()
Igy = resInfo%getSpinGroupIndex()
+ call resParData%getSpinGroupInfo(spinInfo, igy)
+ ntotIgy =spinInfo%getNumChannels()
CALL Get_Unc (Unkunc, Icov, K_Unc, E,
- * Ga, Gb, Gc, Gd, Defunc, Ntot(Igy), N, Lcomp,
+ * Ga, Gb, Gc, Gd, Defunc, ntotIgy, N, Lcomp,
* Nsrs, Iparf)
listData(1) = resonance%getEres()
listData(2) = Sj(Igy)
@@ -575,7 +605,7 @@ C
* listFlag(1), listFlag(2), listFlag(3),
* listFlag(4), listFlag(5), listFlag(6),
* Iux)
- IF (Ntot(Igy).gt.3) THEN
+ IF (ntotIgy.gt.3) THEN
STOP '[STOP in Wrres3 in ndf/mndf3.f]'
END IF
END DO
diff --git a/sammy/src/ndf/mndf4.f b/sammy/src/ndf/mndf4.f
index 8e526c21a880b5ed1048d8494e0e161072588165..fb093ac8e9e80c9b79f01eeeb6b42abcc756f611 100644
--- a/sammy/src/ndf/mndf4.f
+++ b/sammy/src/ndf/mndf4.f
@@ -2,7 +2,7 @@ C
C
C ______________________________________________________________
C
- SUBROUTINE Wrres2 (Sj, Ntot, Lspin,
+ SUBROUTINE Wrres2 (Sj,
* Zke, Zkte, Zkfe, Locate, Awri, Lendfg, Kendfg,
* Ngrpsm, Kresis, Unkunc, Icov, Nendfx, Misotp, Num_Res_Parx,
* Defunc, Mat, Mf, Mfx, Ns, Iu, Iux, Lcomp, If_Diag, Nsrs)
@@ -25,7 +25,12 @@ C
C
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
- DIMENSION Sj(*), Ntot(*), Lspin(Ntotc,*),
+ type(SammySpinGroupInfo)::spinInfo
+ type(RMatSpinGroup)::spinGroup
+ type(SammyChannelInfo)::channelInfo
+ type(RMatChannelParams)::channel
+ integer,allocatable,dimension(:)::ntotTmp
+ DIMENSION Sj(*),
* Awri(*), Lendfg(Ngroup,*), Kendfg(Ngroup,Ngroup,*),
* Ngrpsm(Ngroup,*), Kresis(*), Unkunc(*), Locate(*)
DIMENSION Zke(Ntotc,*), Zkte(Ntotc,*), Zkfe(Ntotc,*), Icov(*)
@@ -34,14 +39,23 @@ C
C
Iparf = 0
Kbegin = 0
- Nt = Ntot(1)
+ call resParData%getSpinGroupInfo(spinInfo, 1)
+ Nt = spinInfo%getNumChannels()
Nx = Nt
DO I=1,resParData%getNumSpinGroups()
- IF (Ntot(I).NE.Nt) THEN
- Nx = Ntot(I)
+ call resParData%getSpinGroupInfo(spinInfo, I)
+ nn = spinInfo%getNumChannels()
+ IF (nn.NE.Nt) THEN
+ Nx = nn
IF (Nx.NE.Nt) then
+ allocate(ntotTmp(resParData%getNumSpinGroups()))
+ DO j=1,resParData%getNumSpinGroups()
+ call resParData%getSpinGroupInfo(spinInfo, j)
+ ntotTmp(J) = spinInfo%getNumChannels()
+ end do
WRITE (6,50100)
- * (Ntot(J),J=1,resParData%getNumSpinGroups())
+ * (ntotTmp(J),J=1,resParData%getNumSpinGroups())
+ deallocate(ntotTmp)
end if
END IF
END DO
@@ -51,9 +65,9 @@ C
C *** Find the total number of resonances to be included in file 2
Nrs_File2 = 0
DO Mendfg=1,Nendfx
- CALL Figure_Nmbr_Res (Lspin, Lendfg(Mendfg,Misotp),
+ CALL Figure_Nmbr_Res (Lendfg(Mendfg,Misotp),
* Kendfg(1,Mendfg,Misotp), Ngrpsm(Mendfg,Misotp),
- * Kresis, Nrs, Ntotc)
+ * Kresis, Nrs)
Nrs_File2 = Nrs_File2 + Nrs
END DO
C
@@ -66,7 +80,8 @@ C *** ergo must count how many resonances have flags
DO I=1,resParData%getNumResonances()
call resParData%getResonanceInfo(resInfo, I)
igrp = resInfo%getSpinGroupIndex()
- Ntot2 = Ntot(Igrp) + 2
+ call resParData%getSpinGroupInfo(spinInfo, igrp)
+ Ntot2 = spinInfo%getNumResPar()
Iflag = 0
DO J=1,Ntot2
if (j.eq.1) then
@@ -88,9 +103,9 @@ C
DO Mendfg=1,Nendfx
C
C *** figure out how many resonances for this ENDF/B-VI spin group
- CALL Figure_Nmbr_Res (Lspin, Lendfg(Mendfg,Misotp),
+ CALL Figure_Nmbr_Res (Lendfg(Mendfg,Misotp),
* Kendfg(1,Mendfg,Misotp), Ngrpsm(Mendfg,Misotp),
- * Kresis, Nrs, Ntotc)
+ * Kresis, Nrs)
Nrs6 = 6*Nrs
C
C *** first part of sixth entry in ENDF/B-VI file [LIST record]
@@ -180,17 +195,20 @@ C *** second part of sixth entry
Nnn = N
IF (Kresis(N).NE.0) THEN
- Igy = resInfo%getSpinGroupIndex()
+ Igy = resInfo%getSpinGroupIndex()
+ call resParData%getSpinGroupInfo(spinInfo, igy)
+ ntotIgy =spinInfo%getNumChannels()
Lful = Lful + 1
IF (Iux.NE.0) THEN
Locate(N) = Lful
CALL Get_Unc (Unkunc, Icov, K_Unc, E, Ga, Gb,
- * Gc, Gd, Defunc, Ntot(Igy), Nnn, Lcomp, Nsrs, Iparf)
+ * Gc, Gd, Defunc, ntotIgy, Nnn, Lcomp, Nsrs, Iparf)
IF (Lcomp.EQ.1 .AND. If_Diag.EQ.1) THEN
C ****************** Write File 32 when If_Diag>0 (each resonance alone in
C ****************** its own short-range section)
igrp = resInfo%getSpinGroupIndex()
- Mpar = Ntot(Igrp) + 2
+ call resParData%getSpinGroupInfo(spinInfo, igrp)
+ Mpar = spinInfo%getNumResPar()
Nrb = 1
Kkk = Mpar*Nrb
Nvs = (Kkk*(Kkk+1))/2
@@ -224,27 +242,27 @@ C
* (Nsrs.EQ.0 .OR.
* resInfo%getEnergyFitOption().GE.0)) THEN
C ********************* Write uncertainties into File 32 for LCOMP=2
- CALL Write_Lrf2_2 (Ntot(Igy), E, Ax, Ga, Gb, Gc,
+ CALL Write_Lrf2_2 (ntotIgy, E, Ax, Ga, Gb, Gc,
* Gd, Mat, Mfx, Mt, Ns, Iux)
C
ELSE IF (Lcomp.EQ.1 .AND. If_Diag.EQ.1) THEN
C ********************* Write covariance matrix for LCOMP=1 when diagonal
C ********************* wrt resonances
IF (Nsrs.EQ.0) THEN
- CALL Write_Lrf2_3 (Ntot(Igy), E, Ax, Ga, Gb,
+ CALL Write_Lrf2_3 (ntotIgy, E, Ax, Ga, Gb,
* Gc, Gd, Mat, Mfx, Mt, Ns, Iux)
ELSE IF (resInfo%getEnergyFitOption().ge.0) THEN
- CALL Write_Lrf2_3 (Ntot(Igy), E, Ax, Ga, Gb,
+ CALL Write_Lrf2_3 (ntotIgy, E, Ax, Ga, Gb,
* Gc, Gd, Mat, Mfx, Mt, Ns, Iux)
END IF
C
ELSE IF (Lcomp.EQ.0) THEN
C ********************* Write cov mtrx for LCOMP=0
IF (Nsrs.EQ.0) THEN
- CALL Write_Lrf2_0 (Ntot(Igy), E, Ax, Ga, Gb,
+ CALL Write_Lrf2_0 (ntotIgy, E, Ax, Ga, Gb,
* Gc, Gd, Mat, Mfx, Mt, Ns, Iux)
ELSE IF (resInfo%getEnergyFitOption().GE.0) THEN
- CALL Write_Lrf2_0 (Ntot(Igy), E, Ax, Ga, Gb,
+ CALL Write_Lrf2_0 (ntotIgy, E, Ax, Ga, Gb,
* Gc, Gd, Mat, Mfx, Mt, Ns, Iux)
END IF
END IF
diff --git a/sammy/src/ndf/mndf6.f b/sammy/src/ndf/mndf6.f
index d5b773b270de2015f69eb4faf0f4bb857b720fa2..3b1ec379489c3ab4f89c7a4a2e5a85fab48be854 100644
--- a/sammy/src/ndf/mndf6.f
+++ b/sammy/src/ndf/mndf6.f
@@ -2,7 +2,7 @@ C
C
C ______________________________________________________________
C
- SUBROUTINE Rdndf7 (Emmm1, Kzzz1, Spnn1,
+ SUBROUTINE Rdndf7 (Spnn1,
* Spi, Zai, Awri, Abn, Za, Nendfg, Lrf, Nisotp, Nsrs, Iflag)
C
C *** Purpose -- Read rest of "ndf file"
@@ -19,12 +19,16 @@ C
use mdf5_m
use EndfData_common_m
use SammySpinGroupInfo_M
+ use ResonanceParameterIO_M
IMPLICIT DOUBLE PRECISION (A-h,o-z)
C
CHARACTER*1 Alpha(80)
- DIMENSION Emmm1(Ntotc2,*), Kzzz1(Ntotc2,*), Spnn1(Ntotc2,*),
+ DIMENSION Spnn1(Ntotc2,*),
* Spi(*), Zai(*), Awri(*), Abn(*), Nendfg(*)
type(SammySpinGroupInfo)::spinInfo
+ type(SammyParticlePairInfo)::pairInfo
+ type(RMatParticlePair)::pair
+ type(SammyChannelInfo)::channelInfo
DATA Zero /0.0d0/, One /1.0d0/
C
C
@@ -114,7 +118,13 @@ C *** other Lrf values)
call resParData%getSpinGroupInfo(spinInfo, Ig)
isoIg = spinInfo%getIsotopeIndex()
IF (IsoIg.EQ.Misotp) THEN
- Nzz = Kzzz1(1,Ig)
+ iela = spinInfo%getElasticChannel()
+ call spinInfo%getChannelInfo(channelInfo, iela)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair,pairInfo)
+ Nzz = pair%getZa(2)
GO TO 65
END IF
END DO
@@ -155,7 +165,15 @@ C Nisotp = number of ENDF isotopes
isoIg = spinInfo%getIsotopeIndex()
IF (IsoIg.EQ.Iso) THEN
IF (N.EQ.0) THEN
- IF (Awri(Iso).EQ.Zero) Awri(Iso) = Emmm1(1,Ig)/Aneutr
+ IF (Awri(Iso).EQ.Zero) then
+ iela = spinInfo%getElasticChannel()
+ call spinInfo%getChannelInfo(channelInfo, iela)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ Awri(Iso) = pair%getMass(2)/Aneutr
+ end if
Spi(Iso) = Spnn1(1,Ig)
END IF
N = N + 1
@@ -171,12 +189,9 @@ C
C
C ______________________________________________________________
C
- SUBROUTINE Wrres7 (Ntot, Nent, Ishift, Lpent, Lspin,Chspin,
- * Echan, Emmm1, Emmm2, Kzzz1, Kzzz2, Spnn1, Spnn2, Kppair,
- * Zke, Zkte, Zkfe,
+ SUBROUTINE Wrres7 (Zke, Zkte, Zkfe,
* Locate, Unc, Unkunc, Icov, Awri, Defunc, Misotp,
- * Num_Res_Parx, Mat, Mf, Mfx, Ns, Iu, Iux, Lcomp, If_Diag, Nsrs,
- * Bndry)
+ * Num_Res_Parx, Mat, Mf, Mfx, Ns, Iu, Iux, Lcomp, If_Diag, Nsrs)
C
C NML, May 2002 Lrf=7 format for ENDF
C with more mods later wrt covariances etc.
@@ -191,17 +206,14 @@ C
use RMatResonanceParam_M
IMPLICIT DOUBLE PRECISION (A-h,o-z)
C
- DIMENSION Ntot(*), Nent(*), Ishift(Ntotc,*),
- * Lpent(Ntotc,*), Lspin(Ntotc,*), Chspin(Ntotc,*),
- * Echan(Ntotc,*), Emmm1(Ntotc,*), Emmm2(Ntotc,*),
- * Kzzz1(Ntotc,*), Kzzz2(Ntotc,*), Spnn1(Ntotc,*), Spnn2(Ntotc,*),
- * Awri(*), Locate(*), Unc(*), Unkunc(*), Icov(*),
- * Zke(Ntotc,*), Zkte(Ntotc,*), Zkfe(Ntotc,*), Kppair(Ntotc,*),
- * Bndry(Ntotc,*)
+ DIMENSION Awri(*), Locate(*), Unc(*), Unkunc(*), Icov(*),
+ * Zke(Ntotc,*), Zkte(Ntotc,*), Zkfe(Ntotc,*)
type(SammySpinGroupInfo)::spinInfo
type(RMatSpinGroup)::spinGroup
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
+ type(SammyChannelInfo)::channelInfo
+ type(RMatChannelParams)::channel
DATA Zero /0.0d0/, Tenth /0.1d0/, One /1.0d0/
C
C
@@ -214,9 +226,7 @@ C
K_Unc = 0
C
C *** Determine and write particle-pair definitions
- CALL Pp7 (Ntot, Nent, Ishift, Lpent, Echan, Emmm1, Emmm2,
- * Kzzz1, Kzzz2, Spnn1, Spnn2, Kppair, Misotp, Mat, Mf,
- * Mfx, Ns, Iu, Iux, Lcomp)
+ CALL Pp7 (Misotp, Mat, Mf, Mfx, Ns, Iu, Iux, Lcomp)
C @@@ File 2 LRF=7, first LIST on III-16
C @@@ File 32 LRF=7 LCOMP=2, first LIST on IV-20
C
@@ -233,7 +243,8 @@ C
C ****** Determine Ngf = number of groups with parameters for cov mtrx
Ngf = 0
DO Ig=1,resParData%getNumSpinGroups()
- Ntotc2x = Ntot(Ig) + 2
+ call resParData%getSpinGroupInfo(spinInfo, Ig)
+ Ntotc2x = spinInfo%getNumResPar()
DO Ires=1,resParData%getNumResonances()
call resParData%getResonanceInfo(resInfo, Ires)
igrp = resInfo%getSpinGroupIndex()
@@ -295,7 +306,7 @@ C
END IF
END IF
IF (K_Want.EQ.0) THEN
- Ntotc2x = Ntot(Ig) + 2
+ Ntotc2x = spinInfo%getNumResPar()
C
C *** Figure Nrs = how many resonances for this ENDF/B-VI spin group
C *** and (if needed) Nrsx = how many have varied parameters
@@ -322,14 +333,31 @@ C *** and (if needed) Nrsx = how many have varied parameters
END IF
END IF
END DO
- Ntotcx = Ntot(Ig) + 1
- Num_Res_Parx = Num_Res_Parx + Nrsx*(Ntot(Ig)+2)
+ Ntotcx = spinInfo%getAllChannels()
+ Num_Res_Parx = Num_Res_Parx +
+ * Nrsx*spinInfo%getNumResPar()
C *** first part of LIST record ... Define J; How many channels?
Ntotc6 = Ntotcx*6
Parity = Zero
IF (spinGroup%getJ().EQ.Zero) then
- Parity = Parity_Z (Lspin(1,Ig),
- * Chspin(1,Ig), Ntot(Ig))
+ Parity = 0.0d0
+ DO I=1,spinInfo%getNumChannels()
+ call spinInfo%getChannelInfo(channelInfo, I)
+ call resParData%getChannel(channel, channelInfo)
+ C = channel%getSch()
+ IF (C.NE.0.0D0) THEN
+ IF (C.GT.0.0D0) THEN
+ C = 1.0D0
+ ELSE
+ C = -1.0D0
+ END IF
+ IF (MOD(channel%getL(),2).NE.0) THEN
+ C = - C
+ END IF
+ Parity = C
+ exit
+ END IF
+ END DO
end if
10200 FORMAT ('####', /,
* '#### Spin group is defined in the next lines', /,
@@ -367,19 +395,22 @@ C @@@@@@@@@@@@ File 2 LRF=7, 2nd line (gamma ch) of 2nd LIST on III-16
* Mat, Mfx, Mt, Ns, Iux)
END IF
Flag = Zero
- DO I=1,Ntot(Ig)
+ DO I=1,spinInfo%getNumChannels()
IF (Nppair.EQ.0) THEN
- Apair = (I-Nent(Ig)+1) + One
+ Apair = (I-spinInfo%getNumEntryChannels()+1) + One
ELSE
- Apair = dFLOAT(Kppair(I,Ig)) + One
+ call spinInfo%getChannelInfo(channelInfo, I)
+ ipp = channelInfo%getParticlePairIndex()
+ Apair = dFLOAT(ipp) + One
END IF
- El = Lspin(I,Ig)
+ call spinInfo%getChannelInfo(channelInfo, I)
+ call resParData%getChannel(channel, channelInfo)
+ El = channel%getL()
C &&&&&&&&&& Changed by A. Holcomb 11/11/16 - channel spin parity is a good check for consistency,
C &&&&&&&&&& but has been ruffling some feathers. In any case, the sign of the channel spin does
C &&&&&&&&&& not change the angle-integrated cross sections, double-differential xs, or derivatives.
-C Es = Chspin(I,Ig) !old line
- Es = DABS( Chspin(I,Ig) )
- Flag= Bndry(I,Ig)
+ Es = DABS( channel%getSch() )
+ Flag= channel%getBnd()
C Rad1 = effective, Rad2 = true radius. Pre-July 2006, these were backwards
Rad1 = Zkfe(I,Ig)/Zke(I,Ig) * Tenth
Rad2 = Zkte(I,Ig)/Zke(I,Ig) * Tenth
@@ -650,28 +681,3 @@ C
END IF
RETURN
END
-C
-C
-C ______________________________________________________________
-C
- DOUBLE PRECISION FUNCTION Parity_Z (Lspin, Chspin, Ntotg)
- IMPLICIT DOUBLE PRECISION (A-h,o-z)
- DIMENSION Lspin(*), Chspin(*)
- DO I=1,Ntotg
- C = Chspin(I)
- IF (C.NE.0.0D0) THEN
- IF (C.GT.0.0D0) THEN
- C = 1.0D0
- ELSE
- C = -1.0D0
- END IF
- IF (MOD(Lspin(I),2).NE.0) THEN
- C = - C
- END IF
- Parity_Z = C
- RETURN
- END IF
- END DO
- Parity_Z = 0.0d0
- RETURN
- END
diff --git a/sammy/src/ndf/mndf7.f b/sammy/src/ndf/mndf7.f
index 785a238153f1e9967cd600cf6652a40b7e16d986..9d1f32e5b989e0bfaad063bbbf155f0cf4cb7e33 100644
--- a/sammy/src/ndf/mndf7.f
+++ b/sammy/src/ndf/mndf7.f
@@ -91,9 +91,7 @@ C
C
C ______________________________________________________________
C
- SUBROUTINE Pp7 (Ntot, Nent, Ishift, Lpent, Echan, Emmm1,
- * Emmm2, Kzzz1, Kzzz2, Spnn1, Spnn2, Kppair, Misotp,
- * Mat, Mf, Mfx, Ns, Iu, Iux, Lcomp)
+ SUBROUTINE Pp7 (Misotp, Mat, Mf, Mfx, Ns, Iu, Iux, Lcomp)
C
C *** Determine and write particle-pair definitions
C
@@ -105,11 +103,12 @@ C
use SammySpinGroupInfo_M
IMPLICIT DOUBLE PRECISION (A-h,o-z)
C
- DIMENSION Ntot(*), Nent(*), Ishift(Ntotc,*),
- * Lpent(Ntotc,*), Echan(Ntotc,*), Emmm1(Ntotc,*),
- * Emmm2(Ntotc,*), Kzzz1(Ntotc,*), Kzzz2(Ntotc,*), Spnn1(Ntotc,*),
- * Spnn2(Ntotc,*), Kppair(Ntotc,*)
type(SammySpinGroupInfo)::spinInfo
+ type(RMatResonance)::resonance
+ type(SammyParticlePairInfo)::pairInfo
+ type(RMatParticlePair)::pair
+ type(RMatChannelParams)::channel
+ type(SammyChannelInfo)::channelInfo
DATA Zero /0.0d0/, One /1.0d0/
C
C
@@ -122,54 +121,10 @@ C
N1 = 1
Inel = 0
C
- IF (Nppair.EQ.0) THEN
-C
-C *** When particle-pairs were not defined in INPut file
- Npop = 0
- DO Ig=1,Ngroup
- IF (Npop.GT.0) GO TO 10
- IF (Numiso.LE.0) THEN
- K_Want = 0
- ELSE
- call resParData%getSpinGroupInfo(spinInfo, Ig)
- isoig = spinInfo%getIsotopeIndex()
- IF (IsoIg.EQ.Misotp) THEN
- K_Want = 0
- ELSE
- K_Want = 1
- END IF
- END IF
- IF (K_Want.EQ.0) THEN
- Ntotcx = Ntot(Ig) + 1
-C
- IF (Npop.EQ.0) THEN
-C *** LIST record ... pairs of particles
- Npop = Ntotcx
-C
-C *** First, the gamma channel
- Npop2 = 2*Npop
-C 2 lines for each pair-of-particles
- Npop26 = 6*Npop2
- WRITE (Iu,10000) Npop
- IF (Iuxx.NE.0) WRITE (Iux,10000) Npop
10000 FORMAT ('####', /, '####', I3,
* ' pairs of particles are defined next', /,
* '#### First pair is gamma & compound nucleus', /,
* '#### Others are particle pairs')
- CALL Cont_Ndfa (Ax, Ax, Npop, Lx, Npop26, Npop2,
- * Mat, Mf, Mt, Ns, Iu)
-C @@@@@@@ File 2 LRF=7, first line of first LIST on III-16
- IF (Iuxx.NE.0) CALL Cont_Ndfa (Ax, Ax, Npop, Lx,
- * Npop26, Npop2, Mat, Mfx, Mt, Ns, Iux)
-C @@@@@@@ File 32 LRF=7 LCOMP=2, first line of first LIST on IV-20
-C *** First pair is gamma & compound nucleus
- Em2 = Zero
- Em1 = Emmm1(1,Ig)/Aneutr + One
- Zz1 = Kzzz1(1,Ig)
- Zz2 = Zero
- Sp2 = One
- Sp1 = Zero
- Amtx = 102.0
10100 FORMAT ('####', /,
* '#### MA MB ZA ZB', 9X,
* 'IA IB', /,
@@ -177,105 +132,37 @@ C *** First pair is gamma & compound nucleus
* 'PA PB')
10010 FORMAT ('#### Number of groups with varied prmtrs =',
* I3)
- WRITE (Iu,10100)
- CALL List_7a (Em2, Em1, Zz2, Zz1, Sp2, Sp1,
- * Mat, Mf, Mt, Ns, Iu)
-C @@@@@@@ File 2 LRF=7, second line of first LIST on III-16
-C @@@@@@@ (capture "particle pair")
- CALL List_7b (Ax, Ax, Ax, Amtx, Ax, Ax,
- * Mat, Mf, Mt, Ns, Iu)
-C @@@@@@@ File 2 LRF=7, third line of first LIST on III-16
-C @@@@@@@ but only mass of target is given here
-C @@@@@@@ (capture "particle pair")
- IF (Iuxx.NE.0) THEN
- WRITE (Iux,10100)
- CALL List_7a (Em2, Em1, Zz2, Zz1, Sp2, Sp1,
- * Mat, Mfx, Mt, Ns, Iux)
-C @@@@@@@ File 32 LRF=7 LCOMP=2, 2nd line of first LIST on IV-20
-C @@@@@@@ (capture "particle pair")
- CALL List_7b (Ax, Ax, Ax, Amtx, Ax, Ax,
- * Mat, Mfx, Mt, Ns, Iux)
-C @@@@@@@ File 32 LRF=7 LCOMP=2, 3rd line of first LIST on IV-20
-C @@@@@@@ (capture "particle pair")
- END IF
- END IF
-C
- Em2 = Emmm2(1,Ig)/Aneutr
- Em1 = Emmm1(1,Ig)/Aneutr
- Alabcm = - Em1/(Em1+Em2)
- DO I=1,Ntot(Ig)
- IF ((I.EQ.1) .OR. (I.GT.1 .AND. I.GT.Nent(Ig))) THEN
-C *** next pair is SAMMY's Channel I, Spin Group Ig
- Em2 = Emmm2(I,Ig)/Aneutr
- Em1 = Emmm1(I,Ig)/Aneutr
- Zz1 = Kzzz1(I,Ig)
- Kz1 = Kzzz1(I,Ig)
- Zz2 = Kzzz2(I,Ig)
- Sp1 = Spnn1(I,Ig)
- Sp2 = Spnn2(I,Ig)
- CALL List_7a (Em2, Em1, Zz2, Zz1, Sp2, Sp1,
- * Mat, Mf, Mt, Ns, Iu)
-C @@@@@@@ File 2 LRF=7, 2nd-last line of first LIST on III-16
-C @@@@@@@ (two true particles)
- IF (Iuxx.NE.0) CALL List_7a (Em2, Em1, Zz2, Zz1,
- * Sp2, Sp1, Mat, Mfx, Mt, Ns, Iux)
-C @@@@@@@ File 32 LRF=7 LCOMP=2, second-from-last line of first
-C @@@@@@@ LIST on IV-20 (two particles)
- Q = Echan (I,Ig)/Alabcm
- Ashift = Ishift(I,Ig)
- Lp = Lpent (I,Ig)
- Apent = Lpent (I,Ig)
- Pi1 = Ax
- Pi2 = Ax
- CALL Get_Mat (Em2, Kz1, Sp2, Q, Inel, Lp, Amtx)
- IF (Sp1.EQ.Zero) Pi1 = One
- IF (Sp2.EQ.Zero) Pi2 = One
- CALL List_7b (Q, Apent, Ashift, Amtx, Pi2, Pi1,
- * Mat, Mf, Mt, Ns, Iu)
-C @@@@@@@ File 2 LRF=7, last line of first LIST on III-16
-C @@@@@@@ (two particles)
- IF (Iuxx.NE.0) CALL List_7b (Q, Apent, Ashift,
- * Amtx, Pi2, Pi1, Mat, Mfx, Mt, Ns, Iux)
-C @@@@@@@ File 32 LRF=7 LCOMP=2, last line in LIST on IV-20
-C @@@@@@@ (two particles)
- END IF
- END DO
- END IF
- END DO
- 10 CONTINUE
-C
-C
- ELSE
C
C
C *** When particle-pairs were defined in INPut file
C *** First, check to be sure all are actually used
I_Unwanted = 0
- DO Ippair=1,Nppair
- DO Ig=1,Ngroup
- IF (Numiso.LE.0) THEN
- K_Want = 0
+ Npop = resParData%getNumParticlePair()
+ DO Ippair=1,Npop
+ DO Ig=1,resParData%getNumSpinGroups()
+ call resParData%getSpinGroupInfo(spinInfo, Ig)
+ isoIg = spinInfo%getIsotopeIndex()
+ IF (IsoIg.EQ.Misotp) THEN ! does it belong to the desired isotope
+ K_Want = 0
ELSE
- call resParData%getSpinGroupInfo(spinInfo, Ig)
- isoIg = spinInfo%getIsotopeIndex()
- IF (IsoIg.EQ.Misotp) THEN
- K_Want = 0
- ELSE
- K_Want = 1
- END IF
+ K_Want = 1
END IF
IF (K_Want.EQ.0) THEN
- DO I=1,Ntot(Ig)
- IF (Ippair.EQ.Kppair(I,Ig)) THEN
+ DO I=1,spinInfo%getNumChannels()
+ call spinInfo%getChannelInfo(channelInfo, I)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ call resParData%getChannel(channel, channelInfo)
+ IF (Ippair.EQ.
+ * channelInfo%getParticlePairIndex()) THEN
K_Want = 0
ELSE
K_Want = 1
END IF
- IF (K_Want.EQ.0) THEN
- GO TO 20
- END IF
+ IF (K_Want.EQ.0) GO TO 20
END DO
- ELSE
END IF
END DO
I_Unwanted = I_Unwanted + 1
@@ -285,7 +172,7 @@ C *** First, check to be sure all are actually used
END DO
C
C *** Next, write into ENDF files
- Npop = Nppair - I_Unwanted + 1
+ Npop = Npop - I_Unwanted + 1
Npop2 = 2*Npop
C 2 lines for each pair-of-particles
Npop26 = 6*Npop2
@@ -301,10 +188,31 @@ C @@@@@@ File 32 LRF=7 LCOMP=2, first line of first LIST on IV-20
END IF
C
C *** First pair is gamma & compound nucleus
- Ig = Misotp
+C find the first spin group for the desired isotope
+ IgIso = 0
+ DO Ig=1,resParData%getNumSpinGroups()
+ call resParData%getSpinGroupInfo(spinInfo, Ig)
+ isoIg = spinInfo%getIsotopeIndex()
+ IF (IsoIg.EQ.Misotp) THEN
+ IgIso = Ig
+ exit
+ end if
+ end do
+ if (Igiso.eq.0) then
+ STOP '[STOP in Pp7 in ndf/mndf7.f: Invalid isotope]'
+ end if
+ Ig = IgIso
+ call resParData%getSpinGroupInfo(spinInfo, Ig)
+ iela = spinInfo%getElasticChannel()
+ call spinInfo%getChannelInfo(channelInfo, iela)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ call resParData%getChannel(channel, channelInfo)
Em2 = Zero
- Em1 = Emmm1(1,Ig)/Aneutr + One
- Zz1 = Kzzz1(1,Ig)
+ Em1 = pair%getMass(2)/Aneutr + One
+ Zz1 = pair%getZa(2)
Zz2 = Zero
Sp2 = One
Sp1 = Zero
@@ -327,39 +235,41 @@ C @@@@@@ File 32 LRF=7 LCOMP=2, third line of first LIST on IV-20
END IF
C
C *** Now the particle (non-gamma) pairs
- DO Ippair=1,Nppair
- DO Ig=1,Ngroup
- IF (Numiso.LE.0) THEN
- K_Want = 0
+ DO Ippair=1,resParData%getNumParticlePair()
+ DO Ig=1,resParData%getNumSpinGroups()
+ call resParData%getSpinGroupInfo(spinInfo, Ig)
+ isoIg = spinInfo%getIsotopeIndex()
+ IF (IsoIg.EQ.Misotp) THEN ! does it belong to the desired isotope
+ K_Want = 0
ELSE
- call resParData%getSpinGroupInfo(spinInfo, Ig)
- isoIg = spinInfo%getIsotopeIndex()
- IF (IsoIg.EQ.Misotp) THEN
- K_Want = 0
- ELSE
- K_Want = 1
- END IF
+ K_Want = 1
END IF
IF (K_Want.EQ.0) THEN
C
C *** the rest of the LIST record ... pairs of particles
- Em2 = Emmm2(1,Ig)/Aneutr
- Em1 = Emmm1(1,Ig)/Aneutr
- Alabcm = - Em1/(Em1+Em2)
- DO I=1,Ntot(Ig)
- IF (Ippair.EQ.Kppair(I,Ig)) THEN
+ DO I=1,spinInfo%getNumChannels()
+ call spinInfo%getChannelInfo(channelInfo, I)
+
+ IF (Ippair.EQ.
+ * channelInfo%getParticlePairIndex()) THEN
K_Want = 0
ELSE
K_Want = 1
END IF
IF (K_Want.EQ.0) THEN
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ call resParData%getChannel(channel, channelInfo)
+
C *** next pair is SAMMY's Channel I, Spin Group Ig
- Em2 = Emmm2(I,Ig)/Aneutr
- Em1 = Emmm1(I,Ig)/Aneutr
- Zz1 = Kzzz1(I,Ig)
- Zz2 = Kzzz2(I,Ig)
- Sp1 = Spnn1(I,Ig)
- Sp2 = Spnn2(I,Ig)
+ Em2 = pair%getMass(1)/Aneutr
+ Em1 = pair%getMass(2)/Aneutr
+ Zz1 = pair%getZa(2)
+ Zz2 = pair%getZa(1)
+ Sp1 = pair%getIa(2)
+ Sp2 = pair%getIa(1)
CALL List_7a (Em2, Em1, Zz2, Zz1, Sp2, Sp1,
* Mat, Mf, Mt, Ns, Iu)
C @@@@@@ File 2 LRF=7, 2nd-last line in LIST on III-16
@@ -368,10 +278,14 @@ C @@@@@@ (two particles)
* Sp2, Sp1, Mat, Mfx, Mt, Ns, Iux)
C @@@@@@ File 32 LRF=7 LCOMP=2, 2nd-last line in LIST on
C @@@@@@ IV-20 (two particles)
- Q = Echan (I,Ig)*Alabcm
- Ashift = Ishift(I,Ig)
- Apent = Lpent (I,Ig)
- Lp = Lpent (I,Ig)
+ Q = pair%getQ()
+ if (pair%getCalcShift()) then
+ Ashift = 1
+ else
+ Ashift = 0
+ end if
+ Apent = pair%getPnt()
+ Lp = pair%getPnt()
Pi1 = Ax
Pi2 = Ax
IF (Sp1.EQ.Zero) Pi1 = One
@@ -394,9 +308,7 @@ C @@@@@@ IV-20 (two particles)
END DO
30 CONTINUE
END DO
-C
-C
- END IF
+
RETURN
END
C
diff --git a/sammy/src/ndf/mndf8.f b/sammy/src/ndf/mndf8.f
index 7df1c70821fb1aad87e89455047d7504ea7315eb..e4369406f1d6e87132fad3038a97d51b1dc41d24 100755
--- a/sammy/src/ndf/mndf8.f
+++ b/sammy/src/ndf/mndf8.f
@@ -697,7 +697,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Write_Lcomp_1 (Ntot, Unkunc,
+ SUBROUTINE Write_Lcomp_1 (Unkunc,
* Num_Res_Par, Mat, Mfx, Mt, Ns, Nsrs, Knofis, Lrf)
C
C *** PURPOSE -- Write covariance matrix in Lcomp=1 format
@@ -720,8 +720,9 @@ C
IMPLICIT DOUBLE PRECISION (a-h,o-z)
type(SammyResonanceInfo)::resN, resL
type(ResonanceCovariance)::physCov
+ type(SammySpinGroupInfo)::spinInfo
CHARACTER*1 Aaaa(78), Bbbb(66)
- DIMENSION Ntot(*), Unkunc(*)
+ DIMENSION Unkunc(*)
DIMENSION Dum(6)
DATA Zero/0.0d0/
C
@@ -742,7 +743,8 @@ C ######################################################## find Ipar ####
call resParData%getResonanceInfo(resN, N)
IF (Lrf.EQ.7) THEN
ig = resN%getSpinGroupIndex()
- Nn2 = Ntot(Ig) + 2
+ call resparData%getSpinGroupInfo(spinInfo, ig)
+ Nn2 = spinInfo%getNumChannels() + 2
ELSE
Nn2 = Ntotc2
END IF
@@ -776,7 +778,8 @@ C ######################################################## find Jpar ####
call resParData%getResonanceInfo(resL, L)
IF (Lrf.EQ.7) THEN
ig = resL%getSpinGroupIndex()
- Ll2 = Ntot(Ig) + 2
+ call resparData%getSpinGroupInfo(spinInfo, ig)
+ Ll2 = spinInfo%getNumResPar()
ELSE
Ll2 = Ntotc2
END IF
@@ -829,7 +832,8 @@ C ######################################################## find Jpar ####
call resParData%getResonanceInfo(resL, L)
IF (Lrf.EQ.7) THEN
ig = resL%getSpinGroupIndex()
- Ll2 = Ntot(Ig) + 2
+ call resparData%getSpinGroupInfo(spinInfo, ig)
+ Ll2 = spinInfo%getNumResPar()
ELSE
Ll2 = Ntotc2
END IF
diff --git a/sammy/src/ndf/mndf9.f b/sammy/src/ndf/mndf9.f
index 709fe907ea89dfff8851247ed2ff56b25ce32333..245930a8eacff42cf219fd39e9e6dc0642d08167 100644
--- a/sammy/src/ndf/mndf9.f
+++ b/sammy/src/ndf/mndf9.f
@@ -638,7 +638,7 @@ C
C
C ______________________________________________________________
C
- SUBROUTINE Findsj (Sj, Chspin, Ntotc)
+ SUBROUTINE Findsj (Sj)
C
C *** Purpose -- Determine the appropriate Sj to put into the endf file
C *** Criteria - (1) ABS(Sj) = ABS(Spinj)
@@ -651,27 +651,36 @@ C
use SammySpinGroupInfo_M
use RMatResonanceParam_M
IMPLICIT DOUBLE PRECISION (A-h,o-z)
- DIMENSION Sj(*), Chspin(Ntotc,*)
+ DIMENSION Sj(*)
type(SammySpinGroupInfo)::spinInfo
type(RMatSpinGroup)::spinGroup
+ type(SammyChannelInfo)::channelInfo
+ type(RMatChannelParams)::channel
DATA Zero /0.0d0/
C
Csmin = 100.0d0
Csmax = -100.0d0
DO I=1,resParData%getNumSpinGroups()
call resParData%getSpinGroupInfo(spinInfo, I)
- call resParData%getSpinGroup(spinGroup, spinInfo)
+ call resParData%getSpinGroup(spinGroup, spinInfo)
Sj(I) = dABS(spinGroup%getJ())
- Ccccc = dABS(Chspin(1,I))
+ iela = spinInfo%getElasticChannel()
+ call spinInfo%getChannelInfo(channelInfo, iela)
+ call resParData%getChannel(channel, channelInfo)
+ Ccccc = dABS(channel%getSch())
IF (Ccccc.GT.Csmax) Csmax = Ccccc
IF (Ccccc.LT.Csmin) Csmin = Ccccc
END DO
C
IF (Csmin.NE.Csmax) THEN
DO I=1,resParData%getNumSpinGroups()
- Ccccc = dABS(Chspin(1,I))
+ call resParData%getSpinGroupInfo(spinInfo, I)
+ iela = spinInfo%getElasticChannel()
+ call spinInfo%getChannelInfo(channelInfo, iela)
+ call resParData%getChannel(channel, channelInfo)
+ Ccccc = dABS(channel%getSch())
IF (Ccccc.LT.Csmin .OR. Ccccc.GT.Csmax) THEN
- WRITE (6,10100) Csmin, Chspin(1,I), Csmax
+ WRITE (6,10100) Csmin, channel%getSch(), Csmax
10100 FORMAT (' Csmin < Chspin < Csmax ', 3F6.1)
STOP '[STOP in Findsj in ndf/mndf9.f]'
ELSE IF (Sj(I).NE.Zero) THEN
diff --git a/sammy/src/new/SetUParameters_M.f90 b/sammy/src/new/SetUParameters_M.f90
index 25d88b82daa0025fc5c9121853d43265675846b1..d453e2fd85c65f3965c29176ac8a6778dcdd9f1f 100644
--- a/sammy/src/new/SetUParameters_M.f90
+++ b/sammy/src/new/SetUParameters_M.f90
@@ -571,7 +571,7 @@ subroutine SetUParameters_setCovarianceDefault(this, factor, &
igr = resInfo%getSpinGroupIndex()
call resParData%getSpinGroupInfo(spinInfo, igr)
- do m = 1, spinInfo%getNumChannels() + 2
+ do m = 1, spinInfo%getNumResPar()
! if gamma width and gamma width data are fitted together we use miscelleanous parameters
if( m.eq.2.and.spinInfo%getGammWidthParIndex().ne.0) cycle
diff --git a/sammy/src/new/SetUResonanceCovData.cpp b/sammy/src/new/SetUResonanceCovData.cpp
index 0d59d7ccbe46a291f88cb41dae51e0f3a6521417..9d762d2a5d78fe9fe6b9ef9b5f400b6a0e85bebd 100644
--- a/sammy/src/new/SetUResonanceCovData.cpp
+++ b/sammy/src/new/SetUResonanceCovData.cpp
@@ -17,7 +17,7 @@ namespace sammy{
SammySpinGroupInfo * spinInfo = resData.getSpinGroupInfo( resInfo->getSpinGroupIndex());
- for ( int ichan = 0 ; ichan < spinInfo->getNumChannels() + 1; ichan++){ // loop adds +1 since SAMMY does not count gamma channel in input
+ for ( int ichan = 0 ; ichan < spinInfo->getAllChannels(); ichan++){ // loop adds +1 since SAMMY does not count gamma channel in input
// if the gamma width for this group are fitted as one parameter
// there is no contribution to the fit parameters from the gamma width
if ( spinInfo->getGammWidthParIndex() > 0 && ichan == 0) continue;
@@ -39,7 +39,7 @@ namespace sammy{
resInfo->setEnergyFitOption( flag);
SammySpinGroupInfo * spinInfo = resData.getSpinGroupInfo( resInfo->getSpinGroupIndex());
- for ( int ichan = 0 ; ichan < spinInfo->getNumChannels() + 1; ichan++){
+ for ( int ichan = 0 ; ichan < spinInfo->getAllChannels(); ichan++){
// if the gamma width for this group are fitted as one parameter
// there is no contribution to the fit parameters from the gamma width
if ( spinInfo->getGammWidthParIndex() > 0 && ichan == 0){
@@ -82,14 +82,18 @@ namespace sammy{
// calculate polar fission width data if desired
double p1 = 0.0,p2 = 0.0;
if (polarFission && spinInfo->getNumChannels() >= 3){ // getNumChannels does not count gamma channel
- double b2 = redResonance->getWidth(2);
- double b3 = redResonance->getWidth(3);
+ int ifis1 = spinInfo->getFirstFissionChannel();
+ ifis1 = spinInfo->getWidthForChannel(ifis1);
+ int ifis2 = spinInfo->getSecondFissionChannel();
+ ifis2 = spinInfo->getWidthForChannel(ifis2);
+ double b2 = redResonance->getWidth(ifis1);
+ double b3 = redResonance->getWidth(ifis2);
p1 = std::atan2(b3,b2);
p2 = std::sqrt(b2 * b2 + b3 * b3);
}
- for ( int ichan = 0 ; ichan < spinInfo->getNumChannels()+ 1; ichan++){
+ for ( int ichan = 0 ; ichan < spinInfo->getAllChannels(); ichan++){
if ( resInfo->getChannelFitOption(ichan) <= 0) continue;
// if the gamma width for this group are fitted as one parameter
@@ -157,7 +161,7 @@ namespace sammy{
SammySpinGroupInfo * spinInfo = resData.getSpinGroupInfo( resInfo->getSpinGroupIndex());
- for ( int ichan = 0 ; ichan < spinInfo->getNumChannels() + 1; ichan++){
+ for ( int ichan = 0 ; ichan < spinInfo->getAllChannels(); ichan++){
if ( resInfo->getChannelFitOption(ichan) <= 0) continue;
int ipar = covData.getCovIndex(resInfo->getChannelFitOption(ichan) - 1);
if (covData.getCovariance()->getCovariance(ipar,ipar) != 0.0) continue; // already set
diff --git a/sammy/src/new/mnew0.f b/sammy/src/new/mnew0.f
index 3cf3a90a277f7437a88804fc386cc46a0b0e1d32..ca5f14e371f2a75a0b9e35a17c97c97a0aed7863 100644
--- a/sammy/src/new/mnew0.f
+++ b/sammy/src/new/mnew0.f
@@ -46,10 +46,9 @@ C
call allocate_real_data(A_Idiag, K)
C
C *** Generate proper Zke, Zkte, Zkfe, Zeta
- CALL Fxradi ( I_Intot , A_Iechan , A_Irdeff , A_Irdtru ,
- * A_Iemmm1 , A_Iemmm2 , I_Izzzz1 , I_Izzzz2 , I_Iigrra ,
- * A_Ipreff , A_Iprtru , A_Idpiso ,
- * A_Idsiso , A_Izke , A_Izkte , A_Izkfe , A_Izeta )
+ CALL Fxradi ( I_Iigrra ,
+ * A_Ipreff , A_Iprtru , A_Idpiso ,
+ * A_Idsiso , A_Izke , A_Izkte , A_Izkfe , A_Izeta )
C
call allocate_real_data(A_Iderpp, Nfpall)
Iderpp = Idimen (1 , 1, 'Iderpp Nvpres , 1') ! do delete
@@ -57,8 +56,7 @@ C
Idummy = Idimen (idum_size, 1, 'Idummy Ntotc*Nres, 1')
Kkrext = Nrext
IF (Kkrext.EQ.0) Kkrext = 1
- CALL Betset ( A_Iprbrd , I_Iflbrd , I_Intot ,
- * I_Ilpent , I_Ilspin , A_Iechan ,
+ CALL Betset ( A_Iprbrd , I_Iflbrd , A_Iechan ,
* A_Ipreff , I_Ifleff , A_Iprtru , I_Ifltru ,
* I_Ifliso , A_Iprdet , I_Ifldet ,
* A_Iprext , I_Iflext ,
@@ -114,7 +112,7 @@ C *** Read covariance data from COVariance file
C
IF (Nretro.EQ.1 .OR. Nretro.EQ.3) THEN
C *** Convert U-covariance to P-covariance
- CALL Ucov_to_Pcov (I_Iflbrd , I_Intot, A_Iderpp )
+ CALL Ucov_to_Pcov (I_Iflbrd , A_Iderpp )
END IF
C
IF (Nretro.EQ.3 .OR. Nretro.EQ.4) THEN
@@ -125,7 +123,7 @@ C *** modify all of P-covariance
C
IF (Nretro.EQ.2 .OR. Nretro.EQ.3 .OR. Nretro.EQ.4) THEN
C *** Convert P-covariance to U-covariance
- CALL Pcov_to_Ucov (I_Iflbrd , I_Intot, A_Iderpp)
+ CALL Pcov_to_Ucov (I_Iflbrd , A_Iderpp)
END IF
C
IF (Fcovin.NE.0) THEN
@@ -149,14 +147,13 @@ C *** Kompci=1 ==> reading from ENDF File32 (Lcomp=0, 1, or 2)
idum_size = resParData%getNumResonances()
Idum = Idimen (idum_size, 1, 'Nres, 1')
Idii = Idimen ((idum_size+1)/2, 1, '(Nres+1)/2, 1')
- CALL Covrdd_Endf_File32 (I_Intot ,
- * A(Idum), A(Idii), A_Idiag)
+ CALL Covrdd_Endf_File32 ( A(Idum), A(Idii), A_Idiag)
I = Idimen (Idum, -1, 'Idum, -1')
Idum = Idimen (Nvpall, 1, 'Nvpall, 1')
C *** Get_Allvr converts from ENDF-style to SAMMY-style (or vv)
- CALL Get_Allvr (I_Intot , A(Idum))
+ CALL Get_Allvr (A(Idum))
I = Idimen (Idum, -1, 'Idum, -1')
C
END IF
@@ -165,14 +162,14 @@ C *** Check to be sure all uncertainties are greater than zero
IF (Kuncer.EQ.0) CALL Checkz (A_Idiag, Nvpall)
C
C *** Convert P-covariance (physParCov) to U-covariance (uCov)
- CALL Pcov_to_Ucov ( I_Iflbrd , I_Intot , A_Iderpp)
+ CALL Pcov_to_Ucov ( I_Iflbrd , A_Iderpp)
ELSE
C
C *** Generate prior parameter covariance (both U and P) from
C *** information provided by the user
C
- CALL Rparfl ( I_Iflbrd , A_Idebrd , I_Intot , A_Ibcf ,
+ CALL Rparfl ( I_Iflbrd , A_Idebrd , A_Ibcf ,
* A_Icf2 , I_Ifleff , A_Ideeff , I_Ifltru , A_Idetru ,
* I_Ifliso , A_Ideiso , I_Ifldet , A_Idedet , I_Iflext ,
* I_Iflmsc , A_Idemsc , I_Irdmsc , I_Iflpmc , A_Idepmc ,
@@ -189,10 +186,10 @@ C
C
IF (Ipucov.EQ.1) THEN
C *** Assume U cov mtrx is diagonal; generate P-cov matrix
- CALL Ucov_to_Pcov (I_Iflbrd, I_Intot, A_Iderpp)
+ CALL Ucov_to_Pcov (I_Iflbrd, A_Iderpp)
ELSE IF (Ipucov.EQ.2) THEN
C *** Assume P cov mtrx is diagonal; generate U-cov matrix
- CALL Pcov_to_Ucov (I_Iflbrd , I_Intot , A_Iderpp)
+ CALL Pcov_to_Ucov (I_Iflbrd , A_Iderpp)
END IF
END IF
C
@@ -205,7 +202,7 @@ C
I = Idimen (Iderpp, -1, 'Iderpp, -1')
deallocate(A_Iderpp)
C *** Generate flags associated with Zke, Zkte, Zkfe
- CALL Ifxrad ( I_Intot , I_Iigrra , I_Ifleff , I_Ifltru ,
+ CALL Ifxrad (I_Iigrra , I_Ifleff , I_Ifltru ,
* I_Ifliso , I_Ifzke , I_Ifzkte , I_Ifzkfe )
C
IF (Kdropp.EQ.1) CALL Drop_Small
@@ -217,7 +214,7 @@ C *** dependent multiplier, if applicable
n_e_dep = 4*Kmax*resParData%getNumSpinGroups()
Idum = Idimen (n_e_dep, 1, 'E-Dependent Dum, 1')
Ix = Idimen (Nvpres, 1, 'X, 1')
- CALL E_Depend_Mult (I_Intot, A(Idum), A(Ix), Kmax)
+ CALL E_Depend_Mult (A(Idum), A(Ix), Kmax)
I = Idimen (Idum, -1, 'E-Dependent Dum, -1')
END IF
C
@@ -351,10 +348,8 @@ C resetFitFlags is set to true
Ifrex = Ifrel
Ifrel = 0
C write the par file but with the new fit values
- CALL Oldord ( A_Iprbrd , A(Jflbrd), A_Idebrd ,
- * I_Inent , I_Inext , I_Intot , I_Iishif ,
- * I_Ilpent , I_Ifexcl , I_Ilspin , A_Ichspi , A_Ienbnd ,
- * I_Ikppai , I_Ixclud ,
+ CALL Oldord ( A_Iprbrd , A(Jflbrd), A_Idebrd ,
+ * I_Ifexcl ,
* A_Ipreff , A(Jfleff), A_Ideeff ,
* A_Iprtru , I_Ifltru , A_Idetru , I_Iigrra ,
* A(Jfliso), A_Ideiso ,
diff --git a/sammy/src/new/mnew2.f b/sammy/src/new/mnew2.f
index 638ba1052289cac7392c9eba2387a9e918305883..99deb67b8b2779fbb40ff3e01be4c9eea471e65c 100644
--- a/sammy/src/new/mnew2.f
+++ b/sammy/src/new/mnew2.f
@@ -45,7 +45,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Ucov_to_Pcov (Iflbrd, Ntot, Derppp)
+ SUBROUTINE Ucov_to_Pcov (Iflbrd, Derppp)
C
C *** Purpose -- Determine variance on varied parameters P when
C *** have u parameter covariance from earlier SAMMY run (or somewhere else)
@@ -63,11 +63,12 @@ C
use ResonanceCovariance_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
- DIMENSION Iflbrd(*), Ntot(*), Derppp(*)
+ DIMENSION Iflbrd(*), Derppp(*)
C
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
type(ResonanceCovariance)::physCov
+ type(SammySpinGroupInfo)::spinInfo
DATA Zero /0.0d0/, Half /0.5d0/, One /1.0d0/
C
IF (Nvpall.NE.Nvpres) STOP '[STOP in Ucov_to_Pcov in new/mnew2.f]'
@@ -98,7 +99,9 @@ C *** Now convert
IF (resInfo%getEnergyFitOption().GE.0) THEN
call resParData%getResonance(resonance, resInfo)
eres = resonance%getEres()
- Mmax2 = Ntot(resInfo%getSpinGroupIndex()) + 2
+ igr = resInfo%getSpinGroupIndex()
+ call resparData%getSpinGroupInfo(spinInfo, Igr)
+ Mmax2 = spinInfo%getNumResPar()
DO Mmmm=1,Mmax2
M = Mmmm
Ix = 0
@@ -117,29 +120,19 @@ C *** Now convert
IF (P.NE.Zero) A = uVal*Half/P
Iparx = Ipar
A_Pken = A
- ELSE IF (M.EQ.2) THEN
- P = resonance%getWidth(1)
- IF (P.NE.Zero) A = uVal*Half/P
- IF (P.LT.Zero) A = -A
- ELSE IF (M.EQ.3) THEN
- P = resonance%getWidth(M-1)
- IF (P.NE.Zero) A = uVal*Half/P
- IF (P.LT.Zero) A = -A
- ELSE IF (M.GT.3 .AND. Kpolar.EQ.0) THEN
+ ELSE
P = resonance%getWidth(M-1)
IF (P.NE.Zero) A = uVal*Half/P
IF (P.LT.Zero) A = -A
- ELSE IF (M.GT.3 .AND. Kpolar.EQ.1) THEN
+ END IF
+ IF (M.GT.3 .AND. Kpolar.EQ.1) THEN
P = uVal
A = One
- ELSE
- P = Zero
- A = Zero
END IF
IF (Derppp(Ipar).NE.Zero .AND. Iparx.NE.0) THEN
Ax = - Derppp(Ipar)/A/A_Pken
END IF
- CALL Ucov_to_Pcov_J (Ntot,
+ CALL Ucov_to_Pcov_J (
* Derppp, A, Ax, Ipar,
* Iparx, Iparmn)
Iparmn = Iparmn + Ipar
@@ -160,8 +153,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Ucov_to_Pcov_J (Ntot,
- * Derppp, A, Ax, Ipar, Iparx, Iparmn)
+ SUBROUTINE Ucov_to_Pcov_J (Derppp, A, Ax, Ipar, Iparx, Iparmn)
C
C *** Called from Ucov_to_Pcov
C
@@ -175,8 +167,9 @@ C
C
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
+ type(SammySpinGroupInfo)::spinInfo
type(ResonanceCovariance)::physCov, uCov
- DIMENSION Ntot(*), Derppp(*)
+ DIMENSION Derppp(*)
DATA Zero /0.0d0/, Half /0.5d0/, One /1.0d0/
C
Jpar = 0
@@ -187,7 +180,9 @@ C
call resParData%getResonanceInfo(resInfo, K)
Jparx = 0
Kxx = K
- Mmax2 = Ntot(resInfo%getSpinGroupIndex()) + 2
+ igr = resInfo%getSpinGroupIndex()
+ call resparData%getSpinGroupInfo(spinInfo, Igr)
+ Mmax2 = spinInfo%getNumResPar()
IF (resInfo%getEnergyFitOption().GE.0) THEN
call resParData%getResonance(resonance, resInfo)
eres = resonance%getEres()
@@ -209,22 +204,13 @@ C
B = Half*uVal/P
Jparx = Jpar
B_Pken = B
- ELSE IF (L.EQ.2) THEN
- P = resonance%getWidth(1)
- B = Half*uVal/P
- IF (P.LT.Zero) B = -B
- ELSE IF (L.EQ.3) THEN
- P = resonance%getWidth(L-1)
- B = Half*uVal/P
- IF (P.LT.Zero) B = -B
- ELSE IF (L.GT.3 .AND. Kpolar.EQ.0) THEN
+ ELSE
P = resonance%getWidth(L-1)
B = Half*uVal/P
IF (P.LT.Zero) B = -B
- ELSE IF (L.GT.3 .AND. Kpolar.EQ.1) THEN
+ END IF
+ IF (L.GT.3 .AND. Kpolar.EQ.1) THEN
B = One
- ELSE
- B = Zero
END IF
covU = uCov%getCovariance(ipar, jpar)
cov = covU/(B*A)
@@ -305,4 +291,4 @@ C Uncertainty value does not change
C
deallocate(Dum1)
RETURN
- END
\ No newline at end of file
+ END
diff --git a/sammy/src/new/mnew3.f90 b/sammy/src/new/mnew3.f90
index c168620566645cbc2ee1f0991ede2eb9369e319f..3edf335d011a165bf5ff0fd0a1df22e94b3e572d 100644
--- a/sammy/src/new/mnew3.f90
+++ b/sammy/src/new/mnew3.f90
@@ -2,7 +2,7 @@
!C
!C --------------------------------------------------------------
!C
- SUBROUTINE Betset (Parbrd, Iflbrd, Ntot , Lpent , Lspin , Echan , &
+ SUBROUTINE Betset (Parbrd, Iflbrd, Echan , &
Pareff, Ifleff, Partru, Ifltru, Ifliso, Pardet, Ifldet, &
Parext, Iflext, &
Polar , Parmsc, Iflmsc, Iradms, Parpmc, Iflpmc, &
@@ -22,8 +22,8 @@
IMPLICIT DOUBLE PRECISION (a-h,o-z)
!C
EXTERNAL pf
- DIMENSION Parbrd(*), Iflbrd(*), Ntot(*), Lpent(Ntotc,*), &
- Lspin(Ntotc,*), Echan(Ntotc,*), Pareff(*), Ifleff(*), &
+ DIMENSION Parbrd(*), Iflbrd(*), &
+ Echan(Ntotc,*), Pareff(*), Ifleff(*), &
Partru(*), Ifltru(*), Ifliso(*), &
Pardet(*), Ifldet(*), &
Parext(Kkrext,Ntotc,*), Iflext(Kkrext,Ntotc,*), &
@@ -35,9 +35,9 @@
U(*), Derppp(*), Dummy(Ntotc,*)
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
+ type(SammySpinGroupInfo)::spinInfo
!C
-!C DIMENSION Parbrd(Numbrd), Iflbrd(Numbrd), Ntot(Ngroup),
-!C * Lpent(Ntotc,Ngroup), Lspin(Ntotc,Ngroup),
+!C DIMENSION Parbrd(Numbrd), Iflbrd(Numbrd),
!C * Echan(Ntotc,Ngroup), Pareff(Numrad), Ifleff(Numrad),
!C * Partru(Numrad), Ifltru(Numrad), Ifliso(Numiso),
!C * Pardet(Numdet), Ifldet(Numdet), Parext(Nrext,Ntotc,Ngroup),
@@ -65,11 +65,11 @@
IF (Kredwa.EQ.0) THEN
!C *** Partial widths are in the PAR file
!C reduced width are calculated
- CALL Betset1 (Ntot, Lpent, Lspin, Echan, Zkte, Zeta, Dummy)
+ CALL Betset1 (Echan, Zkte, Zeta, Dummy)
ELSE
!C *** Reduced width amplitudes are in the PAR file
!C partial width are calculated
- CALL Betset2 (Ntot, Lpent, Lspin, Echan, Zkte, Zeta, Dummy)
+ CALL Betset2 (Echan, Zkte, Zeta, Dummy)
END IF
!C
!C *** Generate polar parameters
@@ -77,8 +77,14 @@
DO Ires=1,Nres
call resParData%getResonanceInfo(resInfo, Ires)
call resParData%getRedResonance(resonance, resInfo)
- b2 = resonance%getWidth(3)
- b3 = resonance%getWidth(4)
+ igrp = resInfo%getSpinGroupIndex()
+ call resparData%getSpinGroupInfo(spinInfo, Igrp)
+ iFis1 = spinInfo%getFirstFissionChannel()
+ iFis1 = spinInfo%getWidthForChannel(iFis1)
+ iFis2 = spinInfo%getSecondFissionChannel()
+ iFis2 = spinInfo%getWidthForChannel(iFis2)
+ b2 = resonance%getWidth(iFis1)
+ b3 = resonance%getWidth(iFis2)
Polar(1,Ires) = dATAN2(b3, b2)
Polar(2,Ires) = dSQRT(b2**2 + b3**2)
END DO
@@ -96,9 +102,12 @@
end if
IF (resInfo%getEnergyFitOption().GE.0) THEN
call resParData%getRedResonance(resonance, resInfo)
- Mmaxc = Ntot(Igrp)
- Mmaxc2 = Mmaxc + 2
+ igrp = resInfo%getSpinGroupIndex()
+ call resparData%getSpinGroupInfo(spinInfo, Igrp)
+ Mmaxc = spinInfo%getNumChannels()
+ Mmaxc2 = spinInfo%getNumResPar()
Ddd = Zero
+ iGam = spinInfo%getGammaWidthIndex()
DO M=1,Mmaxc2
if (m.eq.1) then
ipar = resInfo%getEnergyFitOption()
@@ -119,7 +128,7 @@
Ddd = UIpar
call covData%setUParamValue(ipar, UIpar)
U(Ipar) = UIpar
- ELSE IF (M.EQ.2) THEN
+ ELSE IF (M.EQ.(iGam+1)) THEN
IF (Krdmsc.EQ.0) THEN
Knpar = Knpar + 1
IF (covData%isPupedParameter(ipar)) THEN
@@ -128,10 +137,10 @@
K1 = K1 + 1
END IF
END IF
- UIpar = resonance%getWidth(1)
+ UIpar = resonance%getWidth(iGam)
call covData%setUParamValue(ipar, UIpar)
U(Ipar) = UIpar
- ELSE IF (M.GE.3) THEN
+ ELSE
Knpar = Knpar + 1
IF (covData%isPupedParameter(ipar)) THEN
K3 = K3 + 1
@@ -139,7 +148,8 @@
K1 = K1 + 1
END IF
M2 = M - 2
- UIpar = resonance%getWidth(m2+1)
+ ichan = spinInfo%getWidthForChannel(M2)
+ UIpar = resonance%getWidth(ichan)
call covData%setUParamValue(ipar, UIpar)
U(Ipar) = UIpar
Derppp(Ipar) = Dummy(M2,Ires)
@@ -174,8 +184,9 @@
!C
IF (Nfpext.GT.0) THEN
!C *** REXTERNAL PARAMETERS
- DO Kgroup=1,Ngroup
- Mmaxc = Ntot(Kgroup)
+ DO Kgroup=1,resParData%getNumSpinGroups()
+ call resparData%getSpinGroupInfo(spinInfo, Kgroup)
+ Mmaxc = spinInfo%getNumChannels()
DO J=1,Mmaxc
IF (Iflext(1,J,Kgroup).GE.0) THEN
DO Kqq=1,Nrext
@@ -334,7 +345,7 @@
!C
!C --------------------------------------------------------------
!C
- SUBROUTINE Betset1 (Ntot, Lpent, Lspin, Echan, Zkte, Zeta, Dummy)
+ SUBROUTINE Betset1 (Echan, Zkte, Zeta, Dummy)
!C
!C *** Purpose -- Generate reduced widths when input used
!C *** partial widths not reduced width parameters
@@ -350,19 +361,25 @@
IMPLICIT DOUBLE PRECISION (a-h,o-z)
!C
EXTERNAL pf
- DIMENSION Ntot(*), Lpent(Ntotc,*), Lspin(Ntotc,*), Echan(Ntotc,*), &
+ DIMENSION Echan(Ntotc,*), &
Zkte(Ntotc,*), Zeta(Ntotc,*), Dummy(Ntotc,*)
!C
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance, resonanceRed
-
+ type(SammySpinGroupInfo)::spinInfo
+ type(SammyParticlePairInfo)::pairInfo
+ type(RMatParticlePair)::pair
+ type(RMatChannelParams)::channel
+ type(SammyChannelInfo)::channelInfo
+
DATA Zero /0.0d0/, One /1.0d0/, Halfth /5.d-4/, Four /4.0d0/
!C
Jdopha = 0
Jdoder = 0
DO Ires=1,resParData%getNumResonances()
call resParData%getResonanceInfo(resInfo, Ires)
- igrp = resInfo%getSpinGroupIndex()
+ igrp = resInfo%getSpinGroupIndex()
+ call resparData%getSpinGroupInfo(spinInfo, Igrp)
!C
!C Need to convert all parameters, even for resonances not included in the calculation
@@ -371,15 +388,23 @@
call resParData%getResonance(resonance, resInfo)
call resParData%getRedResonance(resonanceRed, resInfo)
eres = resonance%getEres()
- Mmaxc = Ntot(Igrp)
+ Mmaxc = spinInfo%getNumChannels()
Ig = Igrp
DO J=1,Mmaxc
P = One
Rho = Zero
- IF (resonance%getWidth(J+1).NE.Zero) THEN
+ ichan = spinInfo%getWidthForChannel(J)
+ IF (resonance%getWidth(ichan).NE.Zero) THEN
Ddd = Zero
- IF (Lpent(J,Ig).NE.0) THEN
- Lsp = Lspin(J,Ig)
+ call spinInfo%getChannelInfo(channelInfo, J)
+ call resParData%getChannel(channel, channelInfo)
+ call resParData%getParticlePairInfo( &
+ pairInfo, &
+ channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ call resParData%getChannel(channel, channelInfo)
+ IF (pair%getPnt().NE.0) THEN
+ Lsp = channel%getL()
Q = dABS ( eres-Echan(J,Ig) )
IF (Q.NE.Zero) THEN
Q = dSQRT(Q)
@@ -411,7 +436,7 @@
END IF
END IF
!C par file contained partial width, also calculate reduced width
- w1 = resonance%getWidth(J+1)
+ w1 = resonance%getWidth(ichan)
B1 = dSQRT(Halfth* dABS(W1)/P)
IF (W1.LT.Zero) B1 = -B1
call resonanceRed%setWidth(j+1, B1)
@@ -419,8 +444,9 @@
END IF
END DO
!C
-!C par file contained partial width, also calculate reduced width
- gga = resonance%getWidth(1)
+!C par file contained partial width, also calculate reduced width
+ ichan = spinInfo%getGammaWidthIndex()
+ gga = resonance%getWidth(ichan)
G2 = Halfth*dABS(Gga)
G1 = dSQRT(g2)
IF (Gga.LT.Zero) G1 = - G1
@@ -432,7 +458,7 @@
!C
!C --------------------------------------------------------------
!C
- SUBROUTINE Betset2 (Ntot, Lpent, Lspin, Echan, Zkte, Zeta, Dummy)
+ SUBROUTINE Betset2 (Echan, Zkte, Zeta, Dummy)
!C
!C *** Purpose -- Generate reduced width when input used
!C *** reduced width parameters not partial widths
@@ -448,11 +474,16 @@
IMPLICIT DOUBLE PRECISION (a-h,o-z)
!C
EXTERNAL pf
- DIMENSION Ntot(*), Lpent(Ntotc,*), Lspin(Ntotc,*), Echan(Ntotc,*), &
+ DIMENSION Echan(Ntotc,*), &
Zkte(Ntotc,*), Zeta(Ntotc,*), Dummy(Ntotc,*)
!C
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance, resonanceRed
+ type(SammySpinGroupInfo)::spinInfo
+ type(SammyParticlePairInfo)::pairInfo
+ type(RMatParticlePair)::pair
+ type(RMatChannelParams)::channel
+ type(SammyChannelInfo)::channelInfo
DATA Zero /0.0d0/, One /1.0d0/, Halfth /5.d-4/, Four /4.0d0/
!C
Jdopha = 0
@@ -460,6 +491,7 @@
DO Ires=1,resParData%getNumResonances()
call resParData%getResonanceInfo(resInfo, Ires)
igrp = resInfo%getSpinGroupIndex()
+ call resparData%getSpinGroupInfo(spinInfo, Igrp)
!C
!C Need to convert all parameters, even for resonances not included in the calculation
@@ -467,7 +499,7 @@
!C
call resParData%getResonance(resonance, resInfo)
call resParData%getRedResonance(resonanceRed, resInfo)
- Mmaxc = Ntot(Igrp)
+ Mmaxc = spinInfo%getNumChannels()
Ig = Igrp
factor = 1.0d0
eres = resonance%getEres()
@@ -485,10 +517,18 @@
DO J=1,Mmaxc
P = One
Rho = Zero
- IF (resonance%getWidth(J+1).NE.Zero) THEN
+ ichan = spinInfo%getWidthForChannel(j)
+ IF (resonance%getWidth(ichan).NE.Zero) THEN
Ddd = Zero
- IF (Lpent(J,Ig).NE.0) THEN
- Lsp = Lspin(J,Ig)
+ call spinInfo%getChannelInfo(channelInfo, J)
+ call resParData%getChannel(channel, channelInfo)
+ call resParData%getParticlePairInfo( &
+ pairInfo, &
+ channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ call resParData%getChannel(channel, channelInfo)
+ IF (pair%getPnt().NE.0) THEN
+ Lsp = channel%getL()
Q = dABS ( eres-Echan(J,Ig) )
IF (Q.NE.Zero) THEN
Q = dSQRT(Q)
@@ -525,7 +565,7 @@
!C Thus, we make sure that the reduced width is stored in the currect spot for
!C reduced width and the partial width in its spot.
!C
- r1 = resonance%getWidth(J+1)
+ r1 = resonance%getWidth(ichan)
call resonanceRed%setWidth(j+1, r1)
w1 = r1**2*P/Halfth
IF (r1.LT.Zero) w1 = -w1
@@ -539,12 +579,13 @@
!C Thus, we make sure that the reducued width is stored in the currect spot for
!C reduced width and the partial width in its spot.
!C
- gga = resonance%getWidth(1)
+ ichan = spinInfo%getGammaWidthIndex()
+ gga = resonance%getWidth(ichan)
call resonanceRed%setWidth(1, gga)
G2 = gga**2
Gga = G2/Halfth
- IF (resonanceRed%getWidth(1).LT.Zero) then
+ IF (resonanceRed%getWidth(ichan).LT.Zero) then
Gga = - Gga
end if
call resonance%setWidth(1, gga)
diff --git a/sammy/src/new/mnew4.f b/sammy/src/new/mnew4.f
index e926222c9cb9e23628db382960b47c466ce83b44..eb740091dcae5e17d20535d5f3017870ee598d2c 100644
--- a/sammy/src/new/mnew4.f
+++ b/sammy/src/new/mnew4.f
@@ -3,7 +3,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Rparfl (Iflbrd, Delbrd, Ntot, Bcf, Cf2,
+ SUBROUTINE Rparfl (Iflbrd, Delbrd, Bcf, Cf2,
* Ifleff, Deleff, Ifltru, Deltru,
* Ifliso, Deliso, Ifldet, Deldet, Iflext,
* Iflmsc, Delmsc, Iradms, Iflpmc, Delpmc,
@@ -45,7 +45,7 @@ C
* Runcs(Ntotc2+1,*),
* Prior(*), Ddcov(*),
* Upup(*), Pdum(*), Pupcov(*), Pdumm(*)
- integer::Iflbrd(*), Ntot(*),
+ integer::Iflbrd(*),
* Ifleff(*), Ifltru(*),
* Ifliso(*), Iflpmc(*),
* IFldet(*), Iflext(Nrext,Ntotc,*),
diff --git a/sammy/src/new/mnew6.f b/sammy/src/new/mnew6.f
index 87215d21063f16247fd8e177982d4200bb727208..8a8ee903f5489111d3cfedca990fd6c4f9e8bd43 100644
--- a/sammy/src/new/mnew6.f
+++ b/sammy/src/new/mnew6.f
@@ -27,7 +27,7 @@ C
if (resInfo%getEnergyFitOption().lt.0) cycle
call resParData%getResonance(resonance, resInfo)
call resParData%getSpinGroupInfo(spinInfo, igrp)
- Mmax2 = spinInfo%getNumChannels() + 2
+ Mmax2 = spinInfo%getNumResPar()
DO M=1,Mmax2
@@ -55,18 +55,11 @@ C
uVal = covData%getUParamValue(Ifl)
IF (M.EQ.1) THEN
P = resonance%getEres()
- ELSE IF (M.EQ.2) THEN
- P = resonance%getWidth(1)
ELSE
- IF (Kpolar.EQ.0) THEN
- P = resonance%getWidth(m-1)
- ELSE
- IF (M.EQ.3) THEN
- P = resonance%getWidth(M-1)
- ELSE
- P = uVal
- END IF
- END IF
+ P = resonance%getWidth(M-1)
+ END IF
+ IF (Kpolar.EQ.1.AND.M.GT.3) THEN
+ P = uVal
END IF
diff --git a/sammy/src/new/mnew9.f b/sammy/src/new/mnew9.f
index 7c438610372637b0dab6292e230ac8702bee4123..1f00d1ea7a6e8a255ddebe198f993406eee354ea 100644
--- a/sammy/src/new/mnew9.f
+++ b/sammy/src/new/mnew9.f
@@ -2,7 +2,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Covrdd_Endf_File32 (Ntot, Dum,
+ SUBROUTINE Covrdd_Endf_File32 (Dum,
* Idiag, Diag)
C
C *** Purpose -- Read ENDf File32 and decide whether Lcomp = 0, 1, or 2
@@ -11,8 +11,7 @@ C
use namfil_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
CHARACTER*1 A(66)
- DIMENSION Ntot(*), Dum(*),
- * Idiag(*), Diag(*)
+ DIMENSION Dum(*), Idiag(*), Diag(*)
C
N = Nvpall
N = (N*(N+1))/2
@@ -60,14 +59,14 @@ C
STOP '[STOP in Covrdd_Endf_File32 in mnew9.f # 3]'
END IF
ELSE IF (Lcomp.EQ.1) THEN
- CALL Covrdd_Lcomp_1 (Ntot, Dum, Idiag,
+ CALL Covrdd_Lcomp_1 (Dum, Idiag,
* Diag, Lrf)
ELSE IF (Lcomp.EQ.2) THEN
IF (Lrf.NE.7) THEN
- CALL Covrdd_Lcomp_2 (Ntot, Dum, Idiag, Diag,
+ CALL Covrdd_Lcomp_2 (Dum, Idiag, Diag,
* Lrf, Ndigit)
ELSE
- CALL Covrdd_Lcomp_27 (Ntot, Dum, Idiag, Diag,
+ CALL Covrdd_Lcomp_27 (Dum, Idiag, Diag,
* Igg, Ndigit)
END IF
ELSE
@@ -180,7 +179,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Covrdd_Lcomp_1 (Ntot, Dum, Idiag,
+ SUBROUTINE Covrdd_Lcomp_1 (Dum, Idiag,
* Diag, Lrf)
cx * Diag, Lrf, Igg)
C
@@ -196,8 +195,8 @@ C
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
type(ResonanceCovariance)::physCov
- DIMENSION Ntot(*), Dum(*),
- * Idiag(*), Diag(*), B(6)
+ type(SammySpinGroupInfo)::spinInfo
+ DIMENSION Dum(*), Idiag(*), Diag(*), B(6)
DATA Zero/0.0d0/, Small /0.0000001/, Thous /1000.0d0/
C
C *** Nsrs = Number of Short-Range Sections
@@ -264,7 +263,8 @@ C *** Now read # of channels, # of resonances in that spin group
if (.not.resInfo%getIncludeInCalc()) then
igr = -1 * igr
end if
- Ntotc2x = Ntot(Igr) + 2
+ call resparData%getSpinGroupInfo(spinInfo, igr)
+ Ntotc2x = spinInfo%getNumResPar()
IF (Ntotc2x.NE.Ntotcx+1) THEN
WRITE (6,10775) Ntotc2x, Ntotcx
WRITE (21,10775) Ntotc2x, Ntotcx
@@ -319,7 +319,8 @@ C
if (.not.resInfo%getIncludeInCalc()) then
igr = -1 * igr
end if
- Knofis = Ntot(Igr) + 2
+ call resparData%getSpinGroupInfo(spinInfo, igr)
+ Knofis = spinInfo%getNumResPar()
end if
Kchan = 0
Jx = 1
@@ -351,8 +352,9 @@ C *** Organize to look like SAMMY covariance matrix
igr = resInfo%getSpinGroupIndex()
if (.not.resInfo%getIncludeInCalc()) then
igr = -1 * igr
- end if
- Knofis = Ntot(Igr) + 2
+ end if
+ call resparData%getSpinGroupInfo(spinInfo, igr)
+ Knofis = spinInfo%getNumResPar()
end if
ELSE IF (Kres.GT.Nrb) THEN
Kchan = Jchan + 1
@@ -363,8 +365,9 @@ C *** Organize to look like SAMMY covariance matrix
igr = resInfo%getSpinGroupIndex()
if (.not.resInfo%getIncludeInCalc()) then
igr = -1 * igr
- end if
- Knofis = Ntot(Igr) + 2
+ end if
+ call resparData%getSpinGroupInfo(spinInfo, igr)
+ Knofis = spinInfo%getNumResPar()
end if
Kx = Jx + 1
IF (Kchan.GT.Knofis) THEN
@@ -377,8 +380,9 @@ C *** Organize to look like SAMMY covariance matrix
igr = resInfo%getSpinGroupIndex()
if (.not.resInfo%getIncludeInCalc()) then
igr = -1 * igr
- end if
- Knofis = Ntot(Igr) + 2
+ end if
+ call resparData%getSpinGroupInfo(spinInfo, igr)
+ Knofis = spinInfo%getNumResPar()
end if
END IF
Jchan = Kchan
@@ -461,7 +465,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Covrdd_Lcomp_2 (Ntot, Dum, Idiag, Diag,
+ SUBROUTINE Covrdd_Lcomp_2 (Dum, Idiag, Diag,
* Lrf, Ndigit)
C
C *** Purpose -- Read initial covariance matrix in ENDf Lcomp=2 format
@@ -476,7 +480,8 @@ C
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
type(ResonanceCovariance)::physCov
- DIMENSION Ntot(*), Dum(*), Idiag(*), Diag(*),
+ type(SammySpinGroupInfo)::spinInfo
+ DIMENSION Dum(*), Idiag(*), Diag(*),
* B(6), Mm(18)
DATA Zero/0.0d0/, Thous /1000.0d0/ Half /0.5d0/
Itu = 0
@@ -629,7 +634,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Covrdd_Lcomp_27 (Ntot, Dum, Idiag, Diag,
+ SUBROUTINE Covrdd_Lcomp_27 (Dum, Idiag, Diag,
* Igg, Ndigit)
C
C *** Purpose -- Read initial covariance matrix in ENDf Lcomp=2 format,
@@ -645,7 +650,8 @@ C
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
type(ResonanceCovariance)::physCov
- DIMENSION Ntot(*), Dum(*), Idiag(*), Diag(*),
+ type(SammySpinGroupInfo)::spinInfo
+ DIMENSION Dum(*), Idiag(*), Diag(*),
* Gn(50), dGn(50), Mm(18)
DATA Zero /0.0d0/, Thous /1000.0d0/
DATA Small /0.000001d0/
@@ -679,16 +685,18 @@ C *** Read the channel info for this group
C
C *** Find number of resonances for this spin group
READ (62,10100) Ndum, Nresg
- IF (Ntotcx.NE.Ntot(Ig)+1) THEN
- WRITE (6,10300) Ntotcx, Ntot(Ig), Ig
+ call resparData%getSpinGroupInfo(spinInfo, Ig)
+ Ntot = spinInfo%getNumChannels()
+ IF (Ntotcx.NE.Ntot+1) THEN
+ WRITE (6,10300) Ntotcx, Ntot, Ig
10300 FORMAT ('Ntotcx.NE.Ntot(Ig)+1', 10i5)
STOP '[STOP in Covrdd_Lcomp_27 in new/mnew9.f #1]'
END IF
IF (Nresg.GT.0) THEN
DO Kr=1,Nresg
Kres = Kres + 1
- READ (62,10400) E, Gg, (Gn(I),I=1,Ntot(Ig))
- READ (62,10400) dE, dGg, (dGn(I),I=1,Ntot(Ig))
+ READ (62,10400) E, Gg, (Gn(I),I=1,Ntot)
+ READ (62,10400) dE, dGg, (dGn(I),I=1,Ntot)
10400 FORMAT (6E11.1)
Dum(Kres) = E
DO Ires=Ires_Sam+1,resParData%getNumResonances()
@@ -700,7 +708,7 @@ C *** Find number of resonances for this spin group
Ires_Sam = Ires
GO TO 10
ELSE
- Ipar_Sammy = Ipar_Sammy + 2 + Ntot(Ig)
+ Ipar_Sammy = Ipar_Sammy + 2 + Ntot
END IF
END DO
10 CONTINUE
@@ -712,7 +720,7 @@ C *** Find number of resonances for this spin group
Ipar_Endf = Ipar_Endf + 1
Idiag(Ipar_Endf) = Ii
Diag(Ii) = Unc_Or_Default (dGg, Gg, 'g', Itu) * Thous
- DO I=1,Ntot(Ig)
+ DO I=1,Ntot
Ii = Ii + 1
Ipar_Endf = Ipar_Endf + 1
Idiag(Ipar_Endf) = Ii
@@ -845,7 +853,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Pcov_to_Ucov (Iflbrd, Ntot, Derppp)
+ SUBROUTINE Pcov_to_Ucov (Iflbrd, Derppp)
C
C *** PURPOSE -- Determine variance uParCov on varied parameters U when
C *** know covariance information (phys parameter Cov) from ENDF file
@@ -862,10 +870,11 @@ C
use RMatResonanceParam_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
- DIMENSION Iflbrd(*), Ntot(*), Derppp(*)
+ DIMENSION Iflbrd(*), Derppp(*)
C
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
+ type(SammySpinGroupInfo)::spinInfo
DATA Zero /0.0d0/, Half /0.5d0/, One /1.0d0/
C
IF (Nvpall.NE.Nvpres) STOP '[STOP in Pcov_to_Ucov in new/mnew9.f]'
@@ -889,7 +898,8 @@ C
IF (resInfo%getEnergyFitOption().GE.0) THEN
call resParData%getResonance(resonance, resInfo)
eres = resonance%getEres()
- Mmax2 = Ntot(Igr) + 2
+ call resparData%getSpinGroupInfo(spinInfo, igr)
+ Mmax2 = spinInfo%getNumResPar()
DO Mmmm=1,Mmax2
M = Mmmm
if (m.eq.1) then
@@ -906,27 +916,17 @@ C
P = eres
IF (P.NE.Zero) A = uVal*Half/P
Iparx = Ipar
- ELSE IF (M.EQ.2) THEN
- P = resonance%getWidth(1)
- IF (P.LT.Zero) P = -P
- IF (P.NE.Zero) A = uVal*Half/P
- ELSE IF (M.EQ.3) THEN
- P = resonance%getWidth(M-1)
- IF (P.LT.Zero) P = -P
- IF (P.NE.Zero) A = uVal*Half/P
- ELSE IF (M.GT.3 .AND. Kpolar.EQ.0) THEN
+ ELSE
P = resonance%getWidth(M-1)
IF (P.LT.Zero) P = -P
IF (P.NE.Zero) A = uVal*Half/P
- ELSE IF (M.GT.3 .AND. Kpolar.EQ.1) THEN
+ END IF
+ IF (M.GT.3 .AND. Kpolar.EQ.1) THEN
P = uVal
A = One
- ELSE
- P = Zero
- A = Zero
END IF
Ax = Derppp(Ipar)
- CALL Pcov_to_Ucov_J (Ntot,
+ CALL Pcov_to_Ucov_J (
* Derppp, A, Ax, Ipar,
* Iparx, Iparmn)
Iparmn = Iparmn + Ipar
@@ -948,7 +948,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Pcov_to_Ucov_J (Ntot,
+ SUBROUTINE Pcov_to_Ucov_J (
* Derppp, A, Ax, Ipar, Iparx, Iparmn)
C
C *** called from Pcov_to_Ucov
@@ -963,8 +963,9 @@ C
C
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
+ type(SammySpinGroupInfo)::spinInfo
type(ResonanceCovariance)::physCov, uCov
- DIMENSION Ntot(*), Derppp(*)
+ DIMENSION Derppp(*)
DATA Zero /0.0d0/, Half /0.5d0/, One /1.0d0/
C
call covData%getCovariance(physCov)
@@ -980,7 +981,8 @@ C
Jparx = 0
Kxx = K
- Mmax2 = Ntot(Igr) + 2
+ call resparData%getSpinGroupInfo(spinInfo, Igr)
+ Mmax2 = spinInfo%getNumResPar()
IF (resInfo%getEnergyFitOption().GE.0) THEN
call resParData%getResonance(resonance, resInfo)
eres = resonance%getEres()
@@ -1004,26 +1006,13 @@ C
P = eres
B = Half*uVal/P
Jparx = Jpar
- ELSE IF (L.EQ.2) THEN
- P = resonance%getWidth(1)
- IF (P.LT.Zero) P = -P
- B = Half*uVal/P
- ELSE IF (L.EQ.3) THEN
+ ELSE
P = resonance%getWidth(L-1)
IF (P.LT.Zero) P = -P
- B = Half*uVal/P
- ELSE IF (L.GT.3 .AND. Kpolar.EQ.0) THEN
- P = resonance%getWidth(L-1)
- IF (P.NE.Zero) THEN
- IF (P.LT.Zero) P = -P
- B = Half*uVal/P
- ELSE
- B = Zero
- END IF
- ELSE IF (L.GT.3 .AND. Kpolar.EQ.1) THEN
+ IF (P.NE.ZERO) B = Half*uVal/P
+ END IF
+ IF (L.GT.3 .AND. Kpolar.EQ.1) THEN
B = One
- ELSE
- B = Zero
END IF
covP = physCov%getCovariance(ipar,jpar)
cov = A*covP*B
diff --git a/sammy/src/ntg/mntg2.f b/sammy/src/ntg/mntg2.f
index 8ced2499b37ba7def75b3d7da5c969f4a359f690..e4435a4e154eb14344b4ba7259cf6c7d52fc695d 100644
--- a/sammy/src/ntg/mntg2.f
+++ b/sammy/src/ntg/mntg2.f
@@ -88,7 +88,7 @@ C *** J = 1 Kountr=1+Many*(Iso-1) thermal cross section
* Vdbsig, Isopar, Kdatb, Numntg, Iso, Kountr)
C
C *** Findem locates the highest energy at which there is a resonance
- CALL Findem (I_Intot , Resmax)
+ CALL Findem (Resmax)
C
C *** J = 2 Maxwellian average
C *** Kountr = J + Many*(Iso-1) [+2 if fissile]
diff --git a/sammy/src/ntg/mntg3.f b/sammy/src/ntg/mntg3.f
index 44823046e798cfb93a96d0ef6b488f98c3eebe04..87e20ed7c817287dcfdb2890fd4b67ef8c3def24 100644
--- a/sammy/src/ntg/mntg3.f
+++ b/sammy/src/ntg/mntg3.f
@@ -124,7 +124,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Findem (Ntot, Resmax)
+ SUBROUTINE Findem (Resmax)
C
C *** Purpose ... find maximum energy for influence from resonances
C
@@ -135,12 +135,12 @@ C
use RMatResonanceParam_M
IMPLICIT none
type(SammyResonanceInfo)::resInfo
+ type(SammySpinGroupInfo)::spinInfo
type(RMatResonance)::resonance
- integer:: Ntot(*)
real(kind=8)::Resmax
real(kind=8)::Rrrmax,eres, E, Width
- integer::I, J, Ntotci
+ integer::I, J, Ntotci, igr
C
Rrrmax = 0.0d0
DO I=1,resParData%getNumResonances()
@@ -148,8 +148,10 @@ C
call resParData%getResonance(resonance, resInfo)
eres = resonance%getEres()
IF (eres.LE.Emax .AND. eres.GE.Emin) THEN
- Width = resonance%getWidth(1)
- Ntotci = Ntot(resInfo%getSpinGroupIndex())
+ Width = 0.0d0
+ igr = resInfo%getSpinGroupIndex()
+ call resParData%getSpinGroupInfo(spinInfo, igr)
+ Ntotci = spinInfo%getAllChannels()
DO J=1,Ntotci
Width = Width + dABS(resonance%getWidth(J+1))
END DO
diff --git a/sammy/src/old/mold0.f b/sammy/src/old/mold0.f
index 47f8431a6e9aafa38f7ed82ba04d8b940dd9323d..bfc3245e2cfe5731ac6d4dc408ad772562ca9af5 100644
--- a/sammy/src/old/mold0.f
+++ b/sammy/src/old/mold0.f
@@ -106,17 +106,16 @@ C *** dependent multiplier, if applicable
CALL Get_E_Dep (Kmax)
Idum = Idimen (4*Kmax*Ngroup, 1, 'E-Dependent Dum, 1')
Ix = Idimen (Nvpres, 1, 'X, 1')
- CALL E_Depend_Mult (I_Intot, A(Idum), A(Ix), Kmax)
+ CALL E_Depend_Mult (A(Idum), A(Ix), Kmax)
I = Idimen (Idum, -1, 'E-Dependent Dum, -1')
END IF
C
C *** Generate proper Zke, Zkte, Zkfe, Zeta
- CALL Fxradi ( I_Intot , A_Iechan , A_Irdeff , A_Irdtru ,
- * A_Iemmm1 , A_Iemmm2 , I_Izzzz1 , I_Izzzz2 , I_Iigrra ,
- * A_Ipreff , A_Iprtru , A_Idpiso ,
- * A_Idsiso , A_Izke , A_Izkte , A_Izkfe , A_Izeta )
+ CALL Fxradi ( I_Iigrra ,
+ * A_Ipreff , A_Iprtru , A_Idpiso ,
+ * A_Idsiso , A_Izke , A_Izkte , A_Izkfe , A_Izeta )
C *** Generate associated flags
- CALL Ifxrad ( I_Intot , I_Iigrra , I_Ifleff , I_Ifltru ,
+ CALL Ifxrad (I_Iigrra , I_Ifleff , I_Ifltru ,
* I_Ifliso , I_Ifzke , I_Ifzkte , I_Ifzkfe )
C
C *** Organized PUPs
@@ -138,8 +137,8 @@ C
Ix = Idimen (K, 1, 'X K, 1')
Iy = Idimen (K, 1, 'Y K, 1')
Ikntr = Idimen (K, 1, 'Kntr K, 1')
- CALL Addup ( I_Ilspin ,
- * A_Izkte , A_Igoj , A(Iallvr),
+ CALL Addup (
+ * A_Izkte , A(Iallvr),
* A(Idiag), A(Id ), A(Ix ), A(Iy ), A(Ikntr ))
C *** Sub routine Addup calculates the summed strength function
STOP
@@ -204,8 +203,7 @@ C
call allocate_real_data(A_Ipupcv, Nn)
Kkrext = Nrext
IF (Kkrext.EQ.0) Kkrext = 1
- CALL Bet_Pup( A_Iprbrd , I_Iflbrd , I_Intot ,
- * I_Ilpent , I_Ilspin , A_Iechan ,
+ CALL Bet_Pup( A_Iprbrd , I_Iflbrd , A_Iechan ,
* A_Ipreff , I_Ifleff , A_Iprtru , I_Ifltru ,
* I_Ifliso , A_Iprdet , I_Ifldet ,
* A_Iprext , I_Iflext ,
@@ -216,7 +214,7 @@ C
* A_Iprdtp , I_Ifldtp , A_Izkte , A_Izeta ,
* A_Iupupx , Kkrext)
CALL Rparfl_Pup (I_Iflbrd , A_Idebrd ,
- * I_Intot , A_Ibcf , A_Icf2 ,
+ * A_Ibcf , A_Icf2 ,
* I_Ifleff , A_Ideeff , I_Ifltru , A_Idetru ,
* I_Ifliso , A_Ideiso , I_Ifldet , A_Idedet , I_Iflext ,
* A_Iprmsc , I_Iflmsc , A_Idemsc , I_Irdmsc ,
diff --git a/sammy/src/old/mold1.f b/sammy/src/old/mold1.f
index 8bf0b0d24bcd66fa58e6d6a26b79036963990faa..9a8b6cbeff7817d95e5f29031d45c9170c437bcb 100644
--- a/sammy/src/old/mold1.f
+++ b/sammy/src/old/mold1.f
@@ -2,9 +2,8 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Fxradi (Ntot, Echan, Rdeff, Rdtru, Emmm1, Emmm2,
- * Kzzz1, Kzzz2, Igrrad, Pareff, Partru, Dopwid,
- * Doswid, Zke, Zkte, Zkfe, Zeta)
+ SUBROUTINE Fxradi (Igrrad, Pareff, Partru, Dopwid,
+ * Doswid, Zke, Zkte, Zkfe, Zeta)
C
C *** Purpose -- Fix the following parameters:
C *** Zke , where k = Zke * sqrt(E)
@@ -22,13 +21,16 @@ C
use SammySpinGroupInfo_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
- DIMENSION Ntot(*), Echan(Ntotc,*), Rdeff(Ntotc,*), Rdtru(Ntotc,*),
- * Emmm1(Ntotc,*), Emmm2(Ntotc,*), Kzzz1(Ntotc,*), Kzzz2(Ntotc,*),
+ DIMENSION
* Igrrad(Ntotc,*), Pareff(*), Partru(*),
* Dopwid(*), Doswid(*), Zkte(Ntotc,*), Zkfe(Ntotc,*),
* Zke(Ntotc,*), Zeta(Ntotc,*)
C
type(SammySpinGroupInfo)::spinInfo
+ type(SammyParticlePairInfo)::pairInfo
+ type(RMatParticlePair)::pair
+ type(SammyChannelInfo)::channelInfo
+ type(RMatChannelParams)::channel
DATA Zero /0.0d0/
C
IF (A_Mass_Small.NE.Aneutr) THEN
@@ -43,21 +45,26 @@ C
CALL Zero_Array (Zeta, Ntotc*Ngroup)
C
IF (Numiso.GT.0) THEN
- DO Kgroup=1,Ngroup
- Ntotnn = Ntot(Kgroup)
+ DO Kgroup=1,resParData%getNumSpinGroups()
call resParData%getSpinGroupInfo(spinInfo, Kgroup)
+ Ntotnn = spinInfo%getNumChannels()
Kgriso = spinInfo%getIsotopeIndex()
IF (Kgriso.NE.0) THEN
DO Ichan=1,Ntotnn
- IF (Emmm1(Ichan,Kgroup).EQ.Zero) THEN
- Emmm1(Ichan,Kgroup) =
- * resParData%getMassForIsotope(Kgriso)
- END IF
- IF (Emmm2(Ichan,Kgroup).EQ.Zero) THEN
- Emmm2(Ichan,Kgroup) = Aneutr
- ELSE
- IF (Ichan.EQ.1) A_Mass_Small = Emmm2(Ichan,Kgroup)
+ call spinInfo%getChannelInfo(channelInfo, Ichan)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ IF (Ichan.EQ.1) A_Mass_Small = pair%getMass(1)
+
+ IF (pair%getMass(2).EQ.Zero) THEN
+ call pair%setMass(2,
+ * resParData%getMassForIsotope(Kgriso))
END IF
+ IF (pair%getMass(1).EQ.Zero) THEN
+ call pair%setMass(1,Aneutr)
+ end if
END DO
END IF
END DO
@@ -82,16 +89,22 @@ C
C *** here Numiso.EQ.0
Dopwid(1) = Dopple
Doswid(1) = Dosind
- DO Kgroup=1,Ngroup
- Ntotnn = Ntot(Kgroup)
+ DO Kgroup=1,resParData%getNumSpinGroups()
+ call resParData%getSpinGroupInfo(spinInfo, Kgroup)
+ Ntotnn = spinInfo%getNumChannels()
DO Ichan=1,Ntotnn
- IF (Emmm1(Ichan,Kgroup).EQ.Zero) THEN
- Emmm1(Ichan,Kgroup) = Aaawww
- END IF
- IF (Emmm2(Ichan,Kgroup).EQ.Zero) THEN
- Emmm2(Ichan,Kgroup) = Aneutr
- ELSE
- IF (Ichan.EQ.1) A_mass_Small = Emmm2(Ichan,Kgroup)
+ call spinInfo%getChannelInfo(channelInfo, Ichan)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ IF (Ichan.EQ.1) A_mass_Small = pair%getMass(1)
+
+ IF (pair%getMass(2).EQ.Zero) THEN
+ call pair%setMass(2, Aaawww)
+ end if
+ IF (pair%getMass(1).EQ.Zero) THEN
+ call pair%setMass(1,Aneutr)
END IF
END DO
END DO
@@ -106,15 +119,31 @@ C *** February 2003 How do we ensure that we don't do this more than once?
C
C
- DO Kgroup=1,Ngroup
- Ntotnn = Ntot(Kgroup)
- Factor = Emmm1(1,Kgroup) + Emmm2(1,Kgroup)
- Alabcm = Emmm1(1,Kgroup)/Factor
- Factor = Alabcm/Emmm2(1,Kgroup)
+ DO Kgroup=1,resParData%getNumSpinGroups()
+ call resParData%getSpinGroupInfo(spinInfo, Kgroup)
+ Ntotnn = spinInfo%getNumChannels()
+
+ iela = spinInfo%getElasticChannel()
+ call spinInfo%getChannelInfo(channelInfo, iela)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ Factor = pair%getMass(2) + pair%getMass(1)
+ Alabcm = pair%getMass(2)/Factor
+ Factor = Alabcm/pair%getMass(1)
DO Ichan=1,Ntotnn
- Aa = Emmm1(Ichan,Kgroup) + Emmm2(Ichan,Kgroup)
- Aa = Emmm1(Ichan,Kgroup)/Aa
- Redmas = Aa * Emmm2(Ichan,Kgroup)
+ call spinInfo%getChannelInfo(channelInfo, Ichan)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ call resParData%getChannel(channel, channelInfo)
+
+ Aa = pair%getMass(2) + pair%getMass(1)
+ Aa = pair%getMass(2)/Aa
+ Redmas = Aa * pair%getMass(1)
+
Zke(Ichan,Kgroup) = Twomhb * dSQRT(Redmas*Factor)
IF (Numrad.GT.0) THEN
Kgrrad = Igrrad(Ichan,Kgroup)
@@ -123,14 +152,14 @@ C
ELSE
At = Crfn
Af = Crfn
- IF (Rdtru(Ichan,Kgroup).NE.Zero) At = Rdtru(Ichan,Kgroup)
- IF (Rdeff(Ichan,Kgroup).NE.Zero) Af = Rdeff(Ichan,Kgroup)
+ IF (channel%getApt().NE.Zero) At = channel%getApt()
+ IF (channel%getApe().NE.Zero) Af = channel%getApe()
Zkte(Ichan,Kgroup) = Zke(Ichan,Kgroup)*At
Zkfe(Ichan,Kgroup) = Zke(Ichan,Kgroup)*Af
END IF
- IF (Kzzz1(Ichan,Kgroup).NE.0 .AND. Kzzz2(Ichan,Kgroup).NE.0)
+ IF (pair%getZa(2).NE.0 .AND. pair%getZa(1).NE.0)
& THEN
- Docoul = Dfloat(Kzzz1(Ichan,Kgroup)*Kzzz2(Ichan,Kgroup))
+ Docoul = Dfloat(pair%getZa(2)*pair%getZa(1))
Zeta(Ichan,Kgroup) = Etac*Docoul*Redmas/Zke(Ichan,Kgroup)
ELSE
END IF
@@ -144,7 +173,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Ifxrad (Ntot, Igrrad, Iffeff, Ifftru, Iffiso,
+ SUBROUTINE Ifxrad (Igrrad, Iffeff, Ifftru, Iffiso,
* If_Zke , If_Zkte, If_Zkfe)
C
C *** Purpose -- Fix the following flags:
@@ -159,7 +188,6 @@ C
use SammySpinGroupInfo_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
- DIMENSION Ntot(*)
DIMENSION Igrrad(Ntotc,*), Iffeff(*), Ifftru(*), Iffiso(*)
DIMENSION If_Zke(Ngroup), If_Zkte(Ntotc,Ngroup), If_Zkfe(Ntotc,*)
C
@@ -171,7 +199,7 @@ C
C
C
IF (Numiso.GT.0) THEN
- DO Kgroup=1,Ngroup
+ DO Kgroup=1,resparData%getNumSpinGroups()
call resParData%getSpinGroupInfo(spinInfo, Kgroup)
Kgriso = spinInfo%getIsotopeIndex()
IF (Kgriso.EQ.0) GO TO 10
@@ -182,8 +210,9 @@ C
C
IF (Numrad.GT.0) THEN
C *** Here Numiso.GT.0 and Numrad.GT.0
- DO Kgroup=1,Ngroup
- Ntotnn = Ntot(Kgroup)
+ DO Kgroup=1,resparData%getNumSpinGroups()
+ call resParData%getSpinGroupInfo(spinInfo, Kgroup)
+ Ntotnn = spinInfo%getNumChannels()
DO Ichan=1,Ntotnn
Kgrrad = Igrrad(Ichan,Kgroup)
IF (Ifftru(Kgrrad).GT.0) If_Zkte(Ichan,Kgroup) =
@@ -195,8 +224,9 @@ C *** Here Numiso.GT.0 and Numrad.GT.0
C
ELSE
C *** Here Numiso.GT.0 but Numrad.EQ.0
- DO Kgroup=1,Ngroup
- Ntotnn = Ntot(Kgroup)
+ DO Kgroup=1,resparData%getNumSpinGroups()
+ call resParData%getSpinGroupInfo(spinInfo, Kgroup)
+ Ntotnn = spinInfo%getNumChannels()
DO Ichan=1,Ntotnn
IF (Kvcrfn.NE.0) IF_Zkte(Ichan,Kgroup) = Kvcrfn
IF (Kvcrfn.NE.0) IF_Zkfe(Ichan,Kgroup) = Kvcrfn
@@ -207,8 +237,9 @@ C
ELSE
IF (Numrad.GT.0) THEN
C *** Here Numiso.EQ.0 but Numrad.GT.0
- DO Kgroup=1,Ngroup
- Ntotnn = Ntot(Kgroup)
+ DO Kgroup=1,resparData%getNumSpinGroups()
+ call resParData%getSpinGroupInfo(spinInfo, Kgroup)
+ Ntotnn = spinInfo%getNumChannels()
DO Ichan=1,Ntotnn
Kgrrad = Igrrad(Ichan,Kgroup)
IF (Ifftru(Kgrrad).GT.0) IF_Zkte(Ichan,Kgroup) =
@@ -221,8 +252,9 @@ C
ELSE
C
C *** Here Numiso.EQ.0 and Numrad.EQ.0
- DO Kgroup=1,Ngroup
- Ntotnn = Ntot(Kgroup)
+ DO Kgroup=1,resparData%getNumSpinGroups()
+ call resParData%getSpinGroupInfo(spinInfo, Kgroup)
+ Ntotnn = spinInfo%getNumChannels()
DO Ichan=1,Ntotnn
IF (Kvcrfn.GT.0) IF_Zkte(Ichan,Kgroup) = Kvcrfn
IF (Kvcrfn.GT.0) IF_Zkfe(Ichan,Kgroup) = Kvcrfn
@@ -235,7 +267,7 @@ C
C *** Set Kvprrt & Kvprrf = 0 if no flags, 1 if any are varied
Kvprrt = 0
Kvprrf = 0
- DO Kgroup=1,Ngroup
+ DO Kgroup=1,resparData%getNumSpinGroups()
DO Ichan=1,Ntotc
IF (If_Zkte(Ichan,Kgroup).NE.0) THEN
Kvprrt = 1
@@ -244,7 +276,7 @@ C *** Set Kvprrt & Kvprrf = 0 if no flags, 1 if any are varied
END DO
END DO
20 CONTINUE
- DO Kgroup=1,Ngroup
+ DO Kgroup=1,resparData%getNumSpinGroups()
DO Ichan=1,Ntotc
IF (IF_Zkfe(Ichan,Kgroup).NE.0) THEN
Kvprrf = 1
@@ -313,15 +345,12 @@ C
END IF
C
C
- IF (Kreduc.NE.0) CALL Outred ( A_Igoj ,
- * I_Intot , I_Ilspin , A_Ichspi , N)
+ IF (Kreduc.NE.0) CALL Outred (N)
C
IF (Kreduc.NE.0 .AND. Ksolve.NE.2 .AND. Kgenpd.EQ.0) CALL Outvr (
* A(Idump))
C
- IF (Kmlbw.NE.0) CALL Outmlb ( A_Igoj ,
- * I_Intot , I_Iishif , I_Ilspin , A_Ibound , A_Iechan ,
- * A_Izkte , N)
+ IF (Kmlbw.NE.0) CALL Outmlb (A_Ibound , A_Iechan ,A_Izkte , N)
C
I = Idimen (Idump, -1, 'Idump, -1')
RETURN
diff --git a/sammy/src/old/mold4.f90 b/sammy/src/old/mold4.f90
index 0170323a214a9c81f6c6cdfddc3e372566e55374..05a3dfdc7e4fa5ef8f9eef76b47de5453d95948c 100644
--- a/sammy/src/old/mold4.f90
+++ b/sammy/src/old/mold4.f90
@@ -502,7 +502,7 @@ END SUBROUTINE
!
! --------------------------------------------------------------
!
- SUBROUTINE E_Depend_Mult_int (Ntot, Dum, Xx, Kmax)
+ SUBROUTINE E_Depend_Mult_int (Dum, Xx, Kmax)
! *** Purpose -- Read E-dependent initial uncertainty multiplier file,
! *** modify initial covariance matrix appropriately
use fixedi_m
@@ -519,13 +519,13 @@ END SUBROUTINE
Integer :: Kmax, Iflr, Jpar, J, Ires, Ipar
Integer :: Ij, Ii, Igr, I, Mmax, Mmax2, M, Kpound, Kk, K
Double precision :: Dd, E2, E1, E, X1, X2, X, Xxx, cov, covU
- Integer, Dimension(*) :: Ntot
Double Precision, Dimension(4,Kmax,*) :: Dum
Double Precision, Dimension(*) :: Xx
Double Precision, Parameter :: Zero = 0.0d0
Double Precision, Parameter :: One = 1.0d0
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
+ type(SammySpinGroupInfo)::spinInfo
type(ResonanceCovariance)::physCov, uCov
! DATA Zero /0.0d0/, One /1.0d0/
@@ -608,8 +608,9 @@ END SUBROUTINE
END IF
END DO
50 CONTINUE
- Mmax = Ntot(Igr)
- Mmax2 = Mmax + 2
+ call resparData%getSpinGroupInfo(spinInfo, Igr)
+ Mmax = spinInfo%getNumChannels()
+ Mmax2 = spinInfo%getNumResPar()
Iflr = resInfo%getEnergyFitOption()
IF (Iflr.GT.0 .AND. Iflr.LE.Nfpres) THEN
Ipar = Ipar + 1
@@ -856,7 +857,7 @@ END MODULE mold4_m
-SUBROUTINE E_Depend_Mult (Ntot, Dum, Xx, Kmax)
+SUBROUTINE E_Depend_Mult (Dum, Xx, Kmax)
! *** Purpose -- Read E-dependent initial uncertainty multiplier file,
! *** modify initial covariance matrix appropriately
! INCLUDE 'B23ZYX'
@@ -867,7 +868,6 @@ SUBROUTINE E_Depend_Mult (Ntot, Dum, Xx, Kmax)
Integer :: Kmax, Iflr, Jpar, J, Ires, Ipar
Integer :: Ij, Ii, Igr, I, Mmax, Mmax2, M, Kpound, Kk, K
Double precision :: Dd, E2, E1, E, X1, X2, X, Xxx
- Integer, Dimension(*) :: Ntot
Double Precision, Dimension(4,Kmax,*) :: Dum
Double Precision, Dimension(*) :: Xx
Double Precision, Parameter :: Zero = 0.0d0
@@ -875,6 +875,6 @@ SUBROUTINE E_Depend_Mult (Ntot, Dum, Xx, Kmax)
! DATA Zero /0.0d0/, One /1.0d0/
- Call E_Depend_Mult_int(Ntot, Dum, Xx, Kmax)
+ Call E_Depend_Mult_int(Dum, Xx, Kmax)
END SUBROUTINE
diff --git a/sammy/src/old/mold7.f b/sammy/src/old/mold7.f
index e85c51010f8fd8ab9cf9397e93502b84a9f9a4b6..51b9654c9ae430aeab11b2eeb4e303552262d153 100644
--- a/sammy/src/old/mold7.f
+++ b/sammy/src/old/mold7.f
@@ -51,7 +51,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Addup (Lspin, Zkte, Goj,
+ SUBROUTINE Addup (Zkte,
* Vx, V, De, X, Y, Kntr)
C
C *** PURPOSE -- OUTPUT SUMMED STRENGTHS AND COVARIANCE MATRIX
@@ -70,7 +70,10 @@ C
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
type(ResonanceCovariance)::physCov, uCov
- DIMENSION Lspin(Ntotc,*), Zkte(Ntotc,*), Goj(*),
+ type(SammySpinGroupInfo)::spinInfo
+ type(RMatChannelParams)::channel
+ type(SammyChannelInfo)::channelInfo
+ DIMENSION Zkte(Ntotc,*),
* Vx(*), V(*), De(*), X(*), Y(*), Kntr(*)
C
DATA Zero /0.0d0/, One /1.0d0/, Two /2.0d0/
@@ -87,16 +90,31 @@ C
IF (Ngrp.EQ.0 .OR. Ngrp.GT.Ngroup) GO TO 100
C
C
+ call resParData%getSpinGroupInfo(spinInfo, Ngrp)
+ gojNgrp = spinInfo%getGFactor()
+ iela = spinInfo%getElasticChannel()
+ call spinInfo%getChannelInfo(channelInfo, iela)
+ call resParData%getChannel(channel, channelInfo)
+ LspinNgrp = channel%getL()
+
IF (Ngrp2.GT.0) THEN
- IF (Lspin(1,Ngrp).NE.Lspin(1,Ngrp2)) THEN
- WRITE (21,10200) Lspin(1,Ngrp), Lspin(1,Ngrp2)
+ IF (Ngrp2.EQ.0 .OR. Ngrp2.GT.Ngroup) GO TO 100
+ call resParData%getSpinGroupInfo(spinInfo, Ngrp2)
+ gojNgrp2 = spinInfo%getGFactor()
+ iela = spinInfo%getElasticChannel()
+ call spinInfo%getChannelInfo(channelInfo, iela)
+ call resParData%getChannel(channel, channelInfo)
+ LspinNgrp2 = channel%getL()
+
+ IF (LspinNgrp.NE.LspinNgrp2) THEN
+ WRITE (21,10200) LspinNgrp, LspinNgrp2
10200 FORMAT (' Spin groups', I3, ' and', I3,
* ' do not have same orbital angular momentum --',
* ' Lspin(1,', I3, ')=', I3, ' and Lspin(1,', I3, ')=',
* I3)
STOP '[STOP in Addup in old/mold7.f]'
ELSE
- WRITE (21,10300) Ngrp, Ngrp2, Emina, Emaxa, Lspin(1,Ngrp)
+ WRITE (21,10300) Ngrp, Ngrp2, Emina, Emaxa, LspinNgrp
10300 FORMAT (/,
* ' Summed strengths for resonances in spin groups',
* 2I3, /, ' in energy range from', 1PG14.6,
@@ -104,7 +122,7 @@ C
* I2)
END IF
ELSE
- WRITE (21,10400) Ngrp, Emina, Emaxa, Lspin(1,Ngrp)
+ WRITE (21,10400) Ngrp, Emina, Emaxa, LspinNgrp
10400 FORMAT (/,' Summed strengths for resonances in spin group',
* I3, /, ' in energy range from', 1PG14.6, ' to',G14.6,
* /, ' with orbital angular momentum =', I2)
@@ -114,10 +132,10 @@ C
10500 FORMAT (8X, 'ENERGY', 26X, 'SUMMED', /, 8X, 'MAXIMUM', 8X,
* 'STRENGTH', 9X, 'STRENGTH', 7X, 'Uncertainty')
C
- Out = One / (Lspin(1,Ngrp)+0.5d0)
- Out1 = Goj(Ngrp ) * Zkte(1,Ngrp ) * Out
+ Out = One / (LspinNgrp+0.5d0)
+ Out1 = gojNgrp * Zkte(1,Ngrp ) * Out
IF (Ngrp2.GT.0) THEN
- Out2 = Goj(Ngrp2) * Zkte(1,Ngrp2) * Out
+ Out2 = gojNgrp2 * Zkte(1,Ngrp2) * Out
ELSE
Out2 = Out1
END IF
diff --git a/sammy/src/old/mold8.f b/sammy/src/old/mold8.f
index 2c10df489fe30b53268f395a60ba8f4690e22718..3ce4264c2d4d539d6defca5c63bfc2fd8c835a6f 100644
--- a/sammy/src/old/mold8.f
+++ b/sammy/src/old/mold8.f
@@ -2,7 +2,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Rparfl_Pup (Iflbrd, Delbrd, Ntot, Bcf, Cf2,
+ SUBROUTINE Rparfl_Pup (Iflbrd, Delbrd,Bcf, Cf2,
* Ifleff, Deleff, Ifltru, Deltru,
* Ifliso, Deliso, Ifldet, Deldet, Iflext,
* Parmsc, Iflmsc, Delmsc, Iradms, Iflpmc, Delpmc,
@@ -27,7 +27,7 @@ C
type(SetUParameters)::covarianceSetter
type(ResonanceCovariance)::physCov, uCov
logical(C_BOOL)::haveUParam
- DIMENSION Iflbrd(*), Delbrd(*), Ntot(*), Bcf(*), Cf2(*),
+ DIMENSION Iflbrd(*), Delbrd(*),Bcf(*), Cf2(*),
* Ifleff(*), Deleff(*), Ifltru(*), Deltru(*),
* Ifliso(*), Deliso(*),
* IFldet(*), Deldet(*), Iflext(Nrext,Ntotc,*),
@@ -40,7 +40,7 @@ C
* Diag(*), Pupcov(*), Runcs(Ntotc2+1,*), Juncs(Ntotc2,*),
* Prior(*), Iprior(*), Jprior(Ntotc2,*) ,Parmsc(*)
C
-C DIMENSION Iflbrd(Numbrd), Ntot(Ngroup), Bcf(Ncf), Cf2(Ncf),
+C DIMENSION Iflbrd(Numbrd), Bcf(Ncf), Cf2(Ncf),
C * Ifleff(Numrad), Deleff(Numrad), Ifltru(Numrad), Deltru(Numrad),
C * IFliso(Numiso), Deliso(Numiso),
C * IFldet(Numdet), Deldet(Numdet),
diff --git a/sammy/src/old/mold9.f b/sammy/src/old/mold9.f
index ad2aea22167593046c1cf08fdf69b9772061828f..ba048e3af3cac3a9cc516de8ef32616d72362cfc 100644
--- a/sammy/src/old/mold9.f
+++ b/sammy/src/old/mold9.f
@@ -7,7 +7,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Bet_Pup (Parbrd, Iflbrd, Ntot , Lpent , Lspin , Echan ,
+ SUBROUTINE Bet_Pup (Parbrd, Iflbrd, Echan ,
* Pareff, Ifleff, Partru, Ifltru, Ifliso, Pardet, Ifldet,
* Parext, Iflext,
* Polar , Parmsc, Iflmsc, Iradms, Parpmc, Iflpmc, Parorr,
@@ -27,8 +27,8 @@ C
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
EXTERNAL pf
- DIMENSION Parbrd(*), Iflbrd(*), Ntot(*), Lpent(Ntotc,*),
- * Lspin(Ntotc,*), Echan(Ntotc,*), Pareff(*), Ifleff(*),
+ DIMENSION Parbrd(*), Iflbrd(*),
+ * Echan(Ntotc,*), Pareff(*), Ifleff(*),
* Partru(*), Ifltru(*), Ifliso(*),
* Pardet(*), Ifldet(*),
* Parext(Kkrext,Ntotc,*), Iflext(Kkrext,Ntotc,*),
@@ -59,8 +59,9 @@ C *** First -- resonance parameters
call resParData%getRedResonance(resonance, resInfo)
igr = resInfo%getSpinGroupIndex()
- Mmaxc = Ntot(Igr)
- Mmaxc2 = Mmaxc + 2
+ call resparData%getSpinGroupInfo(spinInfo, Igr)
+ Mmaxc = spinInfo%getNumChannels()
+ Mmaxc2 = spinInfo%getNumResPar()
DO M=1,Mmaxc2
if (m.eq.1) then
ifl = resInfo%getEnergyFitOption()
@@ -93,17 +94,22 @@ C *** First -- resonance parameters
IF (eres.LT.Zero) Upup(Knpar) =
* - Upup(Knpar)
call covData%setUParamValue(keep,Upup(Knpar))
- ELSE IF (M.EQ.2) THEN
- Upup(Knpar) = resonance%getWidth(1)
- call covData%setUParamValue(keep,Upup(Knpar))
- ELSE IF (M.GE.3) THEN
- M2 = M - 2
- Upup(Knpar) = resonance%getWidth(m2+1)
- IF (.NOT.(Kpolar.EQ.0 .OR. M2.EQ.1)) THEN
- IF (M2.EQ.2) Upup(Knpar) = Polar(1,Ires)
- IF (M2.EQ.3) Upup(Knpar) = Polar(2,Ires)
+ ELSE
+ iChan = m - 1 ! m=1 is energy, reset are channels
+ Upup(Knpar) = resonance%getWidth(iChan)
+ IF (Kpolar.EQ.1) then
+ iFis1 = spinInfo%getFirstFissionChannel()
+ iFis1 = spinInfo%getWidthForChannel(iFis1)
+ iFis2 = spinInfo%getSecondFissionChannel()
+ iFis2 = spinInfo%getWidthForChannel(iFis2)
+ IF (iChan.EQ.iFis1) then
+ Upup(Knpar)=Polar(1,Ires)
+ end if
+ IF (iChan.EQ.iFis2) then
+ Upup(Knpar)=Polar(2,Ires)
+ end if
END IF
- call covData%setUParamValue(keep,Upup(Knpar))
+ call covData%setUParamValue(keep,Upup(Knpar))
END IF
END IF
END IF
@@ -115,7 +121,8 @@ C
IF (Nfpext.GT.0) THEN
C *** R_external parameters
DO Kgroup=1,Ngroup
- Mmaxc = Ntot(Kgroup)
+ call resparData%getSpinGroupInfo(spinInfo, Kgroup)
+ Mmaxc = spinInfo%getNumChannels()
DO J=1,Mmaxc
IF (Iflext(1,J,Kgroup).GE.0) THEN
DO Kqq=1,Nrext
diff --git a/sammy/src/par/mpar0.f b/sammy/src/par/mpar0.f
index afaa8d4456cb71dc59c9a9bf141770fc1766029c..f2e8b9a53bd7acbc8869b548ea3e841bbb9140ec 100644
--- a/sammy/src/par/mpar0.f
+++ b/sammy/src/par/mpar0.f
@@ -46,7 +46,7 @@ C
C *** Routine Estpar guestimates size of array needed for PAR module
C
C
- CALL Set3a (I_Intot , I_Ilspin , Lmax)
+ CALL Set3a (Lmax)
C *** Routine Set3a sets dimensions for resonance parameters
C
Kumpup = Numpup
@@ -64,11 +64,10 @@ C
allocate(I_tmp(itotsize))
I_tmp(:) = 0
CALL Parfil ( A_Iprbrd , I_Iflbrd , A_Isiabn ,
- * A_Igoj , I_Intot , A_Ispinx , I_Ilspin , I_Ikppai ,
* A_Ipreff , I_Ifleff , A_Ideeff ,
* A_Iprtru , I_Ifltru , A_Idetru , I_Iigrra ,
* I_Ifliso , A_Ideiso ,
- * A_Ispiso , I_Ixclud , I_Ixciso ,
+ * A_Ispiso , I_Ixciso ,
* A_Iprdet , I_Ifldet , A_Idedet , I_Iigrde ,
* A_Iprext , I_Iflext ,
* A_Iprmsc , I_Iflmsc , A_Idemsc , I_Irdmsc , I_Ijkmsc ,
@@ -100,9 +99,7 @@ C
C *** Routine Fixabn sets Abundances to 1 for all spin groups, if
C *** integral quantities are being calculated
C
- IF (Numrad.NE.0) CALL Radfix (I_Intot , I_Iishif , I_Ilspin ,
- * A_Ienbnd , A_Ibound , I_Iigrra , A_Iprtru , I_Izzzz1 ,
- * I_Izzzz2 , A_Iemmm1 , A_Iemmm2 )
+ IF (Numrad.NE.0) CALL Radfix (A_Ibound , I_Iigrra , A_Iprtru)
C *** Routine Radfix fixes "Bound" for the case where radii are
C *** different for different spin groups and/or channels
C *** Note cannot use zkte & zke here, because these are not yet set
@@ -111,12 +108,12 @@ C
Numpup = Kumpup
Nunit = 21
IF (Kdecpl.NE.0) CALL Outddc (Nunit)
- CALL Order ( I_Intot , A_Iprmsc , I_Irdmsc , A_Iddcov)
+ CALL Order (A_Iprmsc , I_Irdmsc , A_Iddcov)
C *** Sub routine Order reorders resonances according to J-Pi groups
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - >
C
IF (Kpolar.EQ.1.AND. Nres.NE.0) CALL Fixpol (I_Iflpol )
- CALL Fix (I_Intot , I_Iflbrd , I_Ifleff , I_Ifltru , I_Ifliso ,
+ CALL Fix (I_Iflbrd , I_Ifleff , I_Ifltru , I_Ifliso ,
* I_Ifldet , I_Iflext , I_Iflmsc ,
* I_Irdmsc , I_Iflpmc , I_Iflorr , I_Iflrpi , I_Iflnbk ,
* I_Iflbgf , I_Ifldtp , I_Iflusd , Nnrext)
diff --git a/sammy/src/par/mpar01.f b/sammy/src/par/mpar01.f
index 880dbacb4ebf09ab474509a9e0a37cbcd07e167e..1520a99e758801edbe6622744734319b0cd03ad0 100644
--- a/sammy/src/par/mpar01.f
+++ b/sammy/src/par/mpar01.f
@@ -19,19 +19,29 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Set3a (Ntot, Lspin, Lmax)
+ SUBROUTINE Set3a (Lmax)
C
use fixedi_m
use ifwrit_m
use exploc_common_m
use broad_common_m
+ use SammyResonanceInfo_M
+ use EndfData_common_m
+ use RMatResonanceParam_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
- DIMENSION Ntot(*), Lspin(Ntotc,*)
+ type(SammySpinGroupInfo)::spinInfo
+ type(RMatChannelParams)::channel
+ type(SammyChannelInfo)::channelInfo
C
Lmax = 0
- DO Ig=1,Ngroup
- DO Ic=1,Ntot(Ig)
- IF (Lspin(Ic,Ig).GT.Lmax) Lmax = Lspin(Ic,Ig)
+ DO Ig=1,resParData%getNumSpinGroups()
+ call resParData%getSpinGroupInfo(spinInfo, Ig)
+ DO Ic=1,spinInfo%getNumChannels()
+ call spinInfo%getChannelInfo(channelInfo, Ic)
+ call resParData%getChannel(channel, channelInfo)
+ IF (channel%getL().GT.Lmax) then
+ Lmax = channel%getL()
+ end if
END DO
END DO
Lmax = Lmax + 1
diff --git a/sammy/src/par/mpar02.f b/sammy/src/par/mpar02.f
index 68cce171b80a9cd52ceca9cc4705516fe8d33c4a..9ab6dd82984763081f75c7b7c78fefccf4e10721 100644
--- a/sammy/src/par/mpar02.f
+++ b/sammy/src/par/mpar02.f
@@ -4,10 +4,9 @@ C *** THIS FILE CONTAINS ROUTINES FOR READING "PARAMETER" FILE
C
C --------------------------------------------------------------
C
- SUBROUTINE Parfil (Parbrd, Iflbrd, Siabnd, Goj, Ntot,
- * Spinx , Lspin , Kppair,
+ SUBROUTINE Parfil (Parbrd, Iflbrd, Siabnd,
* Pareff, Ifleff, Deleff, Partru, Ifltru, Deltru, Igrrad,
- * Ifliso, Deliso, Spniso, Ixclud, Ixciso,
+ * Ifliso, Deliso, Spniso, Ixciso,
* Pardet, Ifldet, Deldet, Igrdet,
* Parext, Iflext, Parmsc, Iflmsc, Delmsc, Iradms, Ijkmsc,
* Znonu , Rnonu , Anonu , Bnonu ,
@@ -37,11 +36,10 @@ C
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
DIMENSION Parbrd(*), Iflbrd(*), Siabnd(*),
- * Goj(*), Ntot(*), Spinx(*), Lspin(Ntotc,*), Kppair(*),
* Pareff(*), Ifleff(*), Deleff(*), Partru(*), Ifltru(*),
* Deltru(*), Igrrad(Ntotc,*),
* Ifliso(*), Deliso(*),
- * Spniso(*), Ixclud(*), Ixciso(*),
+ * Spniso(*), Ixciso(*),
* Pardet(*), Ifldet(*), Deldet(*), Igrdet(*),
* Parext(Nnrext,Ntotc,*), Iflext(Nnrext,Ntotc,*),
* Parmsc(*), Iflmsc(*), Delmsc(*), Iradms(*), Ijkmsc(*),
@@ -63,12 +61,10 @@ C
* Kprior(Ntotc2,*), Lprior(*)
C
C DIMENSION Parbrd(Numbrd), Iflbrd(Numbrd),
-C * Siabnd(Ngroup), Goj(Ngroup), Ntot (Ngroup),
-C * Spinx(Ngroup) , Pareff(Numrad), Ifleff(Numrad),
+C * Siabnd(Ngroup), Pareff(Numrad), Ifleff(Numrad),
C * Partru(Numrad), Ifltru(Numrad), Igrrad(Ntotc,Ngroup),
C * Ifliso(Numiso), Deliso(Numiso),
-C * Spniso(Numiso),
-C * Ixclud(Ngroup), Ixciso(Numiso),
+C * Spniso(Numiso), Ixciso(Numiso),
C * Pardet(Numdet), Ifldet(Numdet),
C * Deldet(Numdet), Igrdet(Ngroup),
C * Parext(Nrext,Ntotc,Ngroup) , Iflext(Nrext,Ntotc,Ngroup),
@@ -132,13 +128,12 @@ C
ELSE IF (Alfnm1.EQ.Radius .OR. Alfnm1.EQ.Radiii .OR.
* Alfnm1.EQ.Channe) THEN
C *** card set 7 "Radii" or "Channel Radii"
- CALL Readrd (Parbrd, Ntot, Lspin, Kppair, Pareff, Ifleff,
+ CALL Readrd (Parbrd, Pareff, Ifleff,
* Deleff, Partru, Ifltru, Deltru, Igrrad, Lrad, Lmax)
C
ELSE IF (Alfnm1.EQ.Xisoto .OR. Alfnm1.EQ.Xnucli) THEN
C *** card set 10 "Nuclide" or "Isotopic Abundance"
- CALL Readis (Goj, Spinx, Ifliso, Deliso,
- * Spniso, Ixclud, Ixciso, Iu32)
+ CALL Readis (Ifliso, Deliso, Spniso, Ixciso, Iu32)
C
ELSE IF (Alfnm1.EQ.Broade) THEN
C *** card set 4 "Broadening parameters"
@@ -252,7 +247,7 @@ C
ELSE IF (Alfnm1.EQ.Prioru) THEN
C *** last card set, "prior" alternative (Key-Word format)
C *** (called "Last D" in Table VIB.1 in manual)
- CALL Readpr (Ntot, Lspin, Kppair, Prior,
+ CALL Readpr (Prior,
* Iprior, Jprior, Kprior, Lprior, Alfn80, Lmax, Nprior)
C
ELSE IF (Alfnm1.EQ.Relunc .AND. Nuncer.GT.0) THEN
diff --git a/sammy/src/par/mpar03.f b/sammy/src/par/mpar03.f
index 95cd4f16e0a25b6ffa47f6a8ba070051f7b9ce18..6f67723bf781145dc218624a5b175a242ff34a94 100644
--- a/sammy/src/par/mpar03.f
+++ b/sammy/src/par/mpar03.f
@@ -218,7 +218,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Readrd (Parbrd, Ntot, Lspin, Kppair, Pareff, Ifleff,
+ SUBROUTINE Readrd (Parbrd, Pareff, Ifleff,
* Deleff, Partru, Ifltru, Deltru, Igrrad, Lrad, Lmax)
C
C *** Card Set 7
@@ -230,9 +230,12 @@ C
use misccc_common_m
use partyp_common_m
use par_parameter_names_common_m
+ use EndfData_common_m
+ use SammyResonanceInfo_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
- DIMENSION Parbrd(*), Ntot(*), Lspin(Ntotc,*), Kppair(Ntotc,*),
+ type(SammySpinGroupInfo)::spinInfo
+ DIMENSION Parbrd(*),
* Pareff(*), Ifleff(*), Deleff(*),
* Partru(*), Ifltru(*), Deltru(*), Igrrad(Ntotc,*), Lrad(*)
DIMENSION Iss(28), Jss(1003)
@@ -254,7 +257,7 @@ C
C *** Note that Find_Key_Word may change Alfnm1, so "END IF" and new "IF"
END IF
IF (Alfnm1.EQ.Channe) THEN
- CALL Rd_Rad_Key_Word (Ntot, Lspin, Kppair, Pareff, Ifleff,
+ CALL Rd_Rad_Key_Word (Pareff, Ifleff,
* Deleff, Partru, Ifltru, Deltru, Igrrad, Dumnam,
* Lrad, Alfnum, I_Rad, Ntotc, Nnniso, Nppair, Lmax, Numrad,
* Ngroup, Iu32)
@@ -380,7 +383,8 @@ C
IF (Iwrong.GT.0) STOP '[STOP in Readrd in par/mpar03.f # 5]'
C
DO N=1,Ngroup
- Ntot_N = Ntot(N)
+ call resparData%getSpinGroupInfo(spinInfo,N)
+ Ntot_N = spinInfo%getNumChannels()
DO Ich=1,Ntot_N
IF (Igrrad(Ich,N).EQ.0) THEN
DO K=1,Ngroup
@@ -422,8 +426,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Readis (Goj, Spinx, Ifliso, Deliso,
- * Spniso, Ixclud, Ixciso, Kfile)
+ SUBROUTINE Readis (Ifliso, Deliso, Spniso, Ixciso, Kfile)
C
C *** Card Set 10
C *** PURPOSE -- Read isotopic (nuclide) parameters -- mass and
@@ -442,12 +445,11 @@ C
use RMatResonanceParam_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
-C DIMENSION Goj(Ngroup), Spinx(Ngroup),
+C DIMENSION
C * Ifliso(Numiso), Deliso(Numiso),
-C * Spniso(Numiso),
-C * Ixclud(Ngroup), Ixciso(Numiso)
- DIMENSION Goj(*), Spinx(*), Ifliso(*),
- * Deliso(*), Spniso(*), Ixclud(*), Ixciso(*)
+C * Spniso(Numiso), Ixciso(Numiso)
+ DIMENSION Ifliso(*),
+ * Deliso(*), Spniso(*), Ixciso(*)
DIMENSION Iss(24), Jss(1003)
EQUIVALENCE (Iss(1),Jss(1))
@@ -547,9 +549,10 @@ C
Iso = spinInfo%getIsotopeIndex()
IF (Iso.EQ.N) THEN
IF (Ix.EQ.0) THEN
- Spniso(N) = Spinx(Iso)
+ Spniso(N) = spinInfo%getTargetSpin()
Ix = 1
- ELSE IF (Ix.NE.0 .AND. Spinx(Iso).NE.Spniso(N)) THEN
+ ELSE IF (Ix.NE.0 .AND.
+ * spinInfo%getTargetSpin().NE.Spniso(N)) THEN
WRITE (6,99995)
99995 FORMAT (' #### All spin groups belonging to the same',
* 1X, 'isotope must have same Spinx ####')
@@ -566,7 +569,7 @@ C
DO I=1,Ngroup
call resParData%getSpinGroupInfo(spinInfo, I)
Iso = spinInfo%getIsotopeIndex()
- IF (Ixclud(I).EQ.0) Ixciso(Iso) = 0
+ IF (spinInfo%getIncludeInCalc()) Ixciso(Iso) = 0
END DO
C *** Note that Ixciso(Iso)=1 means exclude this isotope completely
C
diff --git a/sammy/src/par/mpar10.f b/sammy/src/par/mpar10.f
index 0f517fd3e4d007444b27bb679a2006e8f3553bea..24609481ed5d464515970638e89d985cd75a0c15 100755
--- a/sammy/src/par/mpar10.f
+++ b/sammy/src/par/mpar10.f
@@ -176,7 +176,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Readpr (Ntot, Lspin, Kppair, Prior,
+ SUBROUTINE Readpr (Prior,
* Iprior, Jprior, Kprior, Lprior, Alfn80, Lmax, Nprior)
C *** Read resonance parameter uncertainties in key-word format
use fixedi_m
@@ -187,11 +187,12 @@ C *** Read resonance parameter uncertainties in key-word format
use EndfData_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
type(SammyResonanceInfo)::resInfo
+ type(SammySpinGroupInfo)::spinInfo
CHARACTER*80 File
CHARACTER*1 Alfn80(80), Alfn80_Orig(80)
CHARACTER*8 Name, Prinam
- DIMENSION Ntot(*), Lspin(Ntotc,*),
- * Kppair(Ntotc,*), Prior(*), Iprior(*), Jprior(Ntotc2,*),
+ DIMENSION
+ * Prior(*), Iprior(*), Jprior(Ntotc2,*),
* Kprior(Ntotc2,*), Lprior(*)
C * Kprior(Ntotc2,Ngroup), Lprior(Lmax)
EQUIVALENCE (File, Alfn80_Orig)
@@ -258,7 +259,7 @@ C
ELSE IF (Alfn80(I).EQ.'R' .AND. Alfn80(I+1).EQ.'E' .AND.
* Alfn80(I+2).EQ.'L' .AND. Alfn80(I+3).EQ.'A') THEN
C *** Here the key-word is "relative uncertainty"
- IF (Iprio.GT.0) CALL Group_To_Resonance (Ntot,
+ IF (Iprio.GT.0) CALL Group_To_Resonance (
* Jprior, Kprior, Lprior, Pmin, Pmax, Iprio,
* Lmax)
Istart = Istart + 4
@@ -274,7 +275,7 @@ C
* (Alfn80(I).EQ.'U' .AND. Alfn80(I+1).EQ.'N' .AND.
* Alfn80(I+2).EQ.'C' .AND. Alfn80(I+3).EQ.'E'))THEN
C *** Here the key-word is "absolute unc" or "uncertainty"
- IF (Iprio.GT.0) CALL Group_To_Resonance (Ntot,
+ IF (Iprio.GT.0) CALL Group_To_Resonance (
* Jprior, Kprior, Lprior, Pmin, Pmax, Iprio,
* Lmax)
Istart = Istart + 2
@@ -314,7 +315,7 @@ C *** Here the key-word is "Particle-Pair" or "PP"
CALL Set_Nam (Name, Alfn80, Ia, Ib, Ierr)
IF (Name.EQ.'ENERGY ' .OR. Name.EQ.'GAMMA ') THEN
Prinam = Name
- CALL Move_To_Ke (Ntot, Kprior, Prinam, Iprio)
+ CALL Move_To_Ke (Kprior, Prinam, Iprio)
END IF
C
ELSE IF ((Alfn80(I).EQ.'L' .AND. Alfn80(I+1).EQ.'=') .OR.
@@ -328,19 +329,18 @@ C *** (These must be the last values on the line)
IF (Iprio.EQ.0)
* STOP '[Iprio.EQ.0 in Readpr in par/mpar10.f]'
CALL Get_L (Lprior, Alfn80, Istart, Istop, Ierr, Lmax)
- CALL Move_To_K (Ntot, Lspin, Kppair,
- * Kprior, Prinam, Lprior, Lmax, Iprio)
+ CALL Move_To_K (Kprior, Prinam, Lprior, Lmax, Iprio)
C
ELSE IF (Alfn80(I).EQ.'G' .AND. Alfn80(I+1).EQ.'R') THEN
C *** Here the key-word is "GRoup"
CALL Get_Group (Ig, Alfn80, Istart, Istop, Ierr,
* Ngroup)
- CALL Get_Channel (Ntot, Kprior, Alfn80, Istart,
+ CALL Get_Channel (Kprior, Alfn80, Istart,
* Istop, Ierr, Ntotc2, Ig, Iprio)
C
ELSE IF (Alfn80(I).EQ.'C' .AND. Alfn80(I+1).EQ.'H') THEN
C *** Here the key-word is "CHannel"
- CALL Get_Channel (Ntot, Kprior, Alfn80, Istart,
+ CALL Get_Channel (Kprior, Alfn80, Istart,
* Istop, Ierr, Ntotc2, Ig, Iprio)
C
ELSE
@@ -361,15 +361,16 @@ C
40 CONTINUE
IF (Iprio.NE.Nprior)
* STOP '[Iprio.NE.Nprior in Readpr in par/mpar10.f]'
- IF (Iprio.GT.0) CALL Group_To_Resonance (Ntot,
+ IF (Iprio.GT.0) CALL Group_To_Resonance (
* Jprior, Kprior, Lprior, Pmin, Pmax, Iprio, Lmax)
C
C *** Reorganize to put energy & gamma width ahead of particle-widths
C *** Note that Lprior is a dummy here
DO Ires=1,Nres
call resParData%getResonanceInfo(resInfo, Ires)
- Ig = resInfo%getSpinGroupIndex()
- Nchan = Ntot(Ig)
+ Ig = resInfo%getSpinGroupIndex()
+ call resparData%getSpinGroupInfo(spinInfo,ig)
+ Nchan = spinInfo%getNumChannels()
DO Ich=1,Nchan
Lprior(Ich) = Jprior(Ich,Ires)
END DO
@@ -397,7 +398,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Group_To_Resonance (Ntot, Jprior,
+ SUBROUTINE Group_To_Resonance (Jprior,
* Kprior, Lprior, Pmin, Pmax, Iprio, Lmax)
C *** Convert from Kprior to Jprior to take care of Emin,Emax
C *** Zero temporary arrays to restart
@@ -410,11 +411,12 @@ C *** Zero temporary arrays to restart
use EndfData_common_m
IMPLICIT NONE
- integer Ntot(*), Jprior(Ntotc2,*), Kprior(Ntotc2,*), Lprior(Lmax)
+ integer Jprior(Ntotc2,*), Kprior(Ntotc2,*), Lprior(Lmax)
real(kind=8)::Pmin, Pmax
integer::Iprio, Lmax
type(SammyResonanceInfo)::resInfo
+ type(SammySpinGroupInfo)::spinInfo
type(RMatResonance)::resonance
real(kind=8)::Zero, ener
integer::ires, kp, nchan2, I, ig
@@ -427,7 +429,8 @@ C
Ig = resInfo%getSpinGroupIndex()
ener = resonance%getEres()
- Nchan2 = Ntot(Ig) + 2
+ call resparData%getSpinGroupInfo(spinInfo,ig)
+ Nchan2 = spinInfo%getNumResPar()
DO I=1,Nchan2
IF (Jprior(I,Ires).EQ.0) THEN
Kp = Kprior(I,Ig)
@@ -451,18 +454,22 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Move_To_Ke (Ntot, Kprior, Prinam, Iprio)
+ SUBROUTINE Move_To_Ke (Kprior, Prinam, Iprio)
C *** Convert from Prinam=ENERGY or GAMMA to Kprior
use fixedi_m
+ use EndfData_common_m
+ use SammyParticlePairInfo_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
CHARACTER*8 Prinam
- DIMENSION Ntot(*), Kprior(Ntotc2,*)
+ type(SammySpinGroupInfo)::spinInfo
+ DIMENSION Kprior(Ntotc2,*)
C
- DO Ig=1,Ngroup
+ DO Ig=1,resParData%getNumSpinGroups()
+ call resParData%getSpinGroupInfo(spinInfo, Ig)
IF (Prinam.EQ.'ENERGY ') THEN
- Ich = Ntot(Ig) + 1
+ Ich = spinInfo%getAllChannels()
ELSE IF (Prinam.EQ.'GAMMA ') THEN
- Ich = Ntot(Ig) + 2
+ Ich = spinInfo%getNumResPar()
ELSE
STOP '[STOP in Move_To_Ke in mpar10.f]'
END IF
@@ -477,7 +484,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Move_To_K (Ntot, Lspin, Kppair, Kprior, Prinam, Lprior,
+ SUBROUTINE Move_To_K (Kprior, Prinam, Lprior,
* Lmax, Iprio)
C *** Convert from Lprior+Prinam to Kprior
use fixedi_m
@@ -487,17 +494,24 @@ C *** Convert from Lprior+Prinam to Kprior
IMPLICIT DOUBLE PRECISION (a-h,o-z)
CHARACTER*8 Name, Prinam
type(SammyParticlePairInfo)::pairInfo
+ type(SammySpinGroupInfo)::spinInfo
+ type(RMatParticlePair)::pair
+ type(RMatChannelParams)::channel
+ type(SammyChannelInfo)::channelInfo
character(len=8)::pname
- DIMENSION Ntot(*), Lspin(Ntotc,*), Kppair(Ntotc,*),
- * Kprior(Ntotc2,*), Lprior(Lmax)
-C
- DO Ig=1,Ngroup
- DO Ich=1,Ntot(Ig)
- Kpp = Kppair(Ich,Ig)
+ DIMENSION Kprior(Ntotc2,*), Lprior(Lmax)
+C
+ DO Ig=1,resParData%getNumSpinGroups()
+ call resParData%getSpinGroupInfo(spinInfo, Ig)
+ DO Ich=1,spinInfo%getNumChannels()
+ call spinInfo%getChannelInfo(channelInfo, Ich)
+ call resParData%getChannel(channel, channelInfo)
+
+ Kpp = channelInfo%getParticlePairIndex()
call resParData%getParticlePairInfo(pairInfo,Kpp)
call pairInfo%getName(pname)
Name = pname
- Lsp = Lspin (Ich,Ig)
+ Lsp = channel%getL()
Kpr = Kprior(Ich,Ig)
IF (Kpr.EQ.0) THEN
IF (Prinam.EQ.' ') GO TO 50
diff --git a/sammy/src/par/mpar11.f b/sammy/src/par/mpar11.f
index a94c75f7778d0f0fc1615473dab1a313db8850bf..50eec0786e89f0a098d56caa822d1c2dfc04b9c5 100644
--- a/sammy/src/par/mpar11.f
+++ b/sammy/src/par/mpar11.f
@@ -2,50 +2,69 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Radfix (Ntot, Ishift, Lspin, Enbnd, Bound, Igrrad,
- * Partru, Kzzz1, Kzzz2, Emmm1, Emmm2)
+ SUBROUTINE Radfix (Bound, Igrrad, Partru)
C
use sammy_CoulombSelector_I
use fixedi_m
use ifwrit_m
use fixedr_m
use constn_common_m
+ use SammyResonanceInfo_M
+ use EndfData_common_m
+ use RMatResonanceParam_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
EXTERNAL Sf
C
-C DIMENSION Ntot(Ngroup), Ishift(Ntotc,Ngroup), Lspin(Ntotc,Ngroup),
-C * Enbnd(Ntotc,Ngroup), Bound(Ntotc,Ngroup), Igrrad(Ntotc,Ngroup),
+C DIMENSION Ntot(Ngroup),
+C * Bound(Ntotc,Ngroup), Igrrad(Ntotc,Ngroup),
C * Partru(Numrad)
- DIMENSION Ntot(*), Ishift(Ntotc,*), Lspin(Ntotc,*),Enbnd(Ntotc,*),
- * Bound(Ntotc,*), Igrrad(Ntotc,*), Partru(*)
- DIMENSION Kzzz1(Ntotc,*), Kzzz2(Ntotc,*),
- * Emmm1(Ntotc,*), Emmm2(Ntotc,*)
+ type(SammySpinGroupInfo)::spinInfo
+ type(SammyParticlePairInfo)::pairInfo
+ type(RMatParticlePair)::pair
+ type(RMatChannelParams)::channel
+ type(SammyChannelInfo)::channelInfo
+ DIMENSION Bound(Ntotc,*), Igrrad(Ntotc,*), Partru(*)
C
Jdopha = 0
Jdoder = 0
C
DATA Zero /0.0d0/
C
- DO J=1,Ngroup
- Ntotj = Ntot(j)
+ DO J=1,resParData%getNumSpinGroups()
+ call resParData%getSpinGroupInfo(spinInfo, J)
+ Ntotj = spinInfo%getNumChannels()
DO N=1,Ntotj
+ call spinInfo%getChannelInfo(channelInfo, N)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ call resParData%getChannel(channel, channelInfo)
+ enbnd = channel%getBnd()
Bound(N,J) = Zero
- IF (Ishift(N,J).NE.0) THEN
- IF (Enbnd(N,J).GT.Zero) THEN
+
+ IF (pair%getCalcShift()) THEN
+ IF (Enbnd.GT.Zero) THEN
Cycrfn = Cayt*Partru(Igrrad(N,J))
- Docoul = dfloat(Kzzz1(N,J)*Kzzz2(N,J))
+ Docoul = dfloat(pair%getZa(1)*pair%getZa(2))
IF (Docoul.EQ.Zero) THEN
- Bound(N,J) = Sf(Cycrfn*dSQRT(Enbnd(N,J)),
- * Lspin(N,J), Zero)
+ Bound(N,J) = Sf(Cycrfn*dSQRT(Enbnd),
+ * channel%getL(), Zero)
ELSE
- L = Lspin(N,J)
- Rho = Cycrfn * dSQRT(Enbnd(N,J))
- Rhox = Cayt * dSQRT(Enbnd(N,J))
- A1 = Emmm1(N,J)
- A2 = Emmm2(N,J)
+ L = channel%getL()
+ Rho = Cycrfn * dSQRT(Enbnd)
+ Rhox = Cayt * dSQRT(Enbnd)
+ A1 = pair%getMass(2)
+ A2 = pair%getMass(1)
Eta = Etac*Docoul*(A1*A2)/(A1+A2)/Rhox
+
+ if (pair%getCalcShift()) then
+ Ishift = 1
+ else
+ Ishift = 0
+ end if
CALL f_sammy_columb_Pspcou (kwcoul,
- & Rho, L, Eta, Ishift(N,J),
+ & Rho, L, Eta, Ishift,
& Jdopha,
& Jdoder, Ifail, Pent, Shift, Der, Dshift,
& Sinphi, Cosphi, Dphi)
@@ -56,9 +75,9 @@ C
10000 FORMAT (' RADFIX: PSPCOUL ERROR: Ifail = ')
END IF
END IF
- ELSE IF (Enbnd(N,J).LT.Zero) THEN
- Bound(N,J) = Enbnd(N,J)
- ELSE IF (Lspin(N,J).NE.0) THEN
+ ELSE IF (Enbnd.LT.Zero) THEN
+ Bound(N,J) = Enbnd
+ ELSE IF (channel%getL().NE.0) THEN
STOP '[STOP -- must have Enbnd.NE.0 when Shift]'
END IF
END IF
@@ -144,7 +163,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Order (Ntot, Parmsc, Iradms, Ddcov)
+ SUBROUTINE Order (Parmsc, Iradms, Ddcov)
C
C *** Purpose -- Reorder resonance parameters by energy (low to high) and
C *** by J-pi groups
@@ -160,7 +179,7 @@ C
use EndfData_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
- DIMENSION Ntot(*),
+ DIMENSION
* Parmsc(*),
* Iradms(*), Ddcov(*)
C
@@ -219,7 +238,9 @@ C
do J = 1, resParData%getNumResonances()
call resParData%getResonanceInfo(resInfo, j)
call resParData%getResonance(resonance, resInfo)
- igrp = resInfo%getSpinGroupIndex()
+ igrp = resInfo%getSpinGroupIndex()
+ call resParData%getSpinGroupInfo(spinInfo, igrp)
+ ntot = spinInfo%getNumChannels()
! sanity check for channel size
@@ -229,9 +250,9 @@ C
numChan = numChan + 1
end if
end do
- if( Ntot(igrp).lt.numChan ) then
- WRITE ( 6,99997) igrp, Ntot(igrp), numChan
- WRITE (21,99997) igrp, Ntot(igrp), numChan
+ if( Ntot.lt.numChan ) then
+ WRITE ( 6,99997) igrp, Ntot, numChan
+ WRITE (21,99997) igrp, Ntot, numChan
STOP '[STOP in Order in par/mpar11.f # 3]'
end if
diff --git a/sammy/src/par/mpar12.f90 b/sammy/src/par/mpar12.f90
index 282f5a2c778a1a2c018f9bacda64c552be9ce853..8161935ea7b69dc36227da340cefcff8e3734249 100755
--- a/sammy/src/par/mpar12.f90
+++ b/sammy/src/par/mpar12.f90
@@ -31,7 +31,7 @@ end module FixUpParameterData_M
!C
!C --------------------------------------------------------------
!C
- SUBROUTINE Fix ( Ntot , Iflbrd, Ifleff, Ifltru, Ifliso, Ifldet, &
+ SUBROUTINE Fix ( Iflbrd, Ifleff, Ifltru, Ifliso, Ifldet, &
Iflext, Iflmsc, Iradms, Iflpmc, Iflorr, Iflrpi, &
Iflnbk, Iflbgf, Ifldtp, Iflusd, Nnrext)
!C
@@ -42,7 +42,7 @@ end module FixUpParameterData_M
use FixUpParameterData_M
IMPLICIT NONE
- integer:: Ntot(*), Iflbrd(*), Ifleff(*), Ifltru(*), Ifliso(*), &
+ integer:: Iflbrd(*), Ifleff(*), Ifltru(*), Ifliso(*), &
Ifldet(*), Iflext(Nnrext,Ntotc,*), &
Iflmsc(*), Iradms(*), Iflpmc(4,*), Iflorr(*), Iflrpi(*), &
Iflnbk(6,*), Iflbgf(*), Ifldtp(*), Iflusd(*)
diff --git a/sammy/src/qua/mqua1.f b/sammy/src/qua/mqua1.f
index 029b2c7242a0baba9d3a95238b1d6e48bfdcbf3a..f73deb5ec67a6ace9d49e3b1b8930768b8d45469 100755
--- a/sammy/src/qua/mqua1.f
+++ b/sammy/src/qua/mqua1.f
@@ -100,7 +100,7 @@ C *** Alfn80 = 'RADius' or 'RADii', or 'CHAnnel radi'
Iux = 56
Ng = 0
C Ksolve and Numpup are not really needed in SAMQUA
- CALL Rd_Rad_Key_Word (Ntot, Lspin, Kppair, Pareff, Ifleff,
+ CALL Rd_Rad_Key_Word (Pareff, Ifleff,
* Deleff, Partru, Ifltru, Deltru, Igrrad, Dumnam,
* Lrad, Alfn80, Numrad, Max_Chan, Max_Nuclide, Max_Pp, Max_L,
* Max_Rad, Ng, Iux)
diff --git a/sammy/src/qua/mqua9.f b/sammy/src/qua/mqua9.f
index 9ca10c365a750d25fc9a934f3b3459bdfbdd3063..5ed30de6c731fb5d6392615eca2f04332809682e 100755
--- a/sammy/src/qua/mqua9.f
+++ b/sammy/src/qua/mqua9.f
@@ -229,13 +229,15 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Rd_Rad_Key_Word (Ntot, Lspin, Kppair, Pareff, Ifleff,
+ SUBROUTINE Rd_Rad_Key_Word (Pareff, Ifleff,
* Deleff, Partru, Ifltru, Deltru, Igrrad, Dumnam, Lrad,
* Alfn80, I_Rad, Ntotc, Max_Nuclide, Max_Pp, Max_L, Numrad,
* Ngroup, Iux)
C *** Read radii in key-word format
use EndfData_common_m
use SammyParticlePairInfo_M
+ use SammyRMatrixParameters_M
+ use SammyResonanceInfo_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
CHARACTER*80 File
CHARACTER*1 Alfn80(80), Alfn80_Orig(80)
@@ -244,9 +246,13 @@ C DIMENSION Par???(Max_Rad), Ifl???(Max_Rad), Igrrad(Ntotc,Ngroup),
C * Dumnam(Max_Pp,Max_Rad), Lrad(Max_L,Max_Pp,Max_Rad)
DIMENSION Pareff(*), Partru(*), Ifleff(*), Ifltru(*),
* Deleff(*), Deltru(*),
- * Igrrad(Ntotc,*), Ntot(*), Lspin(Ntotc,*), Kppair(Ntotc,*),
+ * Igrrad(Ntotc,*),
* Dumnam(Max_Pp,*), Lrad(Max_L,Max_Pp,*)
type(SammyParticlePairInfo)::pairInfo
+ type(SammySpinGroupInfo)::spinInfo
+ type(RMatParticlePair)::pair
+ type(RMatChannelParams)::channel
+ type(SammyChannelInfo)::channelInfo
character(len=8)::pname
EQUIVALENCE (File, Alfn80_Orig)
C
@@ -426,7 +432,7 @@ C *** Here the key-word is "GRoup"
CALL Get_Group (Ig, Alfn80, Istart, Istop, Ierr,
* Ngroup)
IF (Ngroup.GT.0) THEN
- CALL Get_Channel (Ntot, Igrrad, Alfn80, Istart,
+ CALL Get_Channel (Igrrad, Alfn80, Istart,
* Istop, Ierr, Ntotc, Ig, I_Rad)
ELSE
WRITE (6,10300)
@@ -437,7 +443,7 @@ C
ELSE IF (Alfn80(I).EQ.'C' .AND. Alfn80(I+1).EQ.'H') THEN
C *** Here the key-word is "CHannel" [with Ig .ne. 0]
IF (Ngroup.GT.0) THEN
- CALL Get_Channel (Ntot, Igrrad, Alfn80, Istart,
+ CALL Get_Channel (Igrrad, Alfn80, Istart,
* Istop, Ierr, Ntotc, Ig, I_Rad)
ELSE
WRITE (6,10300)
@@ -470,13 +476,16 @@ C
GO TO 10
C
40 CONTINUE
- IF (Ngroup.GT.0) THEN
- DO Ig=1,Ngroup
- DO Ich=1,Ntot(Ig)
- Kpp = Kppair(Ich,Ig)
+ IF (resParData%getNumSpinGroups().GT.0) THEN
+ DO Ig=1,resParData%getNumSpinGroups()
+ call resParData%getSpinGroupInfo(spinInfo, Ig)
+ DO Ich=1,spinInfo%getNumChannels()
+ call spinInfo%getChannelInfo(channelInfo, Ich)
+ Kpp = channelInfo%getParticlePairIndex()
call resParData%getParticlePairInfo(pairInfo,Kpp)
call pairInfo%getName(pname)
- Lsp = Lspin (Ich,Ig)
+ call resParData%getChannel(channel, channelInfo)
+ Lsp = channel%getL()
Igr = Igrrad(Ich,Ig)
IF (Igr.EQ.0) THEN
DO Irad=1,Numrad
@@ -862,12 +871,15 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Get_Channel (Ntot, Keep, Alfn80, Istart, Istop,
+ SUBROUTINE Get_Channel (Keep, Alfn80, Istart, Istop,
* Ierr, Nx, Ig, Number)
use mdf5_m
+ use EndfData_common_m
+ use SammyResonanceInfo_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
CHARACTER*1 Alfn80(*)
- DIMENSION Keep(Nx,*), Ntot(*)
+ type(SammySpinGroupInfo)::spinInfo
+ DIMENSION Keep(Nx,*)
Ierr = 0
I = Istart
DO J=Istart,Istop
@@ -907,24 +919,35 @@ C
50 CONTINUE
C
Ng = -Ig
+ if (ig.gt.0.and.
+ * resParData%getNumSpinGroups().ge.Ig) then
+ call resparData%getSpinGroupInfo(spinInfo,ig)
+ ntotIg = spinInfo%getNumChannels()
+ else
+ ntotIg = 0
+ end if
DO I=Istart,Iquit
IF (Alfn80(I).EQ.'E') THEN
IF (Ig.LT.0) THEN
DO Igr=1,Ng
- Keep(Ntot(Igr)+1,Igr) = Number
+ call resparData%getSpinGroupInfo(spinInfo,igr)
+ ntotIgr = spinInfo%getNumChannels()
+ Keep(ntotIgr+1,Igr) = Number
END DO
ELSE
- Keep(Ntot(Ig)+1,Ig) = Number
+ Keep(ntotIg+1,Ig) = Number
END IF
Istart = Iquit + 2
RETURN
ELSE IF (Alfn80(I).EQ.'G') THEN
IF (Ig.LT.0) THEN
DO Igr=1,Ng
- Keep(Ntot(Igr)+2,Igr) = Number
+ call resparData%getSpinGroupInfo(spinInfo,igr)
+ ntotIgr = spinInfo%getNumChannels()
+ Keep(ntotIgr+2,Igr) = Number
END DO
ELSE
- Keep(Ntot(Ig)+2,Ig) = Number
+ Keep(ntotIg+2,Ig) = Number
END IF
Istart = Iquit + 2
RETURN
@@ -933,17 +956,19 @@ C
C
CALL Get_Intg (Alfn80(1:80), Istart, Iquit, Intg, Intgx, Kintgx)
IF (Ig.GT.0) THEN
- IF (Intg.LE.Ntot(Ig) .AND. Intg.GT.0) THEN
+ IF (Intg.LE.NtotIg .AND. Intg.GT.0) THEN
Keep(Intg,Ig) = Number
ELSE
- WRITE (6,20100) Intg, Ntot(Ig), Ig
+ WRITE (6,20100) Intg, NtotIg, Ig
20100 FORMAT ('Intg, Ntot(Ig), Ig=', 5i5)
STOP '[STOP in Get_Channel in mqua9.f]'
END IF
ELSE
IF (Intg.GT.0) THEN
DO Igg=1,Ng
- IF (Intg.LE.Ntot(Igg)) Keep(Intg,Igg) = Number
+ call resparData%getSpinGroupInfo(spinInfo,igg)
+ ntotIgg = spinInfo%getNumChannels()
+ IF (Intg.LE.NtotIgg) Keep(Intg,Igg) = Number
END DO
END IF
END IF
diff --git a/sammy/src/rec/mrec0.f b/sammy/src/rec/mrec0.f
index d16a1f46dda38f45c6c2af49601f37f522fde923..36fd12bedc0ec9a99c9d8b9691f81de74e0c2b85 100644
--- a/sammy/src/rec/mrec0.f
+++ b/sammy/src/rec/mrec0.f
@@ -52,7 +52,7 @@ C
C *** one ***
C *** initialize difmax
Idifma = Idimen (Mres, 1, 'Mres, 1')
- CALL Uuuset (I_Intot , I_Ilspin , A(Idifma), I_Ixclud )
+ CALL Uuuset (A(Idifma) )
C
C *** two ***
Ietab2 = Idimen (Nemax, 1, 'Nemax, 1')
@@ -63,8 +63,7 @@ C
C - - - - - - - - - - - - - - - - - - - - - - - - - - - <
C *** three ***
Ix1 = Idimen (Na, 1, 'Na, 1')
- CALL Fixx (I_Intot , I_Iishif , I_Ilspin , A_Ibound , A_Iechan ,
- * I_Ixclud,
+ CALL Fixx (A_Ibound , A_Iechan ,
* A_Izkte , A(Ixx), A(Ix1), Mxany)
C *** SBROUTNE Fixx sets Xx = energy shift
I = Idimen (Ix1, -1, 'Ix1, -1')
@@ -144,7 +143,7 @@ C
C *** thirteen ***
Ienode = Idimen (Mres+2, 1, 'Mres+2, 1')
Iwnode = Idimen (Mres+2, 1, 'Mres+2, 1')
- CALL Eorder (I_Ixclud , A(Ienode), A(Iwnode), Node)
+ CALL Eorder (A(Ienode), A(Iwnode), Node)
Iesave = Idimen (Nesave, 1, 'Nesave, 1')
Isigsa = Idimen (N1, 1, 'N1, 1')
Iesub = Idimen (Nesub, 1, 'Nesub, 1')
diff --git a/sammy/src/rec/mrec1.f b/sammy/src/rec/mrec1.f
index faa58d813e029fece2045665fda4c090c9f5975f..654247699b0bf5f9836ad5a3a8c8a3c1e246da23 100644
--- a/sammy/src/rec/mrec1.f
+++ b/sammy/src/rec/mrec1.f
@@ -2,7 +2,7 @@ C
C
C ----------------------------------------------------------------------
C
- SUBROUTINE Eorder (Ixclud, Enode, Widnod, Node)
+ SUBROUTINE Eorder (Enode, Widnod, Node)
C
C *** Decide which resonances are inside range (emin,emax) and which are
C *** not to be excluded
@@ -18,8 +18,8 @@ C
C
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
+ type(SammySpinGroupInfo)::spinInfo
DIMENSION Enode(*), Widnod(*)
- DIMENSION Ixclud(*)
C
C *** Find which resonances are inside energy range
J = 1
@@ -28,15 +28,16 @@ C *** Find which resonances are inside energy range
DO I=1,resParData%getNumResonances()
call resParData%getResonanceInfo(resInfo, I)
Igrp = resInfo%getSpinGroupIndex()
- IF (Ixclud(Igrp).NE.1) THEN
+ call resParData%getSpinGroupInfo(spinInfo, igrp)
+ IF (spinInfo%getIncludeInCalc()) THEN
call resParData%getResonance(resonance, resInfo)
eres = resonance%getEres()
IF (eres.GE.Emin .AND. eres.LE.Emax) THEN
J = J + 1
Enode(J) = eres
- Widnod(J) = resonance%getWidth(1)
- DO M=1,Ntotc
- Widnod(J) = Widnod(J) + resonance%getWidth(M+1)
+ Widnod(J) = 0.0d0
+ DO M=1,resonance%getNumChan()
+ Widnod(J) = Widnod(J) + resonance%getWidth(M)
END DO
Widnod(J) = Widnod(J)/1000.D0
END IF
diff --git a/sammy/src/rec/mrec3.f b/sammy/src/rec/mrec3.f
index d5f951c042a6512446cc696ed545dcb87092ae14..37bcc90d5e3244b19e858839f5af44f4352617f1 100644
--- a/sammy/src/rec/mrec3.f
+++ b/sammy/src/rec/mrec3.f
@@ -95,7 +95,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Uuuset (Ntot, Lspin, Difmax, Ixclud)
+ SUBROUTINE Uuuset (Difmax)
C
C *** PURPOSE -- GENERATE Uup, Udown, Iuif, Nnpar, Difmax
C *** modified from program Uset in mthe1
@@ -109,10 +109,12 @@ C
C
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
- DIMENSION Ntot(*), Lspin(Ntotc,*),Difmax(*), Ixclud(*)
+ type(SammySpinGroupInfo)::spinInfo
+ type(RMatChannelParams)::channel
+ type(SammyChannelInfo)::channelInfo
+ DIMENSION Difmax(*)
C
-C DIMENSION Ntot(Ngroup), Lspin(Ntotc,Ngroup),
-C * Difmax(Nres), Ixclud(Ngroup)
+C DIMENSION Difmax(Nres)
DATA Zero /0.0d0/, Two /2.0d0/
C
Ks_Res = Ksolve
@@ -120,20 +122,25 @@ C
DO N=1,resParData%getNumResonances()
call resParData%getResonanceInfo(resInfo, N)
IF (resInfo%getIncludeInCalc()) THEN
- Mmax = Ntot(resInfo%getSpinGroupIndex())
- Mmax2 = Mmax + 2
+ igr = resInfo%getSpinGroupIndex()
+ call resParData%getSpinGroupInfo(spinInfo, igr)
+ Mmax = spinInfo%getNumChannels()
+ Mmax2 = spinInfo%getNumResPar()
Igrp = resInfo%getSpinGroupIndex()
- IF (Ixclud(Igrp).NE.1) THEN
+ IF (spinInfo%getIncludeInCalc()) THEN
Difmax(N) = 1.E30
- IF (Kscut.NE.0 .OR. Lspin(1,Igrp).NE.0) THEN
+ iela = spinInfo%getElasticChannel()
+ call spinInfo%getChannelInfo(channelInfo, iela)
+ call resParData%getChannel(channel, channelInfo)
+ IF (Kscut.NE.0 .OR. channel%getL().NE.0) THEN
call resParData%getResonance(resonance, resInfo)
P = resonance%getEres()
IF (P.GE.Zero) THEN
- G = dABS(resonance%getWidth(1))
- DO M=1,Mmax
- G = G + dABS(resonance%getWidth(M+1))
+ G = 0.0d0
+ DO M=1,resonance%getNumChan()
+ G = G + dABS(resonance%getWidth(M))
END DO
- IF (Kscut.NE.0 .AND. Lspin(1,Igrp).EQ.0) G =
+ IF (Kscut.NE.0 .AND. channel%getL().EQ.0) G =
* G * Two
Difmax(N) = G
END IF
diff --git a/sammy/src/ref/mref0.f b/sammy/src/ref/mref0.f
index ab77209b5835322d3aed9a2018f39c9e97bb8611..afa186ebeea8f131f1fb19e46b7dc1805247984c 100644
--- a/sammy/src/ref/mref0.f
+++ b/sammy/src/ref/mref0.f
@@ -34,9 +34,7 @@ C *** Read Energy from sam50.dat and Data & Covariance from SAM44.DAT
CALL Refdat (A(Ienerg), A_Idatb , A_Ivv )
C
c *** convert from SAMMY information to REFIT information
- CALL Refwrt ( I_Inent , I_Inext , I_Intot , I_Ilpent ,
- * I_Ilspin , A_Irdeff , A_Irdtru ,
- * A_Ispinx)
+ CALL Refwrt
C
WRITE (6,10200)
10200 FORMAT (' Normal finish of SAMREF')
diff --git a/sammy/src/ref/mref1.f b/sammy/src/ref/mref1.f
index 7c041e4a7d726b0f5725b04c9150606d6beb6d64..e7a60fd83fd90b63cc46c9338f41c162936d8b5d 100644
--- a/sammy/src/ref/mref1.f
+++ b/sammy/src/ref/mref1.f
@@ -2,8 +2,7 @@ C
C
C --------------------------------------------------------------------
C
- SUBROUTINE Refwrt ( Nent, Next, Ntot, Lpent, Lspin, Rdeff,
- * Rdtru, Spinx)
+ SUBROUTINE Refwrt
C
C *** purpose -- convert from SAMMY input to REFIT input; WRITE
C *** out files for REFIT
@@ -19,10 +18,6 @@ C
C
CHARACTER*10 Files(10)
C
- DIMENSION Nent(*), Next(*), Ntot(*),
- * Lpent(Ntotc,*), Lspin(Ntotc,*), Rdeff(Ntotc,*),
- * Rdtru(Ntotc,*),
- * Spinx(*)
DIMENSION Lw(10,30,20), Lwie(10,10,30,20), Rcoe(4,10),Rcoei(4,10)
C
DIMENSION G(3)
@@ -30,6 +25,10 @@ C
type(RMatSpinGroup)::spinGroup
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
+ type(SammyChannelInfo)::channelInfo
+ type(RMatChannelParams)::channel
+ type(SammyParticlePairInfo)::pairInfo
+ type(RMatParticlePair)::pair
DATA Zero /0.0d0/
DATA Files / 'REFIT0.DAT', 'REFIT1.DAT', 'REFIT2.DAT',
* 'REFIT3.DAT', 'REFIT4.DAT', 'REFIT5.DAT', 'REFIT6.DAT',
@@ -57,14 +56,25 @@ C *** Output file for this isotope
09000 FORMAT ('/nucld', i2)
C
C *** write out the resonance parameters etc for REFIT FILES
-C
+Cc
Iel = 2
IF (Ntotc.EQ.2) Iel = 1
IF (Ntotc.EQ.1) Iel = 0
IF (Iel.GT.0) THEN
Ig = 1
C *** consider first spin group only
- N = Next(Ig)
+ call resParData%getSpinGroupInfo(spinInfo, Ig)
+ nent = spinInfo%getNumEntryChannels()
+ N = spinInfo%getNumExitChannels()
+
+ if ( spinInfo%getNumChannels().ge.Nent+1) then
+ call spinInfo%getChannelInfo(channelInfo, Nent+1)
+ call resParData%getChannel(channel, channelInfo)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ end if
IF (N.EQ.0) THEN
Iel = 0
ELSE
@@ -72,9 +82,22 @@ C *** consider first spin group only
Iel = 1
ELSE
Iel = 1
- lp = Lpent(Nent(Ig)+1,ig)
- DO 5 i=2,n
- IF (Lpent(Nent(Ig)+i,ig).ne.lp) THEN
+ lp = 0
+ if( spinInfo%getNumChannels().ge.Nent+1) then
+ lp = pair%getPnt()
+ end if
+ nmax = n
+ if (nmax.gt.spinInfo%getNumChannels()) then
+ nmax = spinInfo%getNumChannels()
+ end if
+ DO 5 i=2,nmax
+ call spinInfo%getChannelInfo(channelInfo, Nent+i)
+ call resParData%getChannel(channel, channelInfo)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ IF (pair%getPnt().ne.lp) THEN
Iel = 2
GO TO 6
END IF
@@ -114,7 +137,11 @@ C set up to write for spins J to J+Jspin-1
C
DO 70 Jx=1,resParData%getNumSpinGroups()
call resParData%getSpinGroupInfo(spinInfo, Jx)
- call resParData%getSpinGroup(spinGroup, spinInfo)
+ call resParData%getSpinGroup(spinGroup, spinInfo)
+ iela = spinInfo%getElasticChannel()
+ call spinInfo%getChannelInfo(channelInfo, iela)
+ call resParData%getChannel(channel, channelInfo)
+
spinjVal = spinGroup%getJ()
isojx = spinInfo%getIsotopeIndex()
IF (Numiso.GT.0 .AND. IsoJx.NE.Iso) GO TO 70
@@ -131,10 +158,10 @@ C READ (Iunit,20000) Ar(Jx), Gjx, Ehalf2
C Ar(Jx) = Radius for resonance calculations, in 1.e-12 cm
C Gjx = g-factor (2J+1)/((2i+1)(2I+1))
Ehalf = Zero
- Rad = Rdtru(1,Jx)/10.0d0
+ Rad = channel%getApt()/10.0d0
IF (Rad.EQ.0.0d0) Rad = crfn/10.0d0
Sj = dABS(SpinjVal)
- Si = dABS(Spinx(Jx))
+ Si = dABS(spinInfo%getTargetSpin())
Gjx = (2.0d0*Sj+1.0d0)/(2.0d0*(2.0d0*Si+1.0d0))
WRITE (Iunit,20000) Rad, Gjx, Ehalf
WRITE (Iunitx,20020) Rad, Gjx, Ehalf
@@ -149,9 +176,10 @@ C Ncj = Number of particle channels for this spin group
40010 FORMAT (' Number of r-coefficients =', 12i6)
C
C READ (Iunit,50000) (RCOE(2,L),L=1,NCJ)
-C ASP(Jx) = AR(Jx)*(1.0-RCOE(2,1))
- IF (Rad.NE.0.0d0 .AND. Rdeff(1,Jx).NE.0.0d0) THEN
- Rcoe(2,1) = 1.0d0 - Rdeff(1,Jx)/rad
+C ASP(Jx) = AR(Jx)*(1.0-RCOE(2,1))
+ IF (Rad.NE.0.0d0 .AND.
+ * channel%getApe().NE.0.0d0) THEN
+ Rcoe(2,1) = 1.0d0 - channel%getApe()/rad
ELSE
Rcoe(2,1) = 0.0d0
END IF
@@ -181,14 +209,36 @@ C * LWIE(1,2,Jx,Jw)
C Lw (1, Jx,Jw) = Number of entrance channels
C Lwie(1,1,Jx,Jw) = Number of "level 1" channels
C Lwie(1,2,Jx,Jw) = Number of "level 2" channels
- N1 = Nent(Jx)
- N23 = Next(Jx)
+ N1 = spinInfo%getNumEntryChannels()
+ N23 = spinInfo%getNumExitChannels()
N2 = N23
N3 = 0
+
+ lp = 0
+ if ( spinInfo%getNumChannels().ge.N1+1) then
+ call spinInfo%getChannelInfo(channelInfo, N1+1)
+ call resParData%getChannel(channel, channelInfo)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ lp = pair%getPnt()
+ end if
+
IF (N23.GT.1) THEN
N2 = 1
- DO 30 N=N1+2,N1+N23
- IF (Lpent(N,Jx).EQ.Lpent(N1+1,Jx)) THEN
+ nmax = N1+N23
+ if (nmax.gt.spinInfo%getNumChannels()) then
+ nmax = spinInfo%getNumChannels()
+ end if
+ DO 30 N=N1+2,nmax
+ call spinInfo%getChannelInfo(channelInfo, N)
+ call resParData%getChannel(channel, channelInfo)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ IF (pair%getPnt().EQ.Lp) THEN
N2 = N2 + 1
ELSE
N3 = N3 + 1
@@ -203,7 +253,9 @@ C
C READ (Iunit,40000) (Lw(Jz+1,Jx,Jw),Jz=1,Lw(1,Jx,Jw))
Jw = 1
DO 40 Nn=1,N1
- Lw(Nn+1,Jx,Jw) = Lspin(Nn,Jx) + 1
+ call spinInfo%getChannelInfo(channelInfo, Nn)
+ call resParData%getChannel(channel, channelInfo)
+ Lw(Nn+1,Jx,Jw) = channel%getL() + 1
40 CONTINUE
WRITE (Iunit,40000) (Lw(Nn+1,Jx,Jw),Nn=1,N1)
WRITE (Iunitx,40030) (Lw(Nn+1,Jx,Jw),Nn=1,N1)
@@ -219,8 +271,14 @@ C END IF
C END IF
IF (N2.GT.0) THEN
DO 50 N=1,N2
- IF (Lpent(1+N1,Jx).NE.0) THEN
- Lwie(N+1,1,Jx,Jw) = Lspin(N+N1,Jx)
+ call spinInfo%getChannelInfo(channelInfo, N+N1)
+ call resParData%getChannel(channel, channelInfo)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ IF (Lp.NE.0) THEN
+ Lwie(N+1,1,Jx,Jw) = channel%getL()
ELSE
Lwie(N+1,1,Jx,Jw) = 9
END IF
@@ -230,8 +288,23 @@ C END IF
40040 FORMAT (' "level 1" l-values =', 12I6)
IF (N3.GT.0) THEN
DO 60 N=1,N3
- IF (Lpent(N1+n2+1,Jx).NE.0) THEN
- Lwie(N+1,1,Jx,Jw) = Lspin(N+N1+N2,Jx)
+ lp1 = 0
+ if (N1+n2+1.le.spinInfo%getNumChannels()) then
+ call spinInfo%getChannelInfo(channelInfo,
+ * N1+n2+1)
+ call resParData%getChannel(channel, channelInfo)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ lp1 = pair%getPnt()
+ end if
+ index = N1+n2+N
+ IF (lp1.NE.0.and.
+ * index.lt.spinInfo%getNumChannels())THEN
+ call spinInfo%getChannelInfo(channelInfo,index)
+ call resParData%getChannel(channel, channelInfo)
+ Lwie(N+1,1,Jx,Jw) = channel%getL()
ELSE
Lwie(N+1,1,Jx,Jw) = 0
END IF
@@ -280,8 +353,15 @@ C
C *** write out Energy,spin,l-val,radiation width
C READ (Iunit,60000) Er(Lj), AJ(Lj), Lresx, Gg(Lj)
Sj = spinGroup%getJ()
- Lresx = Lspin(1,resInfo%getSpinGroupIndex())
- Gg = resonance%getWidth(1)/1000.0d0
+
+ igr = resInfo%getSpinGroupIndex()
+ call resParData%getSpinGroupInfo(spinInfo, igr)
+ iela = spinInfo%getElasticChannel()
+ call spinInfo%getChannelInfo(channelInfo, iela)
+ call resParData%getChannel(channel, channelInfo)
+ Lresx = channel%getL()
+ iGam = spinInfo%getGammaWidthIndex()
+ Gg = resonance%getWidth(iGam)/1000.0d0
WRITE (Iunit,60000) resonance%getEres(), Sj, Lresx, Gg
60000 FORMAT (F15.6,F6.1,I3,E12.4)
WRITE (Iunitx,60010) resonance%getEres(), Sj, Lresx, Gg
@@ -291,7 +371,9 @@ C
C *** WRITE out elastic neutron width
C READ (Iunit,70000) Gn(1,Lj)
DO 90 Nn=1,N1
- G(Nn) = resonance%getWidth(2)/1000.0d0
+ iCap = spinInfo%getElasticChannel()
+ iCap = spinInfo%getWidthForChannel(iCap)
+ G(Nn) = resonance%getWidth(iCap)/1000.0d0
90 CONTINUE
WRITE (Iunit,70000) (G(Nn),Nn=1,N1)
70000 FORMAT (24X, 3E12.4)
@@ -302,7 +384,8 @@ C *** WRITE out first inelastic neutron width
IF (Iel.GE.1) THEN
C READ (Iunit,70000) Gn(2,Lj)
DO 100 Nn=1,N2
- g(Nn) = resonance%getWidth(Nn+N1+1)/1000.0d0
+ iChan = spinInfo%getWidthForChannel(N1 + Nn)
+ g(Nn) = resonance%getWidth(iChan)/1000.0d0
100 CONTINUE
WRITE (Iunit,70000) (G(Nn),Nn=1,N2)
WRITE (Iunitx,70020) (G(Nn),Nn=1,N2)
@@ -313,7 +396,8 @@ C *** Write out second inelastic neutron width
C READ (Iunit,70000) Gn(3,Lj)
C Gt(Lj) = Gt(Lj) + Gn(3,Lj)
DO 110 Nn=1,N3
- G(Nn) = resonance%getWidth(Nn+N1+N2+1)/1000.0d0
+ iChan = spinInfo%getWidthForChannel(N1 + N2 + NN)
+ G(Nn) = resonance%getWidth(iChan)/1000.0d0
110 CONTINUE
WRITE (Iunit,70000) (G(Nn),Nn=1,N3)
WRITE (Iunitx,70030) (G(Nn),Nn=1,N3)
diff --git a/sammy/src/ref/mrfs0.f b/sammy/src/ref/mrfs0.f
index ed6fb3af750e0b5d0f2af7c188eb92d58366f288..bd3fd14cad107ee6a8c72ef0bb90d78e28202df8 100644
--- a/sammy/src/ref/mrfs0.f
+++ b/sammy/src/ref/mrfs0.f
@@ -45,19 +45,15 @@ C *** sizes
C
C *** collect information for input file
Icf = Idimen (1, 1, '1, 1')
- CALL Cnvinp (A_Iprbrd , I_Iflbrd , A_Igoj ,
- * I_Inent , I_Inext , I_Intot ,
- * I_Iishif , I_Ilpent , I_Ilspin , A_Ichspi ,
- * A_Ienbnd , A_Ibound , A_Iechan ,
- * A_Irdeff , A_Irdtru , A_Iemmm1 , A_Iemmm2 ,
- * I_Ixclud , A_Ispinx ,
+ CALL Cnvinp (A_Iprbrd , I_Iflbrd ,
+ * A_Ibound , A_Iechan ,
* I_Ifcros , A_Iangle , A_Idangl ,
* A_Ibcf , A_Icf2 , A(Icf ), A_Iresol )
I = Idimen (Icf, -1, 'Icf, -1')
C
C *** collect values needed for parameter file
Korder = Idimen (1, 1, '1, 1')
- CALL Cnvpar ( A_Iprbrd , I_Iflbrd , I_Intot ,
+ CALL Cnvpar ( A_Iprbrd , I_Iflbrd ,
* A_Ipreff , I_Ifleff , A_Iprtru , I_Ifltru , I_Iigrra ,
* I_Ifliso , A_Ideiso ,
* A_Iprext , I_Iflext , I_Iflpol ,
diff --git a/sammy/src/ref/mrfs2.f b/sammy/src/ref/mrfs2.f
index 16ff125d27796bcc73eba697910a9325b366889d..d026d3bb754b704ca8e0d6f71deeb7061d975b0a 100644
--- a/sammy/src/ref/mrfs2.f
+++ b/sammy/src/ref/mrfs2.f
@@ -100,23 +100,8 @@ C *** one
N = Ngroup
IF (Ksindi.EQ.0) N = 1
call make_A_Isiabn(N)
- call make_A_Igoj(Ngroup)
- call make_I_Inent(Ngroup)
- call make_I_Inext(Ngroup)
- call make_I_Intot(Ngroup)
- call make_I_Iishif(Ngroup * Ntotc)
- call make_I_Ilpent(Ngroup * Ntotc)
- call make_I_Ilspin(Ngroup * Ntotc)
- call make_A_Ichspi(Ngroup * Ntotc)
- call make_A_Ienbnd(Ngroup * Ntotc)
call make_A_Ibound(Ngroup * Ntotc)
call make_A_Iechan(Ngroup * Ntotc)
- call make_A_Irdeff (Ngroup * Ntotc)
- call make_A_Irdtru(Ngroup * Ntotc)
- call make_A_Iemmm1(Ngroup * Ntotc)
- call make_A_Iemmm2(Ngroup * Ntotc)
- call make_I_Ixclud(Ngroup)
- call make_A_Ispinx(Ngroup)
C
C *** three
N = Nangle
diff --git a/sammy/src/ref/mrfs3.f b/sammy/src/ref/mrfs3.f
index 55be7f5f97ca7ad2d42ceb3cb07e54aca6c0214d..fe82899471c0f735d13dd7338ce05f901f46d647 100644
--- a/sammy/src/ref/mrfs3.f
+++ b/sammy/src/ref/mrfs3.f
@@ -2,11 +2,8 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Cnvinp (Parbrd, Iflbrd, Goj ,
- * Nent , Next , Ntot , Ishift, Lpent, Lspin , Chspin,
- * Enbnd , Bound, Echan, Rdeff , Rdtru, Emmm1 , Emmm2 ,
- * Ixclud, Spinx, Ifcros, Angle , Dangle, Bcf, Cf2, Cf,
- * Eresol)
+ SUBROUTINE Cnvinp (Parbrd, Iflbrd, Bound, Echan,
+ * Ifcros, Angle , Dangle, Bcf, Cf2, Cf, Eresol)
C
C *** PURPOSE -- collect THE INPUT FILE information from REFIT, i.e.
C *** NON-VARIABLE PARAMETERS AND QUANTUM NUMBERS
@@ -22,34 +19,29 @@ C
use SammyRMatrixParameters_M
use SammySpinGroupInfo_M
use ExpPars_common_m
+ use, intrinsic :: ISO_C_BINDING
IMPLICIT DOUBLE PRECISION (A-h,o-z)
CHARACTER*5 Dtype
type(SammyRMatrixParameters)::reorgResPar
type(RMatSpinGroup)::rmatSpin
type(SammySpinGroupInfo)::spinInfo
+ type(SammyChannelInfo)::channelInfo
+ type(RMatChannelParams)::channel
+ type(SammyParticlePairInfo)::pairInfo
+ type(RMatParticlePair)::pair
+ logical(C_BOOL)::calcShift
C
C DIMENSION Parbrd(Numbrd), Iflbrd(Numbrd),
-C * Goj(Ngroup), Nent(Ngroup),
-C * Next(Ngroup), Ntot(Ngroup), Ishift(Ntotc,Ngroup),
-C * Lpent(Ntotc,Ngroup), Lspin(Ntotc,Ngroup),
-C * Chspin(Ntotc,Ngroup), Enbnd(Ntotc,Ngroup),
C * Bound(Ntotc,Ngroup), Echan(Ntotc,Ngroup),
-C * Rdeff(Ntotc,Ngroup), Rdtru(Ntotc,Ngroup),
-C * Emmm1(Ntotc,Ngroup), Emmm2(Ntotc,Ngroup),
-C * Ixclud(Ngroup), Spinx(Ngroup),
C * IFcros(Ncrsss), Angle(Nangle), Dangle(Nangle),
C * Bcf(Ncf), Cf2(Ncf), Cf(Ncf), Eresol(Nresol)
C
- DIMENSION Parbrd(*), Iflbrd(*), Goj(*),
- * Nent(*), Next(*), Ntot(*), Ishift(Ntotc,*), Lpent(Ntotc,*),
- * Lspin(Ntotc,*), Chspin(Ntotc,*), Enbnd(Ntotc,*),
- * Bound(Ntotc,*), Echan(Ntotc,*), Ixclud(*), Spinx(*),
- * Rdeff(Ntotc,*), Rdtru(Ntotc,*),
- * Emmm1(Ntotc,*), Emmm2(Ntotc,*),
- * Ifcros(*), Angle(*), Dangle(*), Bcf(*), Cf2(*), Cf(*),
- * Eresol(*)
+ DIMENSION Parbrd(*), Iflbrd(*),
+ * Bound(Ntotc,*), Echan(Ntotc,*),
+ * Ifcros(*), Angle(*), Dangle(*), Bcf(*),
+ * Cf2(*), Cf(*), Eresol(*)
C
C
!real(kind=8) Ybeam
@@ -147,12 +139,9 @@ C *** RESONANCE QUANTUM NUMBERS AND OTHER INFO
call reorgResPar%addIsotope(1.0d0, 1, 1.0d0)
end if
+ ipp = 1
DO 30 J=1,Ngroup
- Nent(J) = 1
- Next(J) = 0
- Spinx(J) = Spin00
- Ntot(J) = Nent(J) + Next(J)
- Ntotcj = Ntot(J)
+ Ntotcj = 1
iso = 1
if ( resParData%getNumSpinGroups().ge.j) then
@@ -164,18 +153,43 @@ C *** RESONANCE QUANTUM NUMBERS AND OTHER INFO
call reorgResPar%addSpinGroup(iso, spinnj(j), parity)
call reorgResPar%getSpinGroupInfo(spinInfo, j)
call spinInfo%setAbundance(1.0d0)
+ call spinInfo%setTargetSpin(Spin00)
+ call spinInfo%setNumEntryChannels(1)
+ call spinInfo%setNumExitChannels(0)
+
+ calcShift = .false.
DO 20 N=1,Ntotcj
- Lpent(N,J) = 1
- Ishift(N,J) = 0
- Lspin (N,J) = Llllll(J)
- Chspin(N,J) = dabs(Spinnj(J)-Llllll(J))
- Enbnd (N,J) = 0.0d0
+ ! make the particle pair
+ call pair%initialize_DEFAULT(N)
+ call pair%setCalcShift(calcShift)
+ call pair%setPnt(1)
+
+ call pairInfo%initialize()
+ call pairInfo%setInputIndex(ipp)
+ call pairInfo%setIsotopeIndex(N)
+ call pairInfo%setPairIndex(-1)
+ call pairInfo%setTrueRadius(ar(J)*10.0d0)
+ call pairInfo%setEffectiveRadius(asp(J)*10.0d0)
+ call pairInfo%setParticlePair(pair)
+ call reorgResPar%addParticlePair(pairInfo)
+
+ call channel%initialize_DEFAULT(N)
+ call channel%setL(Llllll(J))
+ call channel%setSch( dabs(Spinnj(J)-Llllll(J)))
+ call channel%setApt(ar(J)*10.0d0)
+ call channel%setApe(asp(J)*10.0d0)
+
+ call channelInfo%initialize()
+ call channelInfo%setSpinGroupIndex(J)
+ call channelInfo%setChannelIndex(N)
+ call channelInfo%setInputIndex(ipp)
+ call channelInfo%setParticlePairIndex(ipp)
+ call reorgResPar%addChannelData(channelInfo, channel)
+
+ ipp = ipp + 1
+
Echan (N,J) = 0.0d0
- Rdeff (N,J) = asp(J)*10.0d0
- Rdtru (N,J) = ar(J)*10.0d0
- Emmm1 (N,J) = 0.0d0
- Emmm2 (N,J) = 0.0d0
20 CONTINUE
30 CONTINUE
call reorgResPar%transferParticlePairData(resParData)
diff --git a/sammy/src/ref/mrfs4.f b/sammy/src/ref/mrfs4.f
index f2baf03195bb78ac4eef434b270d3de93240a648..733358c91670e5b0e28a514afbdb36dbbd96aaa1 100644
--- a/sammy/src/ref/mrfs4.f
+++ b/sammy/src/ref/mrfs4.f
@@ -2,7 +2,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Cnvpar ( Parbrd, Iflbrd, Ntot ,
+ SUBROUTINE Cnvpar ( Parbrd, Iflbrd,
* Pareff, Ifleff, Partru, Ifltru, Igrrad,
* Ifliso, Deliso,
* Parext, Iflext, Iflpol,
@@ -34,7 +34,7 @@ C
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
logical(C_BOOL)::reduced
- DIMENSION Parbrd(*), Iflbrd(*), Ntot(*) ,
+ DIMENSION Parbrd(*), Iflbrd(*),
* Pareff(*), Ifleff(*), Partru(*), Ifltru(*), Igrrad(Ntotc,*),
* Ifliso(*), Deliso(*),
* Parext(Nrext,Ntotc,*), Iflext(Nrext,Ntotc,*),
@@ -50,7 +50,7 @@ C
* ParBAG(*), Iflbag(*), Ddcov(*)
C
C DIMENSION Parbrd(Numbrd), Iflbrd(Numbrd),
-C * Ntot (Ngroup), Igrrad(Ntotc,Ngroup),
+C * Igrrad(Ntotc,Ngroup),
C * Pareff(Numrad), Ifleff(Numrad), Partru(Numrad),
C * Ifltru(Numrad),
C * Ifliso(Numiso),
@@ -98,9 +98,6 @@ C
end do
end do
40 CONTINUE
- DO 50 Ig=1,Ngroup
- Ntot(Ig) = 1
- 50 CONTINUE
END IF
C
IF (Numext.NE.0) THEN
diff --git a/sammy/src/ref/mwrt0.f b/sammy/src/ref/mwrt0.f
index 51350f6bc4bfac0e734fd9959414c01dcfe2e96a..20e8da999e2797ffa8264b910836895f23e25a0f 100644
--- a/sammy/src/ref/mwrt0.f
+++ b/sammy/src/ref/mwrt0.f
@@ -29,12 +29,8 @@ C
C
Icf = Idimen (1, 1, '1, 1')
C *** Write INPut file
- CALL Winpfl (A_Iprbrd , I_Iflbrd , A_Igoj ,
- * I_Inent , I_Inext , I_Intot ,
- * I_Iishif , I_Ilpent , I_Ilspin , A_Ichspi ,
- * A_Ienbnd , A_Ibound , A_Iechan ,
- * A_Irdeff , A_Irdtru , A_Iemmm1 , A_Iemmm2 ,
- * I_Ixclud , A_Ispinx ,
+ CALL Winpfl (A_Iprbrd , I_Iflbrd ,
+ * A_Iechan ,
* I_Ifcros , A_Iangle , A_Idangl ,
* A_Ibcf , A_Icf2 , A(Icf ), A_Iresol )
I = Idimen (Icf, -1, 'Icf, -1')
@@ -50,9 +46,7 @@ C *** Write Parameter file
I4 = 1
Kkkgrp = 50
CALL Oldord ( A_Iprbrd , I_Iflbrd , A_Idebrd ,
- * I_Inent , I_Inext , I_Intot , I_Iishif ,
- * I_Ilpent , I_Ifexcl , I_Ilspin , A_Ichspi , A_Ienbnd ,
- * I_Ikppai , I_Ixclud ,
+ * I_Ifexcl ,
* A_Ipreff , I_Ifleff , A_Ideeff ,
* A_Iprtru , I_Ifltru , A_Idetru , I_Iigrra ,
* I_Ifliso , A_Ideiso ,
diff --git a/sammy/src/ref/mwrt1.f b/sammy/src/ref/mwrt1.f
index d00bb52dcab8837f38632cac61cd3c7a1dec4829..8b37d45c67f10883fc31aa23c6d9d2d56e487337 100644
--- a/sammy/src/ref/mwrt1.f
+++ b/sammy/src/ref/mwrt1.f
@@ -4,10 +4,8 @@ c *** "DATa" file
C
C --------------------------------------------------------------
C
- SUBROUTINE Winpfl (Parbrd, Iflbrd, Goj,
- * Nent , Next , Ntot , Ishift, Lpent, Lspin , Chspin,
- * Enbnd , Bound , Echan , Rdeff , Rdtru, Emmm1 , Emmm2,
- * Ixclud, Spinx , Ifcros, Angle , Dangle, Bcf, Cf2, Cf,
+ SUBROUTINE Winpfl (Parbrd, Iflbrd,
+ * Echan , Ifcros, Angle , Dangle, Bcf, Cf2, Cf,
* Eresol)
C
C *** PURPOSE -- WRITE THE INPUT FILE FOR CONTROL MESSAGES FOR
@@ -28,29 +26,21 @@ C
CHARACTER*5 Dtype
C
C DIMENSION Parbrd(Numbrd), Iflbrd(Numbrd),
-C * Goj(Ngroup), Nent(Ngroup),
-C * Next(Ngroup), Ntot(Ngroup), Ishift(Ntotc,Ngroup),
-C * Lpent(Ntotc,Ngroup), Lspin(Ntotc,Ngroup),
-C * Chspin(Ntotc,Ngroup), Enbnd(Ntotc,Ngroup),
-C * Bound(Ntotc,Ngroup), Echan(Ntotc,Ngroup),
-C * Rdeff(Ntotc,Ngroup), Rdtru(Ntotc,Ngroup),
-C * Emmm1(Ntotc,Ngroup), Emmm2(Ntotc,Ngroup),
-C * Ixclud(Ngroup), Spinx(Ngroup),
+C * Echan(Ntotc,Ngroup),
C * IFcros(Ncrsss), Angle(Nangle), Dangle(Nangle),
C * Bcf(Ncf), Cf2(Ncf), Cf(Ncf), Eresol(Nresol)
C
- DIMENSION Parbrd(*), Iflbrd(*), Goj(*),
- * Nent(*), Next(*), Ntot(*), Ishift(Ntotc,*), Lpent(Ntotc,*),
- * Lspin(Ntotc,*), Chspin(Ntotc,*), Enbnd(Ntotc,*),
- * Bound(Ntotc,*), Echan(Ntotc,*), Ixclud(*), Spinx(*),
- * Rdeff(Ntotc,*), Rdtru(Ntotc,*),
- * Emmm1(Ntotc,*), Emmm2(Ntotc,*),
- * Ifcros(*), Angle(*), Dangle(*), Bcf(*), Cf2(*), Cf(*),
- * Eresol(*)
+ DIMENSION Parbrd(*), Iflbrd(*),
+ * Echan(Ntotc,*), Ifcros(*), Angle(*),
+ * Dangle(*), Bcf(*), Cf2(*), Cf(*), Eresol(*)
C
type(SammySpinGroupInfo)::spinInfo
type(RMatSpinGroup)::spinGroup
+ type(SammyParticlePairInfo)::pairInfo
+ type(RMatParticlePair)::pair
+ type(RMatChannelParams)::channel
+ type(SammyChannelInfo)::channelInfo
C
OPEN (UNIT=11, FILE='SAMMY.INP', STATUS='unknown',
* FORM='formatted')
@@ -128,22 +118,39 @@ C
C *** ALTERNATIVE TO CARD SET 10
C *** RESONANCE QUANTUM NUMBERS AND OTHER INFO
Exclud = ' '
- DO 30 J=1,Ngroup
+ DO 30 J=1,resParData%getNumSpinGroups()
C *** 3 5 10 15
call resParData%getSpinGroupInfo(spinInfo, J)
- call resParData%getSpinGroup(spinGroup, spinInfo)
- WRITE (11,11000) J, Exclud, Nent(J), Next(J),
+ call resParData%getSpinGroup(spinGroup, spinInfo)
+ nent = spinInfo%getNumEntryChannels()
+ next = spinInfo%getNumExitChannels()
+ WRITE (11,11000) J, Exclud, Nent, Next,
* spinGroup%getJ(),
- * spinInfo%getAbundance(), Spinx(J)
+ * spinInfo%getAbundance(),
+ * spinInfo%getTargetSpin()
C *** 20 30 35
11000 FORMAT (I3, 1X, A1, 4X, I1, 4X, I1, F5.1, F10.5, F5.1)
C *** 3 5 10 15 20 30 35
- Ntotcj = Ntot(J)
+ Ntotcj = spinInfo%getNumChannels()
DO 20 N=1,Ntotcj
C *** 5 10 15
- WRITE (11,11001) N, Lpent(N,J), Ishift(N,J),
- * Lspin (N,J), Chspin(N,J), Enbnd(N,J), Echan (N,J),
- * Rdeff (N,J), Rdtru (N,J), Emmm1(N,J), Emmm2 (N,J)
+ call spinInfo%getChannelInfo(channelInfo, N)
+ call resParData%getChannel(channel, channelInfo)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ if (pair%getCalcShift()) then
+ Ishift = 1
+ else
+ Ishift = 0
+ end if
+ nx = 9
+ WRITE (11,11001) N, pair%getPnt(), Ishift,
+ * channel%getL(), channel%getSch(),
+ * channel%getBnd(), Echan (N,J),
+ * channel%getApe(), channel%getApt(),
+ * pair%getMass(2), pair%getMass(1)
C *** 20 30 40 50,
C *** 55 60 70 80
11001 FORMAT (4X, I1, 4X, I1, 4X, I1, 3X, I2, F10.1, 2F10.5,
diff --git a/sammy/src/the/mthe0.f b/sammy/src/the/mthe0.f
index afe8523ab3a6ce479784d230fd8b8f0952d878e4..0edd73a6f44900042fee9e505c96966f99c824ce 100644
--- a/sammy/src/the/mthe0.f
+++ b/sammy/src/the/mthe0.f
@@ -49,9 +49,9 @@ C
allocate(A_Ivarda(ndatt))
allocate(A_Idum(ndat))
C
- CALL Uset (I_Intot , I_ILspin , A_Ibcf , A_Icf2 ,
+ CALL Uset (A_Ibcf , A_Icf2 ,
* A_Idcov , A_Iudown , A_Iuup , A(Iiuif), A(Idifma),
- * A(Ienerg), A_Ivarda , A_Idum , I_Ixclud)
+ * A(Ienerg), A_Ivarda , A_Idum)
C *** Uset determines Napres, sets up arrays Udown, Uup,
C *** Iuif, and modifies Vardat
C
diff --git a/sammy/src/the/mthe1.f b/sammy/src/the/mthe1.f
index 978ee7301b2a746fc73986886eac5fb43e578cf5..048bcc28e7f87172ca41282c8921108d1ae289c2 100644
--- a/sammy/src/the/mthe1.f
+++ b/sammy/src/the/mthe1.f
@@ -2,9 +2,9 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Uset (Ntot, Lspin, Bcf, Cf2,
+ SUBROUTINE Uset (Bcf, Cf2,
* Dcov, Udown, Uup, Iuif, Difmax,
- * Energy, Vardat, Dum, Ixclud)
+ * Energy, Vardat, Dum)
C
C *** PURPOSE -- GENERATE Uup, Udown, Iuif, Nnpar, and Difmax
C
@@ -23,15 +23,18 @@ C
C
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
- DIMENSION Ntot(*), Lspin(Ntotc,*), Bcf(*), Cf2(*),
+ type(SammySpinGroupInfo)::spinInfo
+ type(RMatChannelParams)::channel
+ type(SammyChannelInfo)::channelInfo
+ DIMENSION Bcf(*), Cf2(*),
* Dcov(*),
* Udown(*), Uup(*), Iuif(*), Difmax(*), Energy(*), Vardat(*),
- * Dum(*), Ixclud(*)
+ * Dum(*)
C
-C DIMENSION Ntot(Ngroup), Lspin(Ntotc,Ngroup), Bcf(Ncf), Cf2(Ncf),
+C DIMENSION Bcf(Ncf), Cf2(Ncf),
C * Dcov(Nfpres), Udown(Nfpres), Uup(Nfpres),
C * Iuif(Nxxres), Difmax(Nres), Energy(Ndat), Vardat(Nnnnn),
-C * Dum(Ndat), Ixclud(Ngroup)
+C * Dum(Ndat)
C
DATA Zero /0.0d0/, One /1.0d0/, Two /2.0d0/, Three /3.0d0/
C
@@ -68,19 +71,23 @@ C *** Use cutoff on derivatives
call resParData%getResonanceInfo(resInfo, N)
call resParData%getResonance(resonance, resInfo)
eres = resonance%getEres()
- igr = resInfo%getSpinGroupIndex()
-
+ igr = resInfo%getSpinGroupIndex()
+
IF (resInfo%getIncludeInCalc()) THEN
- Mmax = Ntot(Igr)
- Mmax2 = Mmax + 2
- IF (Ixclud(Igr).NE.1) THEN
+ call resParData%getSpinGroupInfo(spinInfo, igr)
+ Mmax = spinInfo%getNumChannels()
+ Mmax2 = spinInfo%getNumResPar()
+ IF (spinInfo%getIncludeInCalc()) THEN
Difmax(N) = 1.d30
- IF (Kscut.NE.0 .OR. Lspin(1,Igr).NE.0) THEN
+ iela = spinInfo%getElasticChannel()
+ call spinInfo%getChannelInfo(channelInfo, iela)
+ call resParData%getChannel(channel, channelInfo)
+ IF (Kscut.NE.0 .OR. channel%getL().NE.0) THEN
P = eres
IF (P.GE.Zero) THEN
- G = dABS(resonance%getWidth(1))
- DO M=1,Mmax
- G = G + dABS(resonance%getWidth(M+1))
+ G = 0.0d0
+ DO M=1,resonance%getNumChan()
+ G = G + dABS(resonance%getWidth(M))
END DO
G = G*0.02d0
C 0.02 is 20*(width) and 1/1000 =
@@ -93,7 +100,7 @@ C conversion from meV to eV
G = G + (Wdop+Widgau+Widexp)*Three
END IF
END IF
- IF (Kscut.NE.0 .AND. Lspin(1,Igr).EQ.0)
+ IF (Kscut.NE.0 .AND. channel%getL().EQ.0)
* G = G*two
Difmax(N) = G
END IF
@@ -124,9 +131,14 @@ C *** This is not correct for PUPd constant-Gamma-gamma
Udown(Ipar) = 1.D30
Uup(Ipar) = Zero
ELSE
- IF (Ixclud(Igr).NE.1) THEN
+ IF (spinInfo%getIncludeInCalc()) THEN
+ iela = spinInfo%getElasticChannel()
+ call spinInfo%getChannelInfo(channelInfo,
+ * iela)
+ call resParData%getChannel(channel,
+ * channelInfo)
IF (Kscut.NE.0 .OR.
- * Lspin(1,Igr).NE.0) THEN
+ * channel%getL().NE.0) THEN
IF (eres.GE.Zero) THEN
Udown(Ipar) = P - G
Uup(Ipar) = P + G
diff --git a/sammy/src/xct/mxct0.f b/sammy/src/xct/mxct0.f
index 00191e6f11c101a2b0a2d2361f1107df4569e371..5990900e3188520c52e57860b602cbdcc4e5b4fa 100644
--- a/sammy/src/xct/mxct0.f
+++ b/sammy/src/xct/mxct0.f
@@ -72,8 +72,7 @@ C *** Numdrc = max number of energy/value pairs
END IF
C
C *** GUESSTIMATE SIZE OF ARRAY NEEDED FOR SAMMY-XCT
- CALL Find_If_Coulomb (I_Inent , A_Izeta , IfCoul,
- * resParData%getNumSpinGroups(), Ifdif)
+ CALL Find_If_Coulomb (A_Izeta , IfCoul, Ifdif)
CALL Estxct (Ntwo1, Nthr1, Nthr2, Nthr3, Nfour, Nfour1, Nfour2,
* Nfive1, Nfive2, Nfive3, Nfive4, Nfive1x, Nfive3x, Nsix, Neight,
* Nnine, Nw1, Icr, Mxany, Nfprrr, K_Coul_N)
@@ -113,7 +112,7 @@ C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - <
Inpxdr = Idimen (Ng, 1, 'Inpxdr Ngroup, 1')
Krext = Nrext
IF (Nrext.EQ.0) Krext = 1
- CALL Ppar ( I_Intot , I_Iflext ,
+ CALL Ppar ( I_Iflext ,
* A(Iiuif), A(Inprdr), A(Inpxdr), Krext)
C *** Sbroutine Ppar Sets Nprdr and Npxdr
ELSE
@@ -131,9 +130,8 @@ C
C - - - - - - - - - - - - - - - - <
Ix1 = Idimen (Ntwo1, 1, 'Ix1 Ntwo1, 1')
IF (resParData%getNumResonances().GT.0) then
- CALL Fixx (I_Intot , I_Iishif , I_Ilspin ,
- * A_Ibound , A_Iechan , I_Ixclud ,
- * A_Izkte , A(Ixx), A(Ix1), Mxany)
+ CALL Fixx ( A_Ibound , A_Iechan ,
+ * A_Izkte , A(Ixx), A(Ix1), Mxany)
end if
C *** SBROUTINE Fixx sets Xx = energy shift
I = Idimen (Ix1, -1, ' Ix1, -1')
@@ -170,8 +168,7 @@ C Nfour = (Ntriag) * (Napres)
Ipgai = Idimen (N, 1, 'Ipgai N, 1')
C
IF (Napres.NE.0) THEN
- CALL Babb ( I_Intot ,
- * A_Ipolar , I_Iflpol ,
+ CALL Babb ( A_Ipolar , I_Iflpol ,
* A(Iiuif ), A(Ibr ), A(Ibi ), XxTmp, .true.)
C *** SBROUTINE Babb GENERATES ENERGY-INDEPENDENT PORTION OF
C *** PARTIAL DERIVATIVES
@@ -179,9 +176,8 @@ C *** PARTIAL DERIVATIVES
C
IF ((Nfprad.NE.0 .OR. Kvcrfn.NE.0 ) .AND.
* (Ksolve.NE.2 .OR. Nfprad.NE.Nvprad) ) THEN
- CALL Babbga (I_Intot , I_Iishif , I_Ilpent , I_ILspin ,
- * A_Ibound , A_Iechan ,
- * A_Izke , A_Izkte , A_Izeta , A(Ibga ))
+ CALL Babbga ( A_Ibound , A_Iechan ,
+ * A_Izke , A_Izkte , A_Izeta , A(Ibga ))
C *** Sbroutine Babbga generates energy-independent portion of partial
C *** derivatives wrt unvaried widths (for use in figuring partial
C *** derivatives wrt varied channel radii)
diff --git a/sammy/src/xct/mxct01.f b/sammy/src/xct/mxct01.f
index 3978b6997a11be04b86bbfa21faa63bd8580ca27..fa225f3773896bda1cc9da010b5c77c165aba3d7 100755
--- a/sammy/src/xct/mxct01.f
+++ b/sammy/src/xct/mxct01.f
@@ -2,7 +2,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Ppar (Ntot, Iflext, Iuif, Nprdr,
+ SUBROUTINE Ppar (Iflext, Iuif, Nprdr,
* Npxdr, Krext)
C
C *** Purpose --
@@ -16,10 +16,11 @@ C
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
type(SammyResonanceInfo)::resInfo
- DIMENSION Ntot(*), Iflext(Krext,Ntotc,*),
+ type(SammySpinGroupInfo)::spinInfo
+ DIMENSION Iflext(Krext,Ntotc,*),
* Iuif(*), Nprdr(*), Npxdr(*)
C
-C DIMENSION Ntot(Ngroup), Iflext(.,.,Ngroup),
+C DIMENSION Iflext(.,.,Ngroup),
C * Iuif(Nxxres), Nprdr(Ngroup), Npxdr(Ngroup)
C
C
@@ -32,8 +33,9 @@ C
call resParData%getResonanceInfo(resInfo, Ires)
IF (resInfo%getIncludeInCalc()) THEN
igr = resInfo%getSpinGroupIndex()
- Mmax = Ntot(Igr)
- Mmax2 = Mmax + 2
+ call resparData%getSpinGroupInfo(spinInfo, igr)
+ Mmax = spinInfo%getNumChannels()
+ Mmax2 = spinInfo%getNumResPar()
DO M=1,Mmax2
if(m.eq.1) then
Iflr = resInfo%getEnergyFitOption()
@@ -54,7 +56,8 @@ C
C
IF (Nfpext.GT.0) THEN
DO Igr=1,resParData%getNumSpinGroups()
- N = Ntot(Igr)
+ call resparData%getSpinGroupInfo(spinInfo, igr)
+ N = spinInfo%getNumChannels()
DO J=1,N
IF (Iflext(1,J,Igr).NE.-1) Npxdr(Igr) = 1
END DO
@@ -68,10 +71,12 @@ C
99998 FORMAT (' Problem in Ppar -- Nfpres is not correct', 2I5)
DO Ires=1,resParData%getNumResonances()
call resParData%getResonanceInfo(resInfo, Ires)
- igrp = resInfo%getSpinGroupIndex()
+ igrp = resInfo%getSpinGroupIndex()
+ call resparData%getSpinGroupInfo(spinInfo, igr)
+ ntot = spinInfo%getAllChannels()
WRITE (21,99997) Ires,resInfo%getEnergyFitOption(),
- * (resInfo%getChannelFitOption(m-1),
- * M=2,Ntot(Igrp)+2)
+ * (resInfo%getChannelFitOption(m),
+ * M=1,Ntot)
END DO
STOP '[STOP in Ppar in xct/mxct01.f]'
END IF
@@ -82,10 +87,12 @@ C
99999 FORMAT (' Problem in Ppar -- Napres is not correct', 2I5)
DO Ires=1,resParData%getNumResonances()
call resParData%getResonanceInfo(resInfo, Ires)
- igrp = resInfo%getSpinGroupIndex()
+ igrp = resInfo%getSpinGroupIndex()
+ call resparData%getSpinGroupInfo(spinInfo, igr)
+ ntot = spinInfo%getAllChannels()
WRITE (21,99997) Ires,resInfo%getEnergyFitOption(),
- * (resInfo%getChannelFitOption(m-1),
- * M=2,Ntot(Igrp)+2)
+ * (resInfo%getChannelFitOption(m),
+ * M=1,Ntot)
99997 FORMAT ('Iflres(M,', I4, ') =', 10I4)
END DO
STOP '[STOP in Ppar in xct/mxct01.f # 2]'
@@ -99,8 +106,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Babb (Ntot,
- * Polar, Iflpol, Iuif, Br, Bi, Xx, numDiff)
+ SUBROUTINE Babb (Polar, Iflpol, Iuif, Br, Bi, Xx, numDiff)
C
C *** Purpose -- Generate energy-independent portion of partial
C *** derivatives of R with respect to U-parameters
@@ -114,13 +120,12 @@ C
C
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
+ type(SammySpinGroupInfo)::spinInfo
logical::numDiff
- DIMENSION Ntot(*),
- * Polar(2,*),
+ DIMENSION Polar(2,*),
* Iflpol(2,*), Iuif(*), Br(Ntriag,*), Bi(Ntriag,*), Xx(*)
C
-C DIMENSION Ntot(Ngroup),
-C * Polar(2,Nres), Iflpol(2,Nres),
+C DIMENSION Polar(2,Nres), Iflpol(2,Nres),
C * Iuif(Nxxres), Br(Ntriag,Nyyres), Bi(Ntriag,Nyyres)
C
DATA Zero /0.0d0/, Two /2.0d0/
@@ -136,8 +141,10 @@ C
Igr = resInfo%getSpinGroupIndex()
IF (resInfo%getIncludeInCalc()) THEN
call resParData%getRedResonance(resonance, resInfo)
- Mmax = Ntot(Igr)
- Mmax2 = Mmax + 2
+ call resparData%getSpinGroupInfo(spinInfo, igr)
+ Mmax = spinInfo%getNumChannels()
+ Mmax2 = spinInfo%getNumResPar()
+ iGam = spinInfo%getGammaWidthIndex()
C
DO M=1,Mmax2
if(m.eq.1) then
@@ -176,9 +183,11 @@ C *** HERE U-PARAMETER IS RESONANCE ENERGY
D1 = Two*DSQRT(dABS(arg))
Kj = 0
DO K=1,Mmax
- f1 = resonance%getWidth(k+1)
+ ichan = spinInfo%getWidthForChannel(K)
+ f1 = resonance%getWidth(ichan)
DO J=1,K
- f2 = resonance%getWidth(j+1)
+ ichan = spinInfo%getWidthForChannel(J)
+ f2 = resonance%getWidth(ichan)
Kj = Kj + 1
D = f1*f2*D1
Br(Kj,Iiparx) = D
@@ -186,14 +195,16 @@ C *** HERE U-PARAMETER IS RESONANCE ENERGY
END DO
END DO
C
- ELSE IF (M.EQ.2) THEN
+ ELSE IF (M.EQ.(iGam+1)) THEN
C *** HERE U-PARAMETER IS GAMMA-SUB-GAMMA
- D1 = resonance%getWidth(1)
+ D1 = resonance%getWidth(iGam)
Kj = 0
DO K=1,Mmax
- f1 = resonance%getWidth(k+1)
+ ichan = spinInfo%getWidthForChannel(K)
+ f1 = resonance%getWidth(ichan)
DO J=1,K
- f2 = resonance%getWidth(j+1)
+ ichan = spinInfo%getWidthForChannel(J)
+ f2 = resonance%getWidth(ichan)
Kj = Kj + 1
D = f1*f2*D1
D = D + D
@@ -210,7 +221,8 @@ C *** HERE U-PARAMETERS ARE GAMMA-SUB-CHANNEL(M-2)
DO J=1,K
Kj = Kj + 1
IF (J.EQ.Mmm) THEN
- D = resonance%getWidth(k+1)
+ ichan = spinInfo%getWidthForChannel(k)
+ D = resonance%getWidth(ichan)
IF (K.EQ.Mmm) D = D + D
Br(Kj,Iiparx) = D
Bi(Kj,Iiparx) = D
@@ -221,7 +233,9 @@ C *** HERE U-PARAMETERS ARE GAMMA-SUB-CHANNEL(M-2)
DO J=Kk,Mmax
IF (J.EQ.Mmm) THEN
Jk = (J*(J-1))/2 + K
- D = resonance%getWidth(k+1)
+ ichan =
+ * spinInfo%getWidthForChannel(k)
+ D = resonance%getWidth(ichan)
IF (K.EQ.Mmm) D = D + D
Br(Jk,Iiparx) = D
Bi(Jk,Iiparx) = D
@@ -239,14 +253,18 @@ C *** channels
index = Iipar
end if
Kj = 0
+ iFis1 = spinInfo%getFirstFissionChannel()
+ iFis1 = spinInfo%getWidthForChannel(iFis1)
+ iFis2 = spinInfo%getSecondFissionChannel()
+ iFis2 = spinInfo%getWidthForChannel(iFis2)
DO K=1,Mmax
DO J=1,K
Kj = Kj + 1
Aa = Br(Kj,index-1)
Bb = Br(Kj,index)
IF (Aa.NE.Zero .OR. Bb.NE.Zero) THEN
- W2 = resonance%getWidth(3)
- W3 = resonance%getWidth(4)
+ W2 = resonance%getWidth(iFis1)
+ W3 = resonance%getWidth(iFis2)
Br(KJ,index-1) = -W3* Aa +W2*Bb
IF (Iflpol(2,Ires).EQ.0) THEN
Br(Kj,index) = Zero
@@ -258,8 +276,8 @@ C *** channels
Aa = Bi(Kj,index-1)
Bb = Bi(Kj,index)
IF (Aa.NE.Zero .OR. Bb.NE.Zero) THEN
- W2 = resonance%getWidth(3)
- W3 = resonance%getWidth(4)
+ W2 = resonance%getWidth(iFis1)
+ W3 = resonance%getWidth(iFis2)
Bi(Kj,index-1) = -W3*Aa + W2*Bb
IF (Iflpol(2,Ires).EQ.0) THEN
Bi(Kj,index) = Zero
@@ -299,8 +317,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Babbga (Ntot, Ishift, Lpent, Lspin, Bound, Echan,
- * Zke, Zkte, Zeta, Bga)
+ SUBROUTINE Babbga (Bound, Echan, Zke, Zkte, Zeta, Bga)
C
C *** PURPOSE -- GENERATE ENERGY-INDEPENDENT PORTION OF PARTIAL of R wrt
C *** reduced-width-amplitudes (for those which are not varied)
@@ -315,7 +332,12 @@ C
C
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
- DIMENSION Ntot(*), Ishift(Ntotc,*), Lpent(Ntotc,*),Lspin(Ntotc,*),
+ type(SammySpinGroupInfo)::spinInfo
+ type(SammyChannelInfo)::channelInfo
+ type(RMatChannelParams)::channel
+ type(SammyParticlePairInfo)::pairInfo
+ type(RMatParticlePair)::pair
+ DIMENSION
* Bound(Ntotc,*), Echan(Ntotc,*),
* Zke(Ntotc,*), Zkte(Ntotc,*),
* Zeta(Ntotc,*), Bga(Ntriag,Ntotc,*)
@@ -328,8 +350,9 @@ C
call resParData%getResonanceInfo(resInfo, Ires)
IF (resInfo%getIncludeInCalc()) THEN
call resParData%getRedResonance(resonance, resInfo)
- igr = resInfo%getSpinGroupIndex()
- Mmax = Ntot(Igr)
+ igr = resInfo%getSpinGroupIndex()
+ call resParData%getSpinGroupInfo(spinInfo, igr)
+ Mmax = spinInfo%getNumChannels()
eres = resonance%getEres()
Su = dABS(eres)
DO Mmm=1,Mmax
@@ -340,21 +363,34 @@ C
Iflr = resInfo%getChannelFitOption(m-1)
end if
IF (Iflr.LE.0 .OR. Iflr.GT.Nfpres) THEN
- width = resonance%getWidth(mmm+1)
- IF (Lpent(Mmm,Igr).EQ.1 .AND. width.NE.Zero) THEN
- Lsp = Lspin(Mmm,Igr)
+ call spinInfo%getChannelInfo(channelInfo, Mmm)
+ call resParData%getChannel(channel, channelInfo)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ if (pair%getCalcShift()) then
+ Ishift = 1
+ else
+ Ishift = 0
+ end if
+
+ ichan = spinInfo%getWidthForChannel(Mmm)
+ width = resonance%getWidth(ichan)
+ IF (pair%getPnt().EQ.1 .AND. width.NE.Zero) THEN
+ Lsp = channel%getL()
Q = dSQRT( dABS(eres-Echan(Mmm,Igr)) )
Rho = Zkte(Mmm,Igr)*Q
Rhox = Zke (Mmm,Igr)*Q
IF (Zeta(Mmm,Igr).EQ.Zero) THEN
CALL Pgh (Rho, Lsp, Bound(Mmm,Igr), Hr, Hi, P,
- * Dp, Ds, Ishift(Mmm,Igr), Iffy)
+ * Dp, Ds, Ishift, Iffy)
ELSE
Eta = Zeta(Mmm,Igr)/Q
CALL f_sammy_columb_Pghcou(Kwcoul,
* Rho, Lsp, Bound(Mmm,Igr),
* Hr, Hi,
- * P, Dp, Ds, Ishift(Mmm,Igr), Iffy, Eta,
+ * P, Dp, Ds, Ishift, Iffy, Eta,
* Sinphi, Cosphi, Dphi, 0)
END IF
C
@@ -369,7 +405,8 @@ C
DO J=1,K
Kj = Kj + 1
IF (J.EQ.Mmm) THEN
- D = resonance%getWidth(k+1)
+ ichan = spinInfo%getWidthForChannel(k)
+ D = resonance%getWidth(ichan)
IF (K.EQ.Mmm) D = D + D
Bga(Kj,Mmm,Ires) = D
END IF
@@ -379,7 +416,8 @@ C
DO J=Kk,Mmax
IF (J.EQ.Mmm) THEN
Jk = (J*(J-1))/2 + K
- D = resonance%getWidth(k+1)
+ ichan = spinInfo%getWidthForChannel(k)
+ D = resonance%getWidth(ichan)
IF (K.EQ.Mmm) D = D + D
Bga(Jk,Mmm,Ires) = D
END IF
diff --git a/sammy/src/xct/mxct02.f b/sammy/src/xct/mxct02.f
index 2b5328e2272ef1b63073e311feea17e83b5ff3e3..d75e2575b40339b0dd0954d485fcea606ea3d5fe 100644
--- a/sammy/src/xct/mxct02.f
+++ b/sammy/src/xct/mxct02.f
@@ -88,8 +88,7 @@ C *** Start Coulomb if needed
IF (Nnpar.GT.0) CALL Zero_Array (A_Idcoul ,
* 2*Ntotc*Ng*Ndatb*Nnpar)
CALL Zero_Array (A(Icx), Ntotc*Ng)
- CALL Start_Coul (I_Inent , I_Intot , A_Igoj ,
- * A_Izke , A(Icx))
+ CALL Start_Coul (A_Izke , A(Icx))
END IF
C
Idrcp = 1
@@ -138,7 +137,7 @@ C ************ Want dummy Gaussian resonances
C
C ************ Generate cross sections and derivatives
IF (Nd_Xct.NE.0 .AND. Ksolve.NE.2) THEN
- CALL N_D_Zcross (A, I_Intot , A(Iiuif), Kount_Helmut)
+ CALL N_D_Zcross (A, A(Iiuif), Kount_Helmut)
ELSE
CALL Zcross (A, Nnndrc, Ipoten, Kount_Helmut)
END IF
diff --git a/sammy/src/xct/mxct03.f b/sammy/src/xct/mxct03.f
index 8acae7a4f94d5df3c1930eaf8b20bcf2e44cbf3b..214d0bbaba6646265a78e449a67420cc1ca9b732 100644
--- a/sammy/src/xct/mxct03.f
+++ b/sammy/src/xct/mxct03.f
@@ -2,7 +2,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE N_D_Zcross (A, Ntot, Iuif, Kount_Helmut)
+ SUBROUTINE N_D_Zcross (A, Iuif, Kount_Helmut)
C
C *** PURPOSE -- Calculate numerically the partial derivatives
C *** of the cross section wrt R-matrix parameters
@@ -23,8 +23,9 @@ C
C
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
+ type(SammySpinGroupInfo)::spinInfo
real(kind=8)::XxTmp(1)
- DIMENSION Ntot(*), Iuif(*)
+ DIMENSION Iuif(*)
C
DATA Zero /0.0d0/, One /1.0d0/
DATA U_Increment /0.0001d0/
@@ -43,24 +44,24 @@ C
C *** First, for the original parameter values --
C *** Generate energy-independent pieces
C True is passed to babb since it is used to set parameters for numerical differentiation
- CALL Babb (I_Intot ,
+ CALL Babb (
* A_Ipolar , I_Iflpol , A(Iiuif), A(Ibr),
* A(Ibi), Xxtmp, .true.)
CALL Abpart (
* A(Ialphr), A(Ialphi), A(Ibr ),
* A(Ibi ), A(Ipr ), A(Ipi ), A(Idifen), A(Ixden ), A(Iupr ),
* A(Iupi ), A(Iiuif ), A(Idifma), A(Inot ), A(Inotu ), A(Ixx ),
- * A(Iprer ), A(Iprei ), I_Ixclud )
+ * A(Iprer ), A(Iprei ))
C
C *** Form the cross section Crss
- CALL Crosss (A, A_Igoj , I_Inent , I_Inext ,
- * I_Intot , I_Iishif , I_Ilpent , I_Ifexcl , I_Ilspin ,
- * A_Ibound , A_Iechan , I_Ixclud , I_Ifcros ,
+ CALL Crosss (A,
+ * I_Ifexcl ,
+ * A_Ibound , A_Iechan , I_Ifcros ,
* A_Iprmsc , I_Iflmsc , I_Ijkmsc , A_Izke ,
* A_Izkte , A_Izkfe , A_Izeta , I_Ifzke , I_Ifzkte ,
* I_Ifzkfe , A(Inprdr), A(Inpxdr), A(Icrss ), A(Ideriv),
* A(Icrssx), A(Idervx), A(Iprer ), A(Iprei ), A(Ixdrcp),
- * A(Indrcp), I_Izzzz2 , Nnndrc, 0, Kount_Helmut)
+ * A(Indrcp), Nnndrc, 0, Kount_Helmut)
C
IF (Ncrssx.NE.0) THEN
N = Ncrsss*Nnpar*resParData%getNumSpinGroups()
@@ -80,8 +81,10 @@ C *** Now vary parameters one-by-one to get derivatives
IF (resInfo%getEnergyFitOption().GE.0) THEN
Igrp = resInfo%getSpinGroupIndex()
- Ntotn = Ntot(Igrp)
- Ntotn2 = Ntotn + 2
+ call resparData%getSpinGroupInfo(spinInfo, Igrp)
+ Ntotn = spinInfo%getNumChannels()
+ Ntotn2 = spinInfo%getNumResPar()
+ iGam = spinInfo%getGammaWidthIndex()
call resParData%getRedResonance(resonance, resInfo)
@@ -111,17 +114,18 @@ C *** RESONANCE ENERGY
eres = B
eres = eres*(One+U_Increment/100.d0)**2
call resonance%setEres(eres)
- ELSE IF (M.EQ.2) THEN
+ ELSE IF (M.EQ.(iGam+1)) THEN
C *** GAMMA-SUB-GAMMA
- G1 = resonance%getWidth(1)
+ G1 = resonance%getWidth(iGam)
X = G1*U_increment
call resonance%setWidth(1, G1*(One+U_increment))
- ELSE IF (M.GE.3) THEN
+ ELSE
C *** GAMMA-SUB-N (PARTICLE WIDTHS)
M2 = M - 2
+ ichan = spinInfo%getWidthForChannel(M)
IF (M2.EQ.1 .OR. Kpolar.NE.1) THEN
- B = resonance%getWidth(m2+1)
- call resonance%setWidth(m2+1,
+ B = resonance%getWidth(ichan)
+ call resonance%setWidth(ichan,
* B*(One+U_Increment))
X = B*U_Increment
ELSE
@@ -137,28 +141,25 @@ C
END IF
C
C *** Generate energy-independent pieces with new parameter
- CALL Babb ( I_Intot ,
- * A_Ipolar ,
+ CALL Babb ( A_Ipolar ,
* I_Iflpol , A(Iiuif ), A(Ibr ), A(Ibi),
* Xxtmp, .true.)
CALL Abpart (A(Ialphr),
* A(Ialphi), A(Ibr ), A(Ibi ), A(Ipr ),
* A(Ipi ), A(Idifen), A(Ixden ), A(Iupr ),
* A(Iupi ), A(Iiuif ), A(Idifma), A(Inot ),
- * A(Inotu ), A(Ixx ), A(Iprer ), A(Iprei ),
- * I_Ixclud )
+ * A(Inotu ), A(Ixx ), A(Iprer ), A(Iprei ))
C
C *** Form the cross section Crss with new parameter value
- CALL Crosss (A, A_Igoj , I_Inent ,
- * I_Inext , I_Intot , I_Iishif , I_Ilpent ,
- * I_Ifexcl , I_Ilspin , A_Ibound , A_Iechan ,
- * I_Ixclud , I_Ifcros ,
+ CALL Crosss (A,
+ * I_Ifexcl , A_Ibound , A_Iechan ,
+ * I_Ifcros ,
* A_Iprmsc , I_Iflmsc , I_Ijkmsc , A_Izke ,
* A_Izkte , A_Izkfe , A_Izeta , I_Ifzke ,
* I_Ifzkte , I_Ifzkfe , A(Inprdr), A(Inpxdr),
* A(Icrsnd), A(Ideriv), A(Icrxnd), A(Idervx),
* A(Iprer ), A(Iprei ), A(Ixdrcp), A(Indrcp),
- * I_Izzzz2 , Nnndrc, 0, Kount_Helmut)
+ * Nnndrc, 0, Kount_Helmut)
C
C *** Generate numerical derivatives
CALL Fix_N_D (A(Icrss), A(Icrssx), A(Ideriv),
diff --git a/sammy/src/xct/mxct04.f b/sammy/src/xct/mxct04.f
index 9ed4a8a53df844853f11abf29ce123acc3e54d76..084a121db62937bc81f5cab95b118baee43466f7 100644
--- a/sammy/src/xct/mxct04.f
+++ b/sammy/src/xct/mxct04.f
@@ -27,7 +27,7 @@ C *** from Upr and Upi = energy-dependent pieces of those derivs
* A(Ialphr), A(Ialphi), A(Ibr ),
* A(Ibi ), A(Ipr ), A(Ipi ), A(Idifen), A(Ixden ), A(Iupr),
* A(Iupi ), A(Iiuif ), A(Idifma), A(Inot ), A(Inotu ), A(Ixx ),
- * A(Iprer ), A(Iprei ), I_Ixclud )
+ * A(Iprer ), A(Iprei ))
end if
C
C *** Generate Pgar & Pgai = partial of R wrt (Gamma-x) *
@@ -45,14 +45,14 @@ C
C
C *** FORM THE CROSS SECTION Crss AND THE ( PARTIAL DERIVATIVES OF THE
C *** CROSS SECTION WITH RESPECT TO THE VARIED PARAMETERS ) = Deriv
- CALL Crosss (A, A_Igoj , I_Inent , I_Inext ,
- * I_Intot , I_Iishif , I_Ilpent , I_Ifexcl , I_Ilspin ,
- * A_Ibound , A_Iechan , I_Ixclud , I_Ifcros ,
+ CALL Crosss (A,
+ * I_Ifexcl ,
+ * A_Ibound , A_Iechan , I_Ifcros ,
* A_Iprmsc , I_Iflmsc , I_Ijkmsc , A_Izke ,
* A_Izkte , A_Izkfe , A_Izeta , I_Ifzke , I_Ifzkte ,
* I_Ifzkfe , A(Inprdr), A(Inpxdr), A(Icrss ), A(Ideriv),
* A(Icrssx), A(Idervx), A(Iprer ), A(Iprei ), A(Ixdrcp),
- * A(Indrcp), I_Izzzz2 , Nnndrc, Ipoten, Kount_Helmut)
+ * A(Indrcp), Nnndrc, Ipoten, Kount_Helmut)
C
RETURN
END
diff --git a/sammy/src/xct/mxct05.f b/sammy/src/xct/mxct05.f
index e00cf4e71b9316cae2527c0d9e028498799ef853..966e7612aea74bac21b47351ab5eb312d0fcab3c 100644
--- a/sammy/src/xct/mxct05.f
+++ b/sammy/src/xct/mxct05.f
@@ -4,7 +4,7 @@ C --------------------------------------------------------------
C
SUBROUTINE Abpart (
* Alphar, Alphai, Br, Bi, Pr, Pi, Difen, Xden, Upr, Upi,
- * Iuif, Difmax, Not, Notu, Xx, Prer, Prei, Ixclud)
+ * Iuif, Difmax, Not, Notu, Xx, Prer, Prei)
C
C *** Purpose -- Generate Alphar & Alphai = energy-independent bits
C *** and Upr and Upi = Energy-dependent pieces of Pr & Pi
@@ -25,8 +25,7 @@ C
* Alphar(*), Alphai(*),
* Br(Ntriag,*), Bi(Ntriag,*), Pr(Ntriag,*), Pi(Ntriag,*),
* Difen(*), Xden(*), Upr(*), Upi(*), Iuif(*), Difmax(*),
- * Not(*), Notu(*), Xx(*), Prer(Ntriag,*), Prei(Ntriag,*),
- * Ixclud(*)
+ * Not(*), Notu(*), Xx(*), Prer(Ntriag,*), Prei(Ntriag,*)
type(SammyResonanceInfo)::resInfo
type(SammySpinGroupInfo)::spinInfo
type(RMatResonance)::resonance
@@ -37,7 +36,7 @@ C * Bi(Ntriag,Nyyres), Pr(Ntriag,Nyyres),
C * Pi(Ntriag,Nyyres), Difen(Nres), Xden(Nres),
C * Upr(Nyyres), Upi(Nyyres), Iuif(Nyyres), Difmax(Nres),
C * Not(Nres) , Notu(Nyyres), Xx(Nres), Prer(Ntriag,Ngroup),
-C * Prei(Ntriag,Ngroup), Ixclud(Ngroup)
+C * Prei(Ntriag,Ngroup)
C
DATA Zero /0.0d0/, One /1.0d0/, Two /2.0d0/
C
@@ -62,7 +61,8 @@ C
ccccccccccccccccccccccccccccccccccc
not(n)=0
ccccccccccccccccccccccccccccccccccc
- G2 = resonance%getWidth(1)**2
+ ichan = spinInfo%getGammaWidthIndex()
+ G2 = resonance%getWidth(ichan)**2
G3 = G2**2
Aa = Difen(N)**2 + g3
Xden(N) = One/Aa
@@ -90,7 +90,7 @@ C
C resonance has spinInfo%getNumChannels() + 1 width associated with it
C as gamma width does not have a channel number
C
- N2 = spinInfo%getNumChannels() + 2
+ N2 = spinInfo%getNumResPar()
DO M=1,N2
if(m.eq.1) then
Ipar = resInfo%getEnergyFitOption()
@@ -174,10 +174,12 @@ C resonance has spinInfo%getNumChannels() + 1 width associated with it
C as gamma width does not have a channel number
C
DO IjK=1,spinInfo%getNumChannels()
- channelWidthC = resonance%getWidth(ijk + 1)
+ ichan = spinInfo%getWidthForChannel(Ijk)
+ channelWidthC = resonance%getWidth(ichan)
DO Ijl=1, IjK
Ij = Ij + 1
- channelWidthCPrime = resonance%getWidth(ijl + 1)
+ ichan = spinInfo%getWidthForChannel(Ijl)
+ channelWidthCPrime = resonance%getWidth(ichan)
Prer(Ij,Ig) = Prer(Ij,Ig) +
* Aa*channelWidthC*channelWidthCPrime
Prei(Ij,Ig) = Prei(Ij,Ig) +
diff --git a/sammy/src/xct/mxct06.f b/sammy/src/xct/mxct06.f
index bfbe9eed64245fc784c5071407105aab228ae67a..ebe4f9692de80df36ff2461c91f9d0b13614c506 100644
--- a/sammy/src/xct/mxct06.f
+++ b/sammy/src/xct/mxct06.f
@@ -2,15 +2,12 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Crosss (A, Goj, Nent , Next , Ntot ,
- * Ishift, Lpent , Jfexcl, Lspin , Bound , Echan , Jxclud,
+ SUBROUTINE Crosss (A,
+ * Jfexcl, Bound , Echan ,
* Jfcros, Parmsc, Jflmsc , Jjkmsc , Zke ,
* Zkte , Zkfe , Zeta , If_Zke, If_Zkte, If_Zkfe, Nprdr ,
* Npxdr , Crss , Deriv , Crssx , Derivx , Prer , Prei ,
- * Xdrcpt, Ndrcpt, Kzzz2, Nnndrc, Ipoten, Kount_Helmut)
-C
-C *** CAREFUL -- This must be "Jxclud" because it cannot be "Ixclud" which
-C *** is in SAMLOC. Likewise several others.
+ * Xdrcpt, Ndrcpt, Nnndrc, Ipoten, Kount_Helmut)
C
C *** PURPOSE -- Form the cross sections Crss(Isigma,Igroup) and the
C *** ( partial derivatives of the cross section with respect to
@@ -36,21 +33,19 @@ C
COMMON /Ifsubs/ Ifres, Ifcap, Ifzzz, Ifext, Ifrad, Ifiso, Ifradt
C
DIMENSION A(-Msize:Msize)
- DIMENSION Goj(*), Nent(*), Next(*), Ntot(*),
- * Ishift(Ntotc,*), Lpent(Ntotc,*), Jfexcl(Ntotc,*),
- * Lspin(Ntotc,*), Bound(Ntotc,*), Echan(Ntotc,*), Jxclud(*),
+ DIMENSION Jfexcl(Ntotc,*),
+ * Bound(Ntotc,*), Echan(Ntotc,*),
* Jfcros(*), Nprdr(*), Npxdr(*),
* Parmsc(*), Jflmsc(*), Jjkmsc(*),
* Crss(Ncrsss,*), Deriv(Ncrsss,Nnpar,*), Crssx(2,Ntotc,Ntotc,*),
* Derivx(2,Ntotc,Ntotc,Nnpar,*), Zke(Ntotc,*), Zkte(Ntotc,*),
* Zkfe(Ntotc,*), Zeta(Ntotc,*), If_Zke(*), If_Zkte(Ntotc,*),
* If_Zkfe(Ntotc,*), Prer(Ntriag,*), Prei(Ntriag,*),
- * Xdrcpt(*), Ndrcpt(*), Kzzz2(Ntotc,*)
+ * Xdrcpt(*), Ndrcpt(*)
C
-C DIMENSION Goj(Ngroup), Nent(Ngroup), Next(Ngroup),
-C * Ntot(Ngroup), Ishift(Ntotc,Ngroup), Lpent(Ntotc,Ngroup),
-C * Jfexcl(Ntotc,Ngroup), Lspin(Ntotc,Ngroup), Bound(Ntotc,Ngroup),
-C * Echan(Ntotc,Ngroup), Jxclud(Ngroup), Jfcros(Ncrsss),
+C DIMENSION
+C * Jfexcl(Ntotc,Ngroup), Bound(Ntotc,Ngroup),
+C * Echan(Ntotc,Ngroup), Jfcros(Ncrsss),
C * Nprdr(Ngroup), Npxdr(Ngroup),
C * Crss(Ncrsss,Ngroup), Deriv(Ncrsss,Nnpar,Ngroup),
C * Crssx(2,Ntotc,Ntotc,Ngroup), Derivx(2,Ntotc,Ntotc,Nnpar,Ngroup),
@@ -108,12 +103,12 @@ C
END IF
Nnnn = N
- Ntotnn = Ntot(N)
+ call resParData%getSpinGroupInfo(spinInfo, N)
+ Ntotnn = spinInfo%getNumChannels()
IF (Ifdif.NE.0) CALL Zero_Array (A(Icscs), 2*Ntriag)
- IF (Jxclud(N).EQ.1) THEN
+ IF (.not.spinInfo%getIncludeInCalc()) THEN
If (Ks_Res.NE.2) Kstart = Kstart + Nprdr(N)
ELSE
- call resParData%getSpinGroupInfo(spinInfo, N)
VarAbn = spinInfo%getAbundance()
C
Nnnn = N
@@ -121,7 +116,7 @@ C
Npr = 0
IF (Ks_Res.NE.2) Npr = Nprdr(N)
IF (Ks_Res.NE.2) Npx = Npxdr(N)
- Nn2 = Ntot(N)*(Ntot(N)+1)
+ Nn2 = Ntotnn*(Ntotnn+1)
Nn = Nn2/2
C
C
@@ -129,9 +124,10 @@ C *** Set R-Matrix and other necessary arrays
Lrmat = 0
- Nentnn = Nent(Nnnn)
- CALL Setr (Nentnn, Ntotnn, Ishift(1,N), Lpent(1,N),
- * Lspin(1,N), Bound(1,N), Echan(1,N), A_Iprext , I_Iflext ,
+ Nentnn = spinInfo%getNumEntryChannels()
+ Nextnn = spinInfo%getNumExitChannels()
+ CALL Setr (Nentnn, Ntotnn, N,
+ * Bound(1,N), Echan(1,N), A_Iprext , I_Iflext ,
* A(Isinsq), A(Isinph), A(Idphi), A(Icscs),
* A(Iss), A(Icc), Zkfe(1,N), Zkte(1,N), Zeta(1,N),
* A(Ialphr), A(Ialphi), A(Inot), A(Idpdr), A(Idsdr),
@@ -163,9 +159,9 @@ C *** Generate XQ & Xxxx matrices
* A(Irootp), A(Linvr), A(Linvi), A(Ixxxxr), A(Ixxxxi))
END IF
C
- Dgoj = Goj(N)
+ Dgoj = spinInfo%getGFactor()
C *** generate cross section pieces
- CALL Sectio (Nent(N), Next(N), Lspin(1,N), Echan(1,N),
+ CALL Sectio (Nentnn, Nextnn, N, Echan(1,N),
* Jfexcl(1,N), Jfcros, Zke(1,N), Zeta(1,N), A(Ixxxxr),
* A(Ixxxxi), A(Isinsq), A(Isinph), A(Itermf), Crss(1,N),
* Crssx, A(Icscs), Dgoj, Ntotnn)
@@ -183,7 +179,7 @@ C *** Generate Q = partial Derivative of Xxxx wrt R
C
C *** Generate T = partial of cross sections with respect to R
C *** T = [ partial (sigma) wrt X ] * Q
- CALL Settri (Nent(N), Next(N), Lspin(1,N), Echan(1,N),
+ CALL Settri (Nentnn, Nextnn, N, Echan(1,N),
* Jfexcl(1,N), Zke(1,N), Zeta(1,N), Jfcros,A(Ixxxxr),
* A(Ixxxxi), A(Isinsq), A(Isinph), A(Icscs), A(Iqr),
* A(Iqi), A(Itr), A(Iti), A(Itx), Ntotnn)
@@ -191,7 +187,7 @@ C *** T = [ partial (sigma) wrt X ] * Q
C
IF (Lrmat.EQ.0 .AND. Npr.NE.0 .AND. Ifres.EQ.0) THEN
C *** Find derivatives of cross sections wrt res pars
- CALL Derres (Nent(N), Jfexcl(1,N), Jfcros,
+ CALL Derres (Nentnn, Jfexcl(1,N), Jfcros,
* A(Ipr), A(Ipi), Deriv(1,1,N), Derivx(1,1,1,1,N),
* A(Itr), A(Iti), A(Itx), A(Inotu), A(Iddddd), Dgoj,
* Ntotnn, Minr, Maxr)
@@ -199,7 +195,7 @@ C *** Find derivatives of cross sections wrt res pars
C
IF (Lrmat.EQ.0 .AND. Ifcap.EQ.0) THEN
C *** Find derivatives of cs wrt universal capture width
- CALL Dercap (Nent(N), Jfexcl(1,N), Jfcros,
+ CALL Dercap (Nentnn, Jfexcl(1,N), Jfcros,
* A(Ipr), A(Ipi), Deriv(1,1,N), Derivx(1,1,1,1,N),
* A(Itr), A(Iti), A(Itx), A(Inotu), A(Iddddd), Dgoj,
* Ntotnn, Minr, Maxr)
@@ -209,7 +205,7 @@ C
IF (Ifzzz.EQ.0) THEN
C *** Find derivatives of cross sections wrt Tzero & Elzero
C *** (via energy-denominator portion of R-matrix)
- CALL Dereee (Nent(n), Jfexcl(1,N), Jfcros,
+ CALL Dereee (Nentnn, Jfexcl(1,N), Jfcros,
* Derivx(1,1,1,1,N), A(Itr), A(Iti), A(Itx),
* Prer(1,N), Prei(1,N), A(Iddtlz), Ntotnn)
END IF
@@ -218,7 +214,7 @@ C
C *** Find deriv of cross sections with respect to R-ext pars
CALL Derext (Jfexcl(1,N), Jfcros,A_Iprext , I_Iflext ,
* Deriv(1,1,N), Derivx(1,1,1,1,N), A(Itr), A(Itx),
- * Dgoj, Ntotnn, Nent(N), Krext)
+ * Dgoj, Ntotnn, Nentnn, Krext)
END IF
C
IF (Lrmat.EQ.0 .AND. (Ifzzz.EQ.0 .OR. Ifrad.EQ.0)) THEN
@@ -227,7 +223,7 @@ C *** Find derivatives of Xxxx wrt rho
* A(Idpdr), A(Idsdr), A(Ipxrr), A(Ipxri), Ntotnn)
END IF
C
- Nnext = Next(N)
+ Nnext = Nextnn
IF (Nnext.EQ.0) Nnext = 1
IF (Ifzzz.EQ.0 .OR. Ifrad.EQ.0) THEN
C *** Find derivatives of Crss & Crssx wrt rho
@@ -240,7 +236,7 @@ C *** Find derivatives of Crss & Crssx wrt rho
C
IF (Ifrad.EQ.0) THEN
C *** Find Deriv of Crss & Crssx wrt radii
- CALL Derrad (Nent(N), Next(N), Echan(1,N),
+ CALL Derrad (Nentnn, Nextnn, Echan(1,N),
* Jfexcl(1,N), Jfcros, Zke(1,N), If_Zkte(1,N),
* If_Zkfe(1,N), Deriv(1,1,N), Derivx(1,1,1,1,N),
* A(Idsf), A(Idst), A(Idstt), A(Idsfx), A(Idstx),
@@ -253,20 +249,20 @@ C *** part due to non-varied particle widths)
CALL Derwid (Jfexcl(1,N), Jfcros, I_Ifltru ,
* A(Ipgar), A(Ipgai), Deriv(1,1,N),
* Derivx(1,1,1,1,N), A(Itr), A(Iti), A(Itx),
- * A(Iddddd), Dgoj, Ntotnn, Nent(N), Nfprrr)
+ * A(Iddddd), Dgoj, Ntotnn, Nentnn, Nfprrr)
END IF
C
IF (Ifzzz.EQ.0) THEN
C *** Find deriv of Crss & Crssx wrt Tzero & Elzero (via rho
C via Phi)
- CALL Dertze_Phi (Nent(N), Jfcros, Zkfe(1,N),A(Iddtlz),
+ CALL Dertze_Phi (Nentnn, Jfcros, Zkfe(1,N),A(Iddtlz),
* Derivx(1,1,1,1,N), A(Idsf), A(Idsfx), A(Idstx))
END IF
C
IF (Lrmat.EQ.0 .AND. Ifzzz.EQ.0) THEN
C *** Find deriv of Crss & Crssx wrt Tzero & Elzero (via rho
C via P & S)
- CALL Dertze (Nent(N), Next(N), Jfexcl(1,N), Jfcros,
+ CALL Dertze (Nentnn, Nextnn, Jfexcl(1,N), Jfcros,
* Zkte(1,N), A(Iddtlz), Derivx(1,1,1,1,N), A(Idst),
* A(Idstt), A(Idstx), Nnext, Ntotnn)
END IF
diff --git a/sammy/src/xct/mxct07.f b/sammy/src/xct/mxct07.f
index fdd84d0f7b73a4f808085f35b734530d1b280379..c61f1c657989d1357e03e974bc99087c5ae823df 100644
--- a/sammy/src/xct/mxct07.f
+++ b/sammy/src/xct/mxct07.f
@@ -2,7 +2,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Setr (Nent, Ntot, Ishift, Lpent, Lspin, Bound, Echan,
+ SUBROUTINE Setr (Nent, Ntot, Igr, Bound, Echan,
* Parext, Iflext, Sinsqr, Sin2ph, Dphi, Cscs, Sinphi,
* Cosphi, Zkfe, Zkte, Zeta, Alphar, Alphai, Not, Dpdr, Dsdr, Rmat,
* Ymat, Rootp, Elinvr, Elinvi, Psmall, Krext, Lrmat, Min, Max,
@@ -26,7 +26,7 @@ C
use RMatResonanceParam_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
- DIMENSION Ishift(*), Lpent(*), Lspin(*), Bound(*), Echan(*),
+ DIMENSION Bound(*), Echan(*),
* Parext(Krext,Ntotc,*), Iflext(Krext,Ntotc,*),
* Sinsqr(*), Sin2ph(*), Dphi(*), Cscs(2,*), Zkfe(*),
* Zkte(*), Zeta(*), Alphar(*), Alphai(*), Not(*), Dpdr(*),
@@ -36,11 +36,16 @@ C
LOGICAL ABOVE_THRESHOLD
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
+ type(SammySpinGroupInfo)::spinInfo
+ type(SammyChannelInfo)::channelInfo
+ type(RMatChannelParams)::channel
+ type(SammyParticlePairInfo)::pairInfo
+ type(RMatParticlePair)::pair
type(sammy_LogarithmicDerivativeCWF) :: cwf_solver ! CWF solver interface
REAL(selected_real_kind(14)) :: tmp_holder
double precision, parameter :: Big = 1.0E30
C
-C DIMENSION Ishift(Ntotc), Lpent(Ntotc), Lspin(Ntotc), Bound(Ntotc),
+C DIMENSION Bound(Ntotc),
C * Echan(Ntotc), Parext(Nrext,Ntotc,Ngroup),
C * Iflext(Nrext,Ntotc,Ngroup),
C * Zkte(Ntotc), Zeta(Ntotc), Alphar(Nres), Alphai(Nres),
@@ -80,20 +85,36 @@ C
END DO
END DO
C
+ call resParData%getSpinGroupInfo(spinInfo, igr)
+
IF (Max.GE.Min .AND. Min.GT.0) THEN
DO Ires=Min,Max
call resParData%getResonanceInfo(resInfo, Ires)
call resParData%getRedResonance(resonance, resInfo)
KL = 0
DO K=1,Ntot
- channelWidthC = resonance%getWidth(k+1)
+ ichan = spinInfo%getWidthForChannel(k)
+ channelWidthC = resonance%getWidth(ichan)
+ call spinInfo%getChannelInfo(channelInfo, K)
+ call resParData%getChannel(channel, channelInfo)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ if (pair%getCalcShift()) then
+ Ishift = 1
+ else
+ Ishift = 0
+ end if
+
DO L=1,K
- channelWidthCPrime = resonance%getWidth(l+1)
+ ichan = spinInfo%getWidthForChannel(L)
+ channelWidthCPrime = resonance%getWidth(ichan)
beta = channelWidthC * channelWidthCPrime
KL = KL + 1
! Check on Beta is unnecessary, as we would just add zero - who cares
! Use K to track whether we add closed channel contribution based on value of Ishift
- IF( Ishift( K ) == 0 ) THEN ! B=S
+ IF( Ishift == 0 ) THEN ! B=S
IF ( Su.GT.Echan(K) .AND. Su.GT.Echan(L) ) THEN
Rmat(1,KL) = Rmat(1,KL)+Alphar(Ires)*Beta
IF (Not(Ires).NE.1) THEN
@@ -146,6 +167,13 @@ C
C
II = 0
DO I=1,Ntot
+ call spinInfo%getChannelInfo(channelInfo, I)
+ call resParData%getChannel(channel, channelInfo)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+
II = II + I
Rootp (I) = Zero ! new default to cancel out closed channels
Elinvr(I) = Zero
@@ -159,7 +187,7 @@ C
ABOVE_THRESHOLD = .FALSE.
if( (Su - Echan(I) ) .GT. Zero ) ABOVE_THRESHOLD = .TRUE.
- Lsp = Lspin( I )
+ Lsp = channel%getL()
Q = Zero ! effective incoming energy
IF ( ABOVE_THRESHOLD ) THEN ! effective incoming energy is above channel threshold
Q = dSQRT( Su - Echan(I) )
@@ -191,7 +219,7 @@ C
P = Zero
Dp = Zero
IF( ABOVE_THRESHOLD ) THEN
- IF( Lpent( I ) == 0 ) THEN ! assign value
+ IF( pair%getPnt() == 0 ) THEN ! assign value
P = One
Dp = Zero
ELSE ! compute value
@@ -202,7 +230,14 @@ C
S = Zero
Ds = Zero
- IF( Ishift( I ) /= 0 ) THEN ! Told B=/=S
+
+ if (pair%getCalcShift()) then
+ Ishift = 1
+ else
+ Ishift = 0
+ end if
+
+ IF( Ishift /= 0 ) THEN ! Told B=/=S
IF( .NOT. ABOVE_THRESHOLD ) THEN ! recompute wave functions...
! TODO: Might want to set the rho/eta on the solver based on
! ABOVE_THRESHOLD to begin with - reduces # CWF solves
@@ -220,7 +255,7 @@ C
Hr = Zero
Hi = Zero
- IF( Ishift( I ) /= 0 ) THEN
+ IF( Ishift /= 0 ) THEN
! we set the denominator first, then divide by it later
Hr = ( S - Bound( I ) )**2 + P**2
Hi = -P / Hr
@@ -269,14 +304,14 @@ C
ENDIF
! Looking at the OLD SAMMY check on this part:
- ! IF (Iffy.EQ.0 .AND. .NOT. (Ishift(I).EQ.0 .AND. (One-P*Rmat(2,Ii).EQ.One .OR. P.LT.Tiny))) THEN
+ ! IF (Iffy.EQ.0 .AND. .NOT. (Ishif.EQ.0 .AND. (One-P*Rmat(2,Ii).EQ.One .OR. P.LT.Tiny))) THEN
! ...
! ELSE
! ...
! ENDIF
! Let's apply some boolean algebra, with these as convenience truth values:
! A = ( Iffy.EQ.0 )
- ! B = ( Ishift(I).EQ.0 )
+ ! B = ( Ishift.EQ.0 )
! C = ( One-P*Rmat(2,Ii).EQ.One )
! D = ( P.LT.Tiny )
! Now the truth value of the compound statement in the IF can be expressed as:
@@ -298,7 +333,7 @@ C
Dpdr(I) = Dp
Dsdr(I) = Ds
- IF (Iffy.EQ.0 .AND. .NOT. (Ishift(I).EQ.0 .AND.
+ IF (Iffy.EQ.0 .AND. .NOT. (Ishift.EQ.0 .AND.
* (One-P*Rmat(2,Ii).EQ.One .OR. P.LT.Tiny))) THEN
Elinvr(I) = Hr
Elinvi(I) = Hi
diff --git a/sammy/src/xct/mxct09.f b/sammy/src/xct/mxct09.f
index 57d5525e180aa52644aed767c5f8a8d40c35e781..dd431d65dd14a5295a48e9cf25a146e63d62082e 100644
--- a/sammy/src/xct/mxct09.f
+++ b/sammy/src/xct/mxct09.f
@@ -63,7 +63,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Sectio (Nent, Next, Lspin, Echan, If_Excl, Ifcros, Zke,
+ SUBROUTINE Sectio (Nent, Next, igr, Echan, If_Excl, Ifcros, Zke,
* Zeta, Xxxxr, Xxxxi, Sinsqr, Sin2ph, Termf, Crss, Crssx, Cscs,
* Dgoj, Ntotnn)
C
@@ -72,9 +72,15 @@ C
use fixedi_m
use ifwrit_m
use varyr_common_m
+ use EndfData_common_m
+ use SammyResonanceInfo_M
+ use RMatResonanceParam_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
- DIMENSION Lspin(*), Echan(*), If_Excl(*), Ifcros(*), Zke(*),
+ type(SammySpinGroupInfo)::spinInfo
+ type(SammyChannelInfo)::channelInfo
+ type(RMatChannelParams)::channel
+ DIMENSION Echan(*), If_Excl(*), Ifcros(*), Zke(*),
* Zeta(*), Xxxxr(*), Xxxxi(*),Sinsqr(*), Sin2ph(*), Termf(*),
* Crss(*), Crssx(2,Ntotc,Ntotc,*), Cscs(2,*)
DATA Zero /0.0d0/, One /1.0d0/, Two /2.0d0/
@@ -160,18 +166,25 @@ C
IF (Ifdif.NE.0) THEN
C
C *** Angular Distribution Crssx(.,i,ix,igroup) = (1-U)/2
+ call resParData%getSpinGroupInfo(spinInfo, igr)
DO Ichan=1,Ntotnn
+ call spinInfo%getChannelInfo(channelInfo, Ichan)
+ call resParData%getChannel(channel, channelInfo)
+ Lspin = channel%getL()
Ifs = If_Stay (Ichan, Ifdif, Nent, If_Excl(Ichan), Kaptur)
IF (Ifs.EQ.0) THEN
C
IF (Zeta(Ichan).NE.Zero .AND. Su.GT.Echan(Ichan)) THEN
- CALL Get_Coul_Phase (Cr, Ci, Lspin(Ichan),
+ CALL Get_Coul_Phase (Cr, Ci, Lspin,
* Echan(Ichan), Zeta(Ichan), Su)
ELSE
Cr = One
Ci = Zero
END IF
DO Ichanx=1,Nent
+ call spinInfo%getChannelInfo(channelInfo, Ichanx)
+ call resParData%getChannel(channel, channelInfo)
+ Lspinx = channel%getL()
IF (Ichanx.LE.Ichan) THEN
II = (Ichan*(Ichan-1))/2 + Ichanx
ELSE
@@ -191,13 +204,13 @@ C *** real and imaginary parts of (1-U)/2
* Zeta(Ichanx).NE.Zero) THEN
Br = Ar*Cr - Ai*Ci
Bi = Ar*Ci + Ai*Cr
- IF ((Lspin(Ichanx).NE.Lspin(Ichan) .OR.
+ IF ((Lspinx.NE.Lspin .OR.
* Zeta(Ichanx).NE.Zeta(Ichan)) .AND.
* Ichan.NE.Ichanx ) THEN
IF (Zeta(Ichanx).NE.Zero .AND.
* Su.GT.Echan(Ichanx)) THEN
CALL Get_Coul_Phase (Dr, Di,
- * Lspin(Ichanx), Echan(Ichanx),
+ * Lspinx, Echan(Ichanx),
* Zeta(Ichanx), Su)
ELSE
Dr = One
diff --git a/sammy/src/xct/mxct10.f b/sammy/src/xct/mxct10.f
index 657c132ffc75c1fb8ef24346e9fb53115d6bd77c..fbb0c83e5df20a8903ba5b64bf5aa8bea43ef565 100644
--- a/sammy/src/xct/mxct10.f
+++ b/sammy/src/xct/mxct10.f
@@ -78,7 +78,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Settri (Nent, Next, Lspin, Echan, If_Excl, Zke, Zeta,
+ SUBROUTINE Settri (Nent, Next, igr, Echan, If_Excl, Zke, Zeta,
* Ifcros, Xxxxr, Xxxxi, Sinsqr, Sin2ph, Cscs, Qr, Qi, Tr, Ti, Tx,
* Ntot)
C
@@ -88,9 +88,15 @@ C
use fixedi_m
use ifwrit_m
use varyr_common_m
+ use EndfData_common_m
+ use SammyResonanceInfo_M
+ use RMatResonanceParam_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
- DIMENSION Lspin(*), Echan(*), If_Excl(*), Zke(*), Zeta(*),
+ type(SammySpinGroupInfo)::spinInfo
+ type(SammyChannelInfo)::channelInfo
+ type(RMatChannelParams)::channel
+ DIMENSION Echan(*), If_Excl(*), Zke(*), Zeta(*),
* Ifcros(*), Xxxxr(*), Xxxxi(*), Sinsqr(*), Sin2ph(*), Cscs(2,*),
* Qr(NN,*), Qi(NN,*), Tr(Ncrsss,*), Ti(Ncrsss,*), Tx(2,Ntriag,*)
C
@@ -287,10 +293,15 @@ C *** Ar = Qr*Dr - Qi*Di, Ai = Qi*Dr + Qr*Di
C
C *** Now multiply by Coulomb phase shift if needed
C
+ call resParData%getSpinGroupInfo(spinInfo, igr)
DO K=1,Ntot
+ call spinInfo%getChannelInfo(channelInfo, K)
+ call resParData%getChannel(channel, channelInfo)
+ Lspin = channel%getL()
+
IF (If_Stay (K,Ifdif,Nent,If_Excl(K),Kaptur) .EQ.0) THEN
IF (Zeta(K).NE.Zero .AND. Su.GT.Echan(K)) THEN
- CALL Get_Coul_Phase (Cr, Ci, Lspin(K), Echan(K),
+ CALL Get_Coul_Phase (Cr, Ci, Lspin, Echan(K),
* Zeta(K), Su)
Ix = 1
ELSE
@@ -301,6 +312,9 @@ C
C
KL = (K*(K-1))/2
DO L=1,K
+ call spinInfo%getChannelInfo(channelInfo, L)
+ call resParData%getChannel(channel, channelInfo)
+ LspinL = channel%getL()
KL = KL + 1
IF (K.EQ.L) THEN
Dr = Cr
@@ -308,7 +322,7 @@ C
Iy = Ix
ELSE
IF (Zeta(L).NE.Zero .AND. Su.GT.Echan(L)) THEN
- CALL Get_Coul_Phase (Dr, Di, Lspin(L), Echan(L),
+ CALL Get_Coul_Phase (Dr, Di, LspinL, Echan(L),
* Zeta(L), Su)
Iy = 1
ELSE
diff --git a/sammy/src/xct/mxct26.f b/sammy/src/xct/mxct26.f
index 814a600e70ce5acb09b01a50dd98c5712e1c3a39..86e9baae8410735ec85fe64ad9215395bb7f7b76 100644
--- a/sammy/src/xct/mxct26.f
+++ b/sammy/src/xct/mxct26.f
@@ -2,15 +2,20 @@ C
C
C --------------------------------------------------------------
C
- Subroutine Find_If_Coulomb (Nent, Zeta, IfCoul, Ngroup, Ifdif)
+ Subroutine Find_If_Coulomb (Zeta, IfCoul, Ifdif)
+ use EndfData_common_m
+ use SammySpinGroupInfo_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
- DIMENSION Nent(*), Zeta(*)
+ type(SammySpinGroupInfo)::spinInfo
+ DIMENSION Zeta(*)
C *** On output, IfCoul = Maximum number of entrance channels which
C *** require Coulomb
IF (Ifdif.EQ.1) THEN
Nn = 0
- DO I=1,Ngroup
- IF (Nent(I).GT.Nn) Nn = Nent(I)
+ DO I=1,resParData%getNumSpinGroups()
+ call resParData%getSpinGroupInfo(spinInfo, I)
+ nent = spinInfo%getNumEntryChannels()
+ IF (Nent.GT.Nn) Nn = Nent
END DO
IF (Zeta(1).NE.0.0d0) THEN
IfCoul = Nn
@@ -26,22 +31,23 @@ C
C
C ______________________________________________________________________
C
- SUBROUTINE Start_Coul (Nent, Ntot, Dgoj, Zke, Ccoulx)
+ SUBROUTINE Start_Coul (Zke, Ccoulx)
use fixedi_m
use fixedr_m
use EndfData_common_m
use SammySpinGroupInfo_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
- DIMENSION Nent(*), Ntot(*), Dgoj(*), Zke(Ntotc,*),
+ DIMENSION Zke(Ntotc,*),
* Ccoulx(Ntotc,*)
type(SammySpinGroupInfo)::spinInfo
DATA Hth/0.01d0/
DO Igroup=1,resParData%getNumSpinGroups()
call resParData%getSpinGroupInfo(spinInfo, Igroup)
A = Hth*
- * spinInfo%getAbundance()*Dgoj(Igroup)
- Nenti = Nent(Igroup)
- Ntoti = Ntot(Igroup)
+ * spinInfo%getAbundance()*
+ * spinInfo%getGFactor()
+ Nenti = spinInfo%getNumEntryChannels()
+ Ntoti = spinInfo%getNumChannels()
DO Ich=1,Nenti
Ccoulx(Ich,Igroup) = A/Zke(Ich,Igroup)**2
END DO
diff --git a/sammy/src/xct/mxct28.f b/sammy/src/xct/mxct28.f
index fa91bdc94f339e0e1fdb58242f4272b59e768cf2..5bb7b5366578512d919bd1b44423f27c1b5d9b2b 100755
--- a/sammy/src/xct/mxct28.f
+++ b/sammy/src/xct/mxct28.f
@@ -38,9 +38,9 @@ C
call resParData%getResonanceInfo(resInfo, I)
call resParData%getResonance(resonance, resInfo)
IF (resonance%getEres().EQ.One) THEN
- Gamtot = resonance%getWidth(1)
- DO N=1,Ntotc
- Gamtot = Gamtot + resonance%getWidth(N+1)
+ Gamtot = 0.0d0
+ DO N=1,resonance%getNumChan()
+ Gamtot = Gamtot + resonance%getWidth(N)
END DO
Eee = 1000.0d0*(Eb-resonance%getEres())/Gamtot
Gb(1) = Gb(1) + dEXP(-Eee**2)
diff --git a/sammy/src/xxx/mxxx4.f b/sammy/src/xxx/mxxx4.f
index 86b950ecd014705a46bbe6ad3b5033b07a02d516..6207a1e89dacfcb4861c86aad5acef13bac03954 100644
--- a/sammy/src/xxx/mxxx4.f
+++ b/sammy/src/xxx/mxxx4.f
@@ -2,7 +2,7 @@ C
C
C ___________________________________________________________________
C
- SUBROUTINE Phase (Energy, Lspin, Chspin, Nent, Ishift,
+ SUBROUTINE Phase (Energy,
* Bound, Pm, Px, Sm, Sx, Hsm, Hsx,
* R0m, R0x)
C
@@ -26,20 +26,22 @@ C
EXTERNAL Sf, Pf, Phif
C
C DIMENSION Energy(Ndat),
-C * Lspin(Ntotc,Ngroup), Chspin(Ntotc,Ngroup),
-C * Nent(Ngroup), Ishift(Ntotc),
C * Bound(Ntotc,Ngroup),
C * Pm(Ntotc),
C * Px(Ntotc), Sm(Ntotc), Sx(Ntotc), Hsm(Ntotc),
C * Hsx(Ntotc), R0m(Ntotc), R0x(Ntotc)
C
- DIMENSION Energy(*), Lspin(Ntotc,*),
- * Chspin(Ntotc,*), Nent(*), Ishift(*),
- * Bound(Ntotc,*),
+ DIMENSION Energy(*), Bound(Ntotc,*),
* Pm(*), Px(*), Sm(*), Sx(*), Hsm(*), Hsx(*), R0m(*), R0x(*)
type(SammySpinGroupInfo)::spinInfo
type(RMatSpinGroup)::spinGroup
type(SammyResonanceInfo)::resInfo
+ type(SammyParticlePairInfo)::pairInfo
+ type(RMatParticlePair)::pair
+ type(RMatChannelParams)::channel
+ type(SammyChannelInfo)::channelInfo
+ integer,allocatable,dimension(:)::lspin
+ real(kind=8),allocatable,dimension(:)::chspin
type(RMatResonance)::resonance
DATA Zero /0.0d0/, One /1.0d0/
C
@@ -52,9 +54,10 @@ C
WRITE (21,99999)
WRITE (70,99999)
maxr = 0
- DO N=1,Ngroup
+ DO N=1,resParData%getNumSpinGroups()
minr = maxr + 1
haveRes = .false.
+ call resParData%getSpinGroupInfo(spinInfo, N)
do i = minr, resParData%getNumResonances()
call resParData%getResonanceInfo(resInfo, i)
if( resInfo%getSpinGroupIndex().ne.n) exit
@@ -62,14 +65,22 @@ C
haveRes = .true.
end do
IF (haveRes) THEN
- Nentn = Nent(N)
+ Nentn = spinInfo%getNumEntryChannels()
call resParData%getSpinGroupInfo(spinInfo, N)
call resParData%getSpinGroup(spinGroup, spinInfo)
spinjVal = spinGroup%getJ()
- WRITE (21,99998) SpinjVal, (EL,Lspin(J,N),ES,
- * Chspin(J,N),J=1,Nentn)
- WRITE (70,99998) SpinjVal, (EL,Lspin(J,N),ES,
- * Chspin(J,N),J=1,Nentn)
+ allocate(lspin(Nentn))
+ allocate(chspin(Nentn))
+ do J=1,Nentn
+ call spinInfo%getChannelInfo(channelInfo, j)
+ call resParData%getChannel(channel, channelInfo)
+ lspin(j) = channel%getL()
+ chspin(j) = channel%getSch()
+ end do
+ WRITE (21,99998) SpinjVal, (EL,Lspin(J),ES,
+ * Chspin(J),J=1,Nentn)
+ WRITE (70,99998) SpinjVal, (EL,Lspin(J),ES,
+ * Chspin(J),J=1,Nentn)
WRITE (21,99997) (Epev,J=1,Nentn)
WRITE (70,99997) (Epev,J=1,Nentn)
WRITE (21,99996) (Energy(1),Energy(Ndat),J=1,Nentn)
@@ -77,17 +88,25 @@ C
Nentn2 = Nentn + Nentn
WRITE (21,99995) (HS,R0,J=1,Nentn2)
WRITE (70,99995) (HS,R0,J=1,Nentn2)
+ deallocate(lspin)
+ deallocate(chspin)
DO J=1,Nentn
- Pm(J) = Pf (Rhom,Lspin(J,N))
- Px(J) = Pf (Rhox,Lspin(J,N))
+ call spinInfo%getChannelInfo(channelInfo, j)
+ call resParData%getChannel(channel, channelInfo)
+ call resParData%getParticlePairInfo(
+ * pairInfo,
+ * channelInfo%getParticlePairIndex())
+ call resParData%getParticlePair(pair, pairInfo)
+ Pm(J) = Pf (Rhom,channel%getL())
+ Px(J) = Pf (Rhox,channel%getL())
Sm(J) = Zero
- Sx(J) = Zero
- IF (Ishift(J).NE.0) THEN
- Sm(J) = Sf (Rhom, Lspin(J,N), Bound(J,N))
- Sx(J) = Sf (Rhox, Lspin(J,N), Bound(J,N))
+ Sx(J) = Zero
+ IF (pair%getCalcShift()) THEN
+ Sm(J) = Sf (Rhom, channel%getL(), Bound(J,N))
+ Sx(J) = Sf (Rhox, channel%getL(), Bound(J,N))
END IF
- Hsm(J) = Phif (Rhom, Lspin(J,N)) *Pi90
- Hsx(J) = Phif (Rhox, Lspin(J,N)) *Pi90
+ Hsm(J) = Phif (Rhom, channel%getL()) *Pi90
+ Hsx(J) = Phif (Rhox, channel%getL()) *Pi90
END DO
DO I=Minr,Maxr
call resParData%getResonanceInfo(resInfo, i)
diff --git a/sammy/src/xxx/mxxx6.f b/sammy/src/xxx/mxxx6.f
index f38fbbcadac52e80676fd8b4fe3b7fb14a9d8f33..6e1262dda08b5f12165ee78ea345a433f4bb898b 100644
--- a/sammy/src/xxx/mxxx6.f
+++ b/sammy/src/xxx/mxxx6.f
@@ -2,8 +2,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Cossin (Nent, Lspin, Zke, Zkfe, Cs, Si, Dphi, N,
- * Ipoten)
+ SUBROUTINE Cossin (Zke, Zkfe, Cs, Si, Dphi, N, Ipoten)
C
C *** PURPOSE -- GENERATE COS AND SIN OF ( 2.* Phi(HARD SHELL) )
C
@@ -11,18 +10,26 @@ C
use fixedi_m
use ifwrit_m
use varyr_common_m
+ use SammyResonanceInfo_M
+ use EndfData_common_m
+ use RMatResonanceParam_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
+ type(SammySpinGroupInfo)::spinInfo
+ type(RMatChannelParams)::channel
+ type(SammyChannelInfo)::channelInfo
C
C
DIMENSION Zke(*), Zkfe(*)
- DIMENSION Cs(*), Si(*), Lspin(Ntotc,*), Dphi(*)
-C DIMENSION Cs(Ntotc), Si(Ntotc), Lspin(Ntotc,Ngroup),
-C * Dphi(Ntotc)
+ DIMENSION Cs(*), Si(*), Dphi(*)
+C DIMENSION Cs(Ntotc), Si(Ntotc), Dphi(Ntotc)
DATA Fourpi /0.1256637061435917290808D0/
C
- DO 70 K=1,Nent
+ call resParData%getSpinGroupInfo(spinInfo, N)
+ DO 70 K=1,spinInfo%getNumEntryChannels()
+ call spinInfo%getChannelInfo(channelInfo, K)
+ call resParData%getChannel(channel, channelInfo)
A = Zkfe(K)*Squ
- L = Lspin(K,N)
+ L = channel%getL()
C
IF (L.EQ.0) THEN
C *** Phi0 ***
@@ -85,7 +92,10 @@ C
C = C * 2.0 * Fourpi /Su
C *** Is the above formula right ???? factor of two ???
C *** Hard-sphere potential scattering due to this spin group
- L = Lspin(1,N)
+ iela = spinInfo%getElasticChannel()
+ call spinInfo%getChannelInfo(channelInfo, iela)
+ call resParData%getChannel(channel, channelInfo)
+ L = channel%getL()
A = 2.0D0*(dFLOAT(L)) + 1.0D0
A = A*C
C *** Total hard-sphere potential scattering for this l-value