diff --git a/sammy/src/amr/mamr.f90 b/sammy/src/amr/mamr.f90
index 4e1fd8be1d576852243f4a48a18f3b1eac51a10c..d4d594fb7e6ab254fd1e81c1c097a2321fefb5b6 100644
--- a/sammy/src/amr/mamr.f90
+++ b/sammy/src/amr/mamr.f90
@@ -111,7 +111,7 @@
! *** PREVIOUS RUN, INCLUDING COVARIANCE MATRICES, PARAMETER
! *** VALUES, ETC.
CALL Rdcov ( A_Iprbrd , I_Iflbrd , &
- A_Iprdet , I_Ifldet , I_Iigrde , A_Iprext , I_Iflext , &
+ A_Iprdet , I_Ifldet , I_Iigrde , &
A_Ipolar , I_Iflpol , &
A_Iprmsc , I_Iflmsc , I_Irdmsc , I_Ijkmsc , A_Ietaee , &
A_Iprpmc , I_Iflpmc , I_Isopmc , &
@@ -128,7 +128,6 @@
Isingl = Idimen (Nsingl, 1, 'Nsingl, 1')
Nsingl = Nsingl*2
CALL Rdcovx ( A_Iprbrd , I_Iflbrd , &
- A_Iprext , I_Iflext , &
A_Ipolar , I_Iflpol , A_Iprmsc , I_Iflmsc , I_Irdmsc , &
A_Iprpmc , I_Iflpmc , I_Isopmc , &
A_Iprorr , I_Iflorr , A_Icrnch , A_Iedets , &
@@ -170,7 +169,7 @@
!
! *** Write THE "COVARIANCE" FILE
CALL Wrcov ( A_Iprbrd , I_Iflbrd , &
- A_Iprdet , I_Ifldet , I_Iigrde , A_Iprext , I_Iflext , &
+ A_Iprdet , I_Ifldet , I_Iigrde , &
A_Ipolar , I_Iflpol , &
A_Iprmsc , I_Iflmsc , I_Irdmsc , I_Ijkmsc , A_Ietaee , &
A_Iprpmc , I_Iflpmc , I_Isopmc , &
diff --git a/sammy/src/amr/mamr2.f90 b/sammy/src/amr/mamr2.f90
index 97b8a70d7900942e748ff253a63c464c38fd5dff..b79b570ab7d867a262f4f5e95dc22465c38abe9f 100644
--- a/sammy/src/amr/mamr2.f90
+++ b/sammy/src/amr/mamr2.f90
@@ -34,12 +34,6 @@ module amr2
call make_I_Ifldet(Numdet)
call make_I_Iigrde(Ngroup)
END IF
-!
- N = Nrext*Ntotc*Ngroup
- IF (Numext.NE.0) THEN
- call make_A_Iprext(N)
- call make_I_Iflext(N)
- END IF
!
IF (Nres.GT.0) THEN
!
diff --git a/sammy/src/amx/mamx.f90 b/sammy/src/amx/mamx.f90
index 5accb8d377751b44c0ea86e6fd98cdbc6a2bbaff..410c1f4fb9255c781dd8eb1e7304d723c80a73a8 100644
--- a/sammy/src/amx/mamx.f90
+++ b/sammy/src/amx/mamx.f90
@@ -113,7 +113,7 @@
! *** VALUES, ETC.
! &&& from old/mold2.f
CALL Rdcov ( A_Iprbrd , I_Iflbrd , &
- A_Iprdet , I_Ifldet , I_Iigrde , A_Iprext , I_Iflext , &
+ A_Iprdet , I_Ifldet , I_Iigrde , &
A_Ipolar , I_Iflpol , &
A_Iprmsc , I_Iflmsc , I_Irdmsc , I_Ijkmsc , A_Ietaee , &
A_Iprpmc , I_Iflpmc , I_Isopmc , &
@@ -132,7 +132,6 @@
Nsingl = Nsingl*2
! &&& from old/mold5.f
CALL Rdcovx ( A_Iprbrd , I_Iflbrd , &
- A_Iprext , I_Iflext , &
A_Ipolar , I_Iflpol , A_Iprmsc , I_Iflmsc , I_Irdmsc , &
A_Iprpmc , I_Iflpmc , I_Isopmc , &
A_Iprorr , I_Iflorr , A_Icrnch , A_Iedets , &
@@ -176,7 +175,7 @@
!
! *** Write THE "COVARIANCE" FILE
CALL Wrcov ( A_Iprbrd , I_Iflbrd , &
- A_Iprdet , I_Ifldet , I_Iigrde , A_Iprext , I_Iflext , &
+ A_Iprdet , I_Ifldet , I_Iigrde , &
A_Ipolar , I_Iflpol , &
A_Iprmsc , I_Iflmsc , I_Irdmsc , I_Ijkmsc , A_Ietaee , &
A_Iprpmc , I_Iflpmc , I_Isopmc , &
diff --git a/sammy/src/avg/mavg0.f b/sammy/src/avg/mavg0.f
index 69a346acc3fbf273d52ef86812e710b32501b503..e5ee6449e5a85e7b5eb079dc7a9e6ec43e94dfa4 100755
--- a/sammy/src/avg/mavg0.f
+++ b/sammy/src/avg/mavg0.f
@@ -14,7 +14,7 @@ C
use oopsch_common_m, only : Nowwww, Segmen
use AllocateFunctions_m, only : allocate_real_data,
* allocate_integer_data
- use EndfData_common_m, only : expData, resParData
+ use EndfData_common_m, only : expData, resParData, radFitFlags
use DerivativeHandler_M
use GridData_M
use sammy_ipq_common_m, only : resultData, derivStart, nimplict
@@ -96,7 +96,7 @@ C
oldCalc%instance_ptr = calcData%instance_ptr
call ourCalc%initialize()
- call ourCalc%setUpList(resParData, 1)
+ call ourCalc%setUpList(resParData, radFitFlags, 1)
call ourCalc%setNnsig(1)
calcData%instance_ptr = ourCalc%instance_ptr
C
@@ -222,6 +222,7 @@ C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -<
C
C Copy theoretical data to auxillary grid
C
+ call grid%reserve(resultData%getLength(), ipos)
do i = 1, resultData%getLength()
dd = resultData%getData(i, derivStart)
call grid%addData(i, ipos, dd)
diff --git a/sammy/src/blk/Exploc_common.f90 b/sammy/src/blk/Exploc_common.f90
index 49ecf955a2152692a69ee60e67a8764a84dfc5e9..751db21d47a80e0614ec7003ef2cf37e75b92f68 100644
--- a/sammy/src/blk/Exploc_common.f90
+++ b/sammy/src/blk/Exploc_common.f90
@@ -36,8 +36,6 @@ module exploc_common_m
! old group 8
real(kind=8),allocatable,dimension(:)::A_Idedet
integer,allocatable,dimension(:)::I_Iigrde
- real(kind=8),allocatable,dimension(:)::A_Iprext
- integer,allocatable,dimension(:)::I_Iflext
! old group 9
real(kind=8),allocatable,dimension(:)::A_Ipolar
@@ -256,24 +254,12 @@ module exploc_common_m
integer::want
call allocate_integer_data(I_Iigrde,want)
end subroutine make_I_Iigrde
-
- subroutine make_A_Iprext(want)
- integer::want
- call allocate_real_data(A_Iprext,want)
- end subroutine make_A_Iprext
-
- subroutine make_I_Iflext(want)
- integer::want
- call allocate_integer_data(I_Iflext,want)
- end subroutine make_I_Iflext
-
subroutine make_A_Ipolar(want)
integer::want
call allocate_real_data(A_Ipolar,want)
end subroutine make_A_Ipolar
-
subroutine make_I_Iflpol(want)
integer::want
call allocate_integer_data(I_Iflpol,want)
diff --git a/sammy/src/blk/Templc_common.f90 b/sammy/src/blk/Templc_common.f90
index 915f01db19993af1c118cee9083c5215e817ca9d..e1c7fa5225bdce414085a091ca416a45e61fed70 100644
--- a/sammy/src/blk/Templc_common.f90
+++ b/sammy/src/blk/Templc_common.f90
@@ -7,7 +7,6 @@ module templc_common_m
!
IMPLICIT NONE
- integer,allocatable,dimension(:)::I_Inpxdr
real(kind=8),allocatable,dimension(:,:)::A_Ibr
real(kind=8),allocatable,dimension(:,:)::A_Ibi
real(kind=8),allocatable,dimension(:,:)::A_Ipr
diff --git a/sammy/src/clq/mclq0.f b/sammy/src/clq/mclq0.f
index f09d19b81d3da87d049bba28f67a24e844a9e9f7..2bc390003b4147bbae09b2218f34ad8e91a0689c 100644
--- a/sammy/src/clq/mclq0.f
+++ b/sammy/src/clq/mclq0.f
@@ -17,7 +17,7 @@ C
use templc_common_m
use cbro_common_m
use lbro_common_m
- use EndfData_common_m, only : resParData
+ use EndfData_common_m, only : resParData,radFitFlags
use rsl7_m
use AuxGridHelper_M, only : setAuxGridOffset, setAuxGridRowMax
IMPLICIT DOUBLE PRECISION (a-h,o-z)
@@ -46,7 +46,7 @@ C *** GUESSTIMATE SIZE OF ARRAY NEEDED FOR SAMMY-CLQ
C
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - <
CALL Set_Kws_Xct
- call calcData%setUpList(resParData, Iq_Iso)
+ call calcData%setUpList(resParData, radFitFlags, Iq_Iso)
CALL Work_Clq (A_Isigxx )
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - >
C
diff --git a/sammy/src/cro/mcro0.f b/sammy/src/cro/mcro0.f
index 1c07dabd6f01300096c3b271cf545147acb6794e..c3430c57d3b9d622cc93f6e55443c7b581c35453 100644
--- a/sammy/src/cro/mcro0.f
+++ b/sammy/src/cro/mcro0.f
@@ -72,14 +72,11 @@ C *** GUESSTIMATE SIZE OF ARRAY NEEDED FOR SAMMY-Cross section
C
C *** one ***
CALL Set_Kws_Xct
- call calcData%setUpList(resParData, Iq_Iso)
+ call calcData%setUpList(resParData, radFitFlags, Iq_Iso)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - <
- call allocate_integer_data(I_Inpxdr, Ngroup)
Krext = Nrext
IF (Nrext.EQ.0) Krext = 1
- IF (Ksolve.NE.2) CALL Ppar(I_Iflext, I_Inpxdr, Krext)
-C *** Sbroutine Ppar Sets Npxdr
C
C *** two ***
N = N2
diff --git a/sammy/src/cro/mcro2.f b/sammy/src/cro/mcro2.f
index 41c9d5b6b958f2ddfca96bf8b3e3b1044511d790..60957f758502659bb6c695909186aff6f2165bf5 100644
--- a/sammy/src/cro/mcro2.f
+++ b/sammy/src/cro/mcro2.f
@@ -25,7 +25,7 @@ C
* A_Idifma , I_Inot , I_Inotu , A_Ixx )
C
CALL Parsh (
- * I_Inpxdr , A_Izke ,
+ * A_Izke ,
* Ipoten, Pieces,
* A_Isigxx , A_Idasig , A_Idbsig )
C
@@ -141,7 +141,7 @@ C
C --------------------------------------------------------------
C
SUBROUTINE Setr_Cro (Ntot, Bound, Echan,
- * Parext, Iflext, Min, igr, Alphar, Alphai, Not,
+ * Min, igr, Alphar, Alphai, Not,
* Z, Rmat, Sphr, Sphi, Phr, Phi, Zke, Krext, Lrmat)
C
C *** PURPOSE -- GENERATE Rmat = 1/(S-B+IP)
@@ -167,16 +167,19 @@ C
type(RMatChannelParams)::channel
type(SammyParticlePairInfo)::pairInfo
type(RMatParticlePair)::pair
+ logical::hasRext
+ type(SammyRExternalInfo)::rextInfo
+ type(RExternalFunction)::rext
+ real(kind=8)::Parext(7)
DIMENSION
- * Bound(Ntotc,*), Echan(Ntotc,*), Parext(Krext,Ntotc,*),
- * Iflext(Krext,Ntotc,*), Alphar(*), Alphai(*),
+ * Bound(Ntotc,*), Echan(Ntotc,*),
+ * Alphar(*), Alphai(*),
* Rmat(2,*), Sphr(*), Sphi(*), Phr(*), Phi(*), Not(*), Z(*),
* Zke(*)
C
C DIMENSION Ishift(Ntotc,Ngroup), Lpent(Ntotc,Ngroup),
C * Lspin(Ntotc,Ngroup), Bound(Ntotc,Ngroup),
-C * Echan(Ntotc,Ngroup), Parext(Nrext,Ntotc,Ngroup),
-C * Iflext(Nrext,Ntotc,Ngroup),
+C * Echan(Ntotc,Ngroup),
C * Alphar(Nres), Alphai(Nres), Rmat(2,NTriag),
C * Sphr(Ntotc), Sphi(Ntotc), Phr(Ntotc), Phi(Ntotc),
C * Not(Nres), Z(Ntotc)
@@ -192,20 +195,28 @@ C
Aloge = Zero
KL = 0
DO K=1,Ntot
- IF (Numext.NE.0 .AND. Iflext(1,K,igr).NE.-1) Aloge
- * = dLOG((Parext(2,K,igr)-Su)/ (Su-Parext(1,K,igr)))
+ hasRext = resParData%hasRexInfo(igr, K)
+ Parext = 0.0d0
+ IF (hasRext) then
+ call resparData%getRextInfoByGroup(rextInfo, igr, K)
+ call resparData%getRext(rext, rextInfo)
+ DO J = 1, rextInfo%getNrext()
+ Parext(J) = rext%getSammyValue(J)
+ end do
+ Aloge
+ * = dLOG((Parext(2)-Su)/ (Su-Parext(1)))
+ end if
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,igr).NE.-1) THEN
- Rmat(1,KL) = -(Parext(3,K,igr)+Parext(4,K,igr)*Su) +
- * Parext(5,K,igr)*Aloge
+ IF (L.EQ.K .AND. hasRext) THEN
+ Rmat(1,KL) = -(Parext(3)+Parext(4)*Su) +
+ * Parext(5)*Aloge
IF (Nrext.EQ.7) Rmat(1,KL) = Rmat(1,KL) -
- * Parext(7,K,igr)*Su**2 + Parext(6,K,igr)*
- * (Parext(2,K,igr)-Parext(1,K,igr)) +
- * Parext(6,K,igr)*Aloge*(Su)
+ * Parext(7)*Su**2 + Parext(6)*
+ * (Parext(2)-Parext(1)) +
+ * Parext(6)*Aloge*(Su)
END IF
END DO
END DO
diff --git a/sammy/src/cro/mcro2a.f b/sammy/src/cro/mcro2a.f
index 7b3095bfd3e3bf5055ba17d7363e5ad2d24da00f..2ce2c5da93a582f39e9a35f93b9dd753e5e9258f 100644
--- a/sammy/src/cro/mcro2a.f
+++ b/sammy/src/cro/mcro2a.f
@@ -156,7 +156,7 @@ C
C --------------------------------------------------------------
C
SUBROUTINE Parsh (
- * Npxdr, Zke,
+ * Zke,
* Ipoten, Pieces, Sigxxx, Dasigx, Dbsigx)
C
C
@@ -176,13 +176,13 @@ C
use SammySpinGroupInfo_M
use SammyRMatrixParameters_M
use SammyResonanceInfo_M
+ use SammyRExternalInfo_M
use templc_common_m
use xxx6
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
C
DIMENSION
- * Npxdr(*),
* Zke(Ntotc,*),
* Pieces(Ngroup),
* Sigxxx(*), Dasigx(*), Dbsigx(*)
@@ -190,10 +190,10 @@ C
type(SammyResonanceInfo)::resInfo
type(SammySpinGroupInfo)::spinInfo
type(RMatResonance)::resonance
+ type(SammyRExternalInfo)::rextInfo
logical::ifcap
C
C DIMENSION
-C * npxdr(Ngroup),
C * Zke(Ntotc,Ngroup),
C * Pieces(Ngroup)
C
@@ -228,7 +228,21 @@ C
END IF
C
Nnnn = N
- IF (Ksolve.NE.2) Npx = Npxdr(N)
+ Npx = 0
+ IF (Ksolve.NE.2) then
+ do I = 1, spinInfo%getNumChannels()
+ if (resParData%hasRexInfo(N, I)) then
+ call resparData%getRextInfoByGroup(rextInfo, N, I)
+ do j = 1, rextInfo%getNrext()
+ if(rextInfo%getIflSammyIndex(j).gt.0) then
+ Npx = 1
+ exit
+ end if
+ end do
+ end if
+ if (Npx.gt.0) exit
+ end do
+ end if
Nnf1 = Nnf1 + Nn2
ntot = spinInfo%getNumChannels()
Nn2 = Ntot*(Ntot+1)
@@ -249,7 +263,7 @@ C
Ntotnn = spinInfo%getNumChannels()
Lrmat = 0
CALL Setr_Cro (Ntotnn,
- * A_Ibound , A_Iechan , A_Iprext , I_Iflext , Min, n,
+ * A_Ibound , A_Iechan , Min, n,
* A_Ialphr , A_Ialphi , I_Inot ,
* A_Iz , A_Irmat , A_Isphr , A_Isphi , A_Iphr , A_Iphi ,
* Zke(1,N), Krext, Lrmat)
@@ -277,7 +291,7 @@ C *** TOTAL CROSS SECTIONS
nent = spinInfo%getNumEntryChannels()
next = spinInfo%getNumExitChannels()
IF (Kcros.EQ.1) CALL Total (Agoj, nent, Ntotnn,
- * A_Iprext , I_Iflext , A_Ics, A_Isi,
+ * A_Ics, A_Isi,
* A_Idphi , A_Iwr , A_Iwi , A_Ipwrr , A_Ipwri , A_Itr ,
* A_Iti , A_Iqr , A_Iqi , I_Inotu , Krext, Lrmat,
* min , N, Zke(1,N),
@@ -286,7 +300,7 @@ C *** TOTAL CROSS SECTIONS
C
C *** SCATTERING (ELASTIC) CROSS SECTION
IF (Kcros.EQ.2) CALL Elastc (Agoj, Nent, Ntotnn,
- * A_Iprext , I_Iflext , A_Ics,
+ * A_Ics,
* A_Isi, A_Idphi , A_Iwr , A_Iwi, A_Ipwrr , A_Ipwri ,
* A_Itr , A_Iti , A_Iqr , A_Iqi , I_Inotu, Krext, Lrmat,
* Min , N, Zke(1,N),
@@ -295,8 +309,8 @@ 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, Next, Ntotnn, A_Iprext ,
- * I_Iflext , A_Iwr, A_Iwi, A_Ipwrr ,
+ * ( Agoj, Nent, Next, Ntotnn,
+ * A_Iwr, A_Iwi, A_Ipwrr ,
* A_Ipwri , A_Itr , A_Iti , A_Iqr , A_Iqi , I_Inotu,
* Krext, Lrmat, Min , N,
* Zke(1,N), iflAbund, Sigxxx, Dasigx,
@@ -304,8 +318,8 @@ 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, Next, Ntotnn, A_Iprext ,
- * I_Iflext , A_Iwr, A_Iwi, A_Ipwrr ,
+ * ( Agoj, Nent, Next, Ntotnn,
+ * A_Iwr, A_Iwi, A_Ipwrr ,
* A_Ipwri , A_Itr , A_Iti , A_Iqr , A_Iqi, I_Inotu,
* Krext, Lrmat,Min, N,
* Zke(1,N), iflAbund, Sigxxx, Dasigx,
diff --git a/sammy/src/cro/mcro4.f b/sammy/src/cro/mcro4.f
index 63ab6cd44252356e1cb2c06d388aeaa62780c8f0..08a5e753735b48f1bd61263106fe63b6b5c1dcc5 100644
--- a/sammy/src/cro/mcro4.f
+++ b/sammy/src/cro/mcro4.f
@@ -201,7 +201,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Total (Agoj, Nent, Ntot, Parext, Iflext,
+ SUBROUTINE Total (Agoj, Nent, Ntot,
* Cs, Si, Dphi, Wr, Wi, Pwrhor, Pwrhoi, TR, TI, Qr, Qi,
* Notu, Krext, Lrmat, Minres, igr, Zke, If_Zke,
* Sigxxx, Dasigx, Dbsigx, iso)
@@ -221,18 +221,17 @@ C
integer :: nent, ntot, Krext, Lrmat, Minres, igr, If_Zke, iso
C
C
- real(kind=8) :: Parext(Krext,Ntotc,*),
+ real(kind=8) ::
* Cs(*), Si(*), Dphi(*),
* Wr(*), Wi(*), Pwrhor(*), Pwrhoi(*), Tr(*), Ti(*), Qr(NN,*),
* Qi(NN,*), Zke(*)
- integer :: Iflext(Krext,Ntotc,*),Notu(*)
+ integer :: Notu(*)
real(kind=8) :: Sigxxx(*), Dasigx(Nnnsig,*),
* Dbsigx(Nnnsig,Ndbsig,*)
C
-C DIMENSION Parext(Nrext,Ntotc,Ngroup),
-C * Iflext(Nrext,Ntotc,Ngroup),
+C DIMENSION
C * Cs(Ntotc), Si(Ntotc), Dphi(Ntotc), Wr(NN), Wi(NN),
C * Pwrhor(NN), Pwrhoi(NN), Tr(NN), Ti(NN), Qr(NN,NN),
C * Qi(NN,NN), Zke(Ntotc)
@@ -344,7 +343,7 @@ C
* Tr, Ti, Notu, Minres, igr, Zke, Dasigx, Dbsigx,
* Iso)
C
- IF (Npx.NE.0) CALL Derext_Cro (Agoj, Ntot, Parext, Iflext, TR,
+ IF (Npx.NE.0) CALL Derext_Cro (Agoj, Ntot, TR,
* Zke, Dasigx, Iso)
C
RETURN
@@ -353,7 +352,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Elastc (Agoj, Nent, Ntot, Parext, Iflext,
+ SUBROUTINE Elastc (Agoj, Nent, Ntot,
* Cs, Si, Dphi, Wr, Wi, Pwrhor, Pwrhoi, Tr, Ti, Qr, Qi, Notu,
* Krext, Lrmat, Minres, igr, Zke, If_Zke,
* Sigxxx, Dasigx, Dbsigx, Iso)
@@ -372,16 +371,15 @@ C
real(kind=8) :: agoj
integer :: Nent, Ntot, Krext, Lrmat, Minres, igr, If_Zke,Iso
- real(kind=8) :: Parext(Krext,Ntotc,*),
+ real(kind=8) ::
* Cs(*), Si(*), Dphi(*),
* Wr(*), Wi(*), Pwrhor(*), Pwrhoi(*), Tr(*), Ti(*), Qr(NN,*),
* Qi(NN,*), Zke(*)
- integer :: Iflext(Krext,Ntotc,*), Notu(*)
+ integer :: Notu(*)
real(kind=8) :: Sigxxx(*), Dasigx(Nnnsig,*),
* Dbsigx(Nnnsig,Ndbsig,*)
C
-C DIMENSION Parext(Nrext,Ntotc,Ngroup),
-C * Iflext(Nrext,Ntotc,Ngroup),
+C DIMENSION
C * Cs(Ntotc), Si(Ntotc), Dphi(Ntotc), Wr(NN), Wi(NN),
C * Pwrhor(NN), Pwrhoi(NN), Tr(NN), Ti(NN), Qr(NN,NN),
C * Qi(NN,NN), Zke(Ntotc)
@@ -520,7 +518,7 @@ C
* TR, TI, Notu, Minres, igr, Zke, Dasigx, Dbsigx,
* Iso)
C
- IF (Npx.NE.0) CALL Derext_Cro (Agoj, Ntot, Parext, Iflext, TR,
+ IF (Npx.NE.0) CALL Derext_Cro (Agoj, Ntot, TR,
* Zke, Dasigx, Iso)
C
RETURN
@@ -529,7 +527,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Reactn (Agoj, Nent, Next, Ntot, Parext, Iflext,
+ SUBROUTINE Reactn (Agoj, Nent, Next, Ntot,
* Wr, Wi, Pwrhor, Pwrhoi, Tr, Ti, Qr, Qi, Notu, Krext, Lrmat,
* Minres, igr, Zke, If_Zke, Sigxxx,
* Dasigx, Dbsigx, Iso)
@@ -550,15 +548,14 @@ C
integer :: Nent, Next, Ntot, Krext, Lrmat, Minres, igr
integer :: If_Zke, Iso
- real(kind=8) :: Parext(Krext,Ntotc,*),
+ real(kind=8) ::
* Wr(*), Wi(*), Pwrhor(*),
* Pwrhoi(*), Tr(*), Ti(*), Qr(NN,*), Qi(NN,*), Zke(*)
- integer :: Iflext(Krext,Ntotc,*), Notu(*)
+ integer :: Notu(*)
real(kind=8) :: Sigxxx(*), Dasigx(Nnnsig,*),
* Dbsigx(Nnnsig,Ndbsig,*)
C
-C DIMENSION Parext(Nrext,Ntotc,Ngroup),
-C * Iflext(Nrext,Ntotc,Ngroup),
+C DIMENSION
C * Wr(NN), Wi(NN),
C * Pwrhor(NN), Pwrhoi(NN), Tr(NN), Ti(NN), Qr(NN,NN), Qi(NN,NN)
C
@@ -692,7 +689,7 @@ C
* Tr, Ti, Notu, Minres, igr, Zke, Dasigx, Dbsigx,
* Iso)
C
- IF (Npx.NE.0) CALL Derext_Cro (Agoj, Ntot, Parext, Iflext, Tr,
+ IF (Npx.NE.0) CALL Derext_Cro (Agoj, Ntot, Tr,
* Zke, Dasigx, Iso)
C
RETURN
@@ -701,7 +698,7 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Captur (Agoj, Nent, Next, Ntot, Parext, Iflext,
+ SUBROUTINE Captur (Agoj, Nent, Next, Ntot,
* Wr, Wi, Pwrhor, Pwrhoi, Tr, Ti, Qr, Qi, Notu, Krext,
* Lrmat, Minres, igr, Zke, If_Zke, Sigxxx,
* Dasigx, Dbsigx, Iso)
@@ -723,16 +720,15 @@ C
integer :: Nent, Next, Ntot, Krext, Lrmat,
* igr, If_zke, iso, minres
- real(kind=8):: Parext(Krext,Ntotc,*),
+ real(kind=8)::
* Wr(*), Wi(*),
* Pwrhor(*), Pwrhoi(*), Tr(*), Ti(*), Qr(NN,*),
* Qi(NN,*), Zke(*)
- integer:: Iflext(Krext,Ntotc,*), Notu(*)
+ integer:: Notu(*)
real(kind=8):: Sigxxx(*), Dasigx(Nnnsig,*),
* Dbsigx(Nnnsig,Ndbsig,*)
C
-C DIMENSION Parext(Nrext,Ntotc,Ngroup),
-C * Iflext(Nrext,Ntotc,Ngroup),
+C DIMENSION
C * Cs(Ntotc), Si(Ntotc), Dphi(Ntotc), Wr(NN), Wi(NN),
C * Pwrhor(NN), Pwrhoi(NN), Tr(NN), Ti(NN), Qr(NN,NN), Qi(NN,NN)
C
@@ -867,7 +863,7 @@ C
* Tr, Ti, Notu, Minres, igr, Zke, Dasigx, Dbsigx,
* Iso)
C
- IF (Npx.NE.0) CALL Derext_Cro (Agoj, Ntot, Parext, Iflext, Tr,
+ IF (Npx.NE.0) CALL Derext_Cro (Agoj, Ntot, Tr,
* Zke, Dasigx, Iso)
RETURN
END
@@ -939,89 +935,98 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Derext_Cro (Agoj, Ntot, Parext, Iflext, Tr, Zke,
+ SUBROUTINE Derext_Cro (Agoj, Ntot, Tr, Zke,
* Dasigx, Iso)
C
use fixedi_m
use ifwrit_m
use varyr_common_m
use constn_common_m
+ use SammyRExternalInfo_M
+ use RMatResonanceParam_M
+ use EndfData_common_m, only : resParData
IMPLICIT none
C
real(kind=8) :: Agoj
integer :: Ntot, Iso
- real(kind=8) :: Parext(Nrext,Ntotc,*), Tr(*),Zke(*)
- integer :: Iflext(Nrext,Ntotc,*)
+ real(kind=8) :: Tr(*),Zke(*)
real(kind=8) :: Dasigx(Nnnsig,*)
-C DIMENSION Parext(Nrext,Ntotc,Ngroup),
-C * Iflext(Nrext,Ntotc,Ngroup), Dasigx(Ngbout), Tr(NN)
+ type(SammyRExternalInfo)::rextInfo
+ type(RExternalFunction)::rext
+ real(kind=8)::Parext(7)
+C DIMENSION Dasigx(Ngbout), Tr(NN)
C
real(kind=8) :: Two = 2.0d0
C
real(kind=8) :: B, C
- integer :: I, Ifl, Ij
+ integer :: I, Ifl, Ij, J
C = Fourpi*Agoj/Su
Ij = 0
DO I=1,Ntot
B = C/Zke(I)**2
Ij = Ij + I
- Ifl = Iflext(1,I,Nnnn)
- IF (Ifl.NE.-1) THEN
- Ifl = Ifl
+ IF (resparData%hasRexInfo(Nnnn, I)) THEN
+ call resparData%getRextInfoByGroup(rextInfo, Nnnn, I)
+ call resparData%getRext(rext, rextInfo)
+ Parext = 0.0d0
+ DO J = 1, rextInfo%getNrext()
+ Parext(J) = rext%getSammyValue(J)
+ end do
+ Ifl = rextInfo%getIflSammyIndex(1)
if( ifl.gt.ndasig) then
stop 'Out of range in Derext_Cro in mcro4 #1'
end if
IF (Ifl.GT.0) THEN
IF (Nrext.EQ.5) Dasigx(1,Ifl) = Dasigx(1,Ifl)
- * - Tr(Ij)*B*Parext(5,I,Nnnn)/
- * (Su-Parext(1,I,Nnnn))
+ * - Tr(Ij)*B*Parext(5)/
+ * (Su-Parext(1))
IF (Nrext.EQ.7) Dasigx(1,Ifl) = Dasigx(1,Ifl)
- * - Tr(Ij)*B* (Parext(5,I,Nnnn) +
- * Parext(6,I,Nnnn)*Parext(1,I,Nnnn))/
- * (Su-Parext(1,I,Nnnn))
+ * - Tr(Ij)*B* (Parext(5) +
+ * Parext(6)*Parext(1))/
+ * (Su-Parext(1))
END IF
- Ifl = Iflext(2,I,Nnnn)
+ Ifl = rextInfo%getIflSammyIndex(2)
if( ifl.gt.ndasig) then
stop 'Out of range in Derext_Cro in mcro4 #2'
end if
IF (Ifl.GT.0) THEN
IF (Nrext.EQ.5) Dasigx(1,Ifl) = Dasigx(1,Ifl)
- * - Tr(Ij)*B*Parext(5,I,Nnnn)/(Parext(2,I,Nnnn)-Su)
+ * - Tr(Ij)*B*Parext(5)/(Parext(2)-Su)
IF (Nrext.EQ.7) Dasigx(1,Ifl) = -Tr(Ij)*B*
- * (Parext(5,I,Nnnn)+Parext(6,I,Nnnn)*Parext(2,I,Nnnn))/
- * (Parext(2,I,Nnnn)-Su) + Dasigx(1,Ifl)
+ * (Parext(5)+Parext(6)*Parext(2))/
+ * (Parext(2)-Su) + Dasigx(1,Ifl)
END IF
- Ifl = Iflext(3,I,Nnnn)
+ Ifl = rextInfo%getIflSammyIndex(3)
if( ifl.gt.ndasig) then
stop 'Out of range in Derext_Cro in mcro4 #3'
end if
IF (Ifl.GT.0) THEN
Dasigx(1,Ifl) = Tr(Ij)*B + Dasigx(1,Ifl)
END IF
- Ifl = Iflext(4,I,Nnnn)
+ Ifl = rextInfo%getIflSammyIndex(4)
if( ifl.gt.ndasig) then
stop 'Out of range in Derext_Cro in mcro4 #4'
end if
IF (Ifl.GT.0) THEN
Dasigx(1,Ifl) = Tr(Ij)*B*Su + Dasigx(1,Ifl)
END IF
- Ifl = Iflext(5,I,Nnnn)
+ Ifl = rextInfo%getIflSammyIndex(5)
IF (Ifl.GT.0) THEN
- Dasigx(1,Ifl) = -Two*Tr(Ij)*B * dSQRT(Parext(5,I,Nnnn))*
- * dLOG( (Parext(2,I,Nnnn)-Su)/(Su-Parext(1,I,Nnnn)) ) +
+ Dasigx(1,Ifl) = -Two*Tr(Ij)*B * dSQRT(Parext(5))*
+ * dLOG( (Parext(2)-Su)/(Su-Parext(1)) ) +
* Dasigx(1,Ifl)
END IF
- IF (Nrext.GT.5) THEN
- Ifl = Iflext(6,I,Nnnn)
+ IF (rextInfo%getNrext().GT.5) THEN
+ Ifl = rextInfo%getIflSammyIndex(6)
IF (Ifl.GT.0) THEN
Dasigx(1,Ifl) = Dasigx(1,Ifl) - Tr(Ij)*B*
- * ( (Parext(2,I,Nnnn)-Parext(1,I,Nnnn))+
- * Su*dLOG((Parext(2,I,Nnnn)-Su)/
- * (Su-Parext(1,I,Nnnn))) )
+ * ( (Parext(2)-Parext(1))+
+ * Su*dLOG((Parext(2)-Su)/
+ * (Su-Parext(1))) )
END IF
- Ifl = Iflext(7,I,Nnnn)
+ Ifl = rextInfo%getIflSammyIndex(7)
IF (Ifl.GT.0) THEN
Dasigx(1,Ifl) = Tr(Ij)*B*Su**2 + Dasigx(1,Ifl)
END IF
diff --git a/sammy/src/dat/mdat0.f90 b/sammy/src/dat/mdat0.f90
index b5a8d714bcfdb9e8e6b861c63df33c88932f6e51..bc26a117c0b502061a5f8fde39c4adc1bd2ea7d4 100644
--- a/sammy/src/dat/mdat0.f90
+++ b/sammy/src/dat/mdat0.f90
@@ -47,6 +47,7 @@ module Samdat_0_M
type(EndfData)::reader
type(GridData)::grid, auxGrid
logical::hasAuxGrid
+ integer::maxRow, maxCol
!
Segmen(1) = 'D'
Segmen(2) = 'A'
@@ -92,11 +93,11 @@ module Samdat_0_M
IF (Nrext.EQ.0) Krext = 1
call reader%initialize()
CALL Read00 (A_Ibcf , A_Icf2 , A_Idpiso , &
- A_Iprext , I_Iflext , A_Iprorr , A_Icrnch , A_Iedets , &
+ 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 , &
A_J1 , A_J2, Krext, Iwhich, Mind, Mine, Maxe, &
- Maxd, Nmax, reader)
+ Maxd, Nmax, reader, I_Iflrpi)
deallocate(A_Iedrpi)
deallocate(A_Ixxrpi)
deallocate(A_J1)
@@ -141,6 +142,12 @@ module Samdat_0_M
if(Ktzero.NE.0) minDataIndex = minDataIndex + 1
if(Numcro.gt.1) minDataIndex = minDataIndex + 1
call grid%setDataIndex(minDataIndex)
+ maxRow = Ndat * Numcro
+ maxCol = 2
+ if (Numcro.gt.1) maxCol = 3
+ if (Ktzero.NE.0) maxCol = maxCol + 1
+ call grid%reserve(maxRow, maxCol)
+
do i = 1, Ndat
ee = A_Ienerg(i)
etzero = ee
@@ -333,6 +340,9 @@ module Samdat_0_M
CALL Artificial_Energy (A_Ienerg, Ndat, Keveng)
call expData%getGrid(grid, 1)
ii = 1
+ maxRow = Ndat * Numcro
+ maxCol = 1
+ call grid%reserve(maxRow, maxCol)
do i = 1, Ndat
do j = 1, Numcro
call grid%addData(ii, 1, A_Ienerg(i))
@@ -349,6 +359,9 @@ module Samdat_0_M
if (hasAuxGrid) then
call auxGrid%initialize()
+ maxRow = Ndatb * Numcro
+ maxCol = 1
+ call auxGrid%reserve(maxRow, maxCol)
ipos = 1
do i = 1, Ndatb
do ii = 1, numcro
diff --git a/sammy/src/dat/mdat1.f90 b/sammy/src/dat/mdat1.f90
index 5278fff49375ffc19f5273e14426752914edfb5d..7f628968e50a3eeba9b2aebc4a30e7a307f64157 100644
--- a/sammy/src/dat/mdat1.f90
+++ b/sammy/src/dat/mdat1.f90
@@ -4,9 +4,9 @@ contains
!
! --------------------------------------------------------------
!
- SUBROUTINE Limits (Bcf, Cf2, Dopwid, Parext, Iflext, Parorr, &
+ SUBROUTINE Limits (Bcf, Cf2, Dopwid, Parorr, &
Ecrnch, Endets, Sesese, Eseses, Parrpi, Edxrpi, Xxxrpi, Parudr, &
- Nud_E, Nud_T, UdE, UdR, UdT, UdR_E, UdT_E, Krext)
+ Nud_E, Nud_T, UdE, UdR, UdT, UdR_E, UdT_E, Krext, Iflrpi)
!
! *** Purpose -- Find energy limits for the various processes --
! *** Emin , Emax = limits for experimental data set
@@ -34,11 +34,12 @@ contains
IMPLICIT DOUBLE PRECISION (a-h,o-z)
!
DIMENSION Bcf(*), Cf2(*), Dopwid(*), &
- Parext(Krext,Ntotc,*), Iflext(Krext,Ntotc,*), Parorr(*), &
+ Parorr(*), &
Ecrnch(*), Endets(*), Sesese(*), Eseses(*), Parrpi(*), &
Edxrpi(Kxxrpi,*), Xxxrpi(Kmmrpi,*)
DIMENSION Nud_E(*), Nud_t(*), UdE(Nudeng,*), UdR(Nudtim,Nudeng,*), &
UdT(Nudtim,Nudeng,*), UdR_E(*), UdT_E(*), Parudr(*)
+ integer::iflrpi(*)
!
DATA Zero /0.0d0/, Two /2.0d0/
Brdlim = 5.0d0
@@ -127,9 +128,9 @@ contains
ELSE IF (Numrpi.GT.0) THEN
! *** Here for RPI version of resolution broadening
Yresol = .TRUE.
- CALL Gen_Rpi_E_Independent (Parrpi, Iflext, Edxrpi, Xxxrpi, &
+ CALL Gen_Rpi_E_Independent (Parrpi, Iflrpi, Edxrpi, Xxxrpi, &
Binpdx, 1)
-! *** Note that Iflext is "Dummy" here, never used
+! *** Note that Iflext is "Dummy" here, never use
Itime = 0
Mndets = 1
Min = Nnnrpi + 1
@@ -232,7 +233,7 @@ contains
!
END IF
!
- IF (Numext.GT.0) CALL Testxt (Parext, Iflext, Krext)
+ IF (Numext.GT.0) CALL Testxt
CALL Wwrite (Bcf, Cf2, Dopwid)
RETURN
!
@@ -380,7 +381,7 @@ contains
!
! --------------------------------------------------------------
!
- SUBROUTINE Testxt (Parext, Iflext, Krext)
+ SUBROUTINE Testxt
!
use fixedi_m
use fixedr_m
@@ -388,24 +389,32 @@ contains
use RMatResonanceParam_M
use EndfData_common_m
use AuxGridHelper_M
- IMPLICIT DOUBLE PRECISION (a-h,o-z)
+ IMPLICIT none
!
type(SammySpinGroupInfo)::spinInfo
- DIMENSION Parext(Krext,Ntotc,*), Iflext(Krext,Ntotc,*)
+ type(SammyRExternalInfo)::rextInfo
+ type(RExternalFunction)::rext
+ integer::Ii, N, Ntotn, M
+ real(kind=8)::Elow, Eup
+
Ii = 0
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
- WRITE ( 6,10000) N, M, Parext(1,M,N), Emind
- WRITE (21,10000) N, M, Parext(1,M,N), Emind
+ IF (resparData%hasRexInfo(N, M)) THEN
+ call resparData%getRextInfoByGroup(rextInfo, N, M)
+ call resparData%getRext(rext, rextInfo)
+ Elow = rext%getSingularityBelowErange()
+ EUp = rext%getSingularityAboveErange()
+ IF (Elow.GT.Emind) THEN
+ WRITE ( 6,10000) N, M, Elow, Emind
+ WRITE (21,10000) N, M, Elow, Emind
II = 1
END IF
- IF (Parext(2,M,N).LT.Emaxd) THEN
- WRITE ( 6,10100) N, M, Parext(2,M,N), Emaxd
- WRITE (21,10100) N, M, Parext(2,M,N), Emaxd
+ IF (EUp.LT.Emaxd) THEN
+ WRITE ( 6,10100) N, M, EUp, Emaxd
+ WRITE (21,10100) N, M, EUp, Emaxd
II = 1
END IF
END IF
diff --git a/sammy/src/dat/mdat2.f90 b/sammy/src/dat/mdat2.f90
index a5554dd55998d5995dd5b1df6120469631d92fcf..f3725f33bf29e1b979bea3935860795d8a02fcc0 100644
--- a/sammy/src/dat/mdat2.f90
+++ b/sammy/src/dat/mdat2.f90
@@ -7,10 +7,10 @@ module mdat2_m
!
! ______________________________________________________________
!
- SUBROUTINE Read00 (Bcf, Cf2, Dopwid, Parext, Jflext, &
+ SUBROUTINE Read00 (Bcf, Cf2, Dopwid, &
Parorr, Ecrnch, Endets, Sesese, Eseses, Parrpi, Edxrpi, Xxxrpi, &
Parudr, Nud_E, Nud_T, UdE, UdR, UdT, UdR_E, UdT_E, Krext, &
- Iwhich, Mind, Mine, Maxe, Maxd, Nmax, reader)
+ Iwhich, Mind, Mine, Maxe, Maxd, Nmax, reader, Iflrpi)
!
! *** Purpose -- Read data file through once to learn dimensions and
! *** positions of data in the file
@@ -28,12 +28,13 @@ module mdat2_m
use AllocateFunctions_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
type(EndfData)::reader
- DIMENSION Bcf(*), Cf2(*), Dopwid(*), &
- Parext(Krext,Ntotc,*), Jflext(Krext,Ntotc,*), Parorr(*), &
+ DIMENSION Bcf(*), Cf2(*), Dopwid(*), &
+ Parorr(*), &
Ecrnch(*), Endets(*), Sesese(*), Eseses(*), Parrpi(*), &
Edxrpi(*), Xxxrpi(*), Parudr(*)
DIMENSION Nud_E(*), Nud_t(*), UdE(Nudeng,*), UdR(Nudtim,Nudeng,*), &
UdT(Nudtim,Nudeng,*), UdR_E(*), UdT_E(*)
+ integer::Iflrpi(*)
DIMENSION Ehkeep(4)
real(kind=8),allocatable,dimension(:)::E
Data Nodpoc /3/, Zero /0.0d0/
@@ -57,9 +58,9 @@ module mdat2_m
IF (Kartgd.EQ.1) THEN
ELSE
! *** find energy limits for the various processes --
- CALL Limits (Bcf, Cf2, Dopwid, Parext, Jflext, Parorr, &
+ CALL Limits (Bcf, Cf2, Dopwid, Parorr, &
Ecrnch, Endets, Sesese, Eseses, Parrpi, Edxrpi, Xxxrpi, &
- Parudr, Nud_E, Nud_T, UdE, UdR, UdT, UdR_E, UdT_E, Krext)
+ Parudr, Nud_E, Nud_T, UdE, UdR, UdT, UdR_E, UdT_E, Krext, Iflrpi)
END IF
RETURN
END IF
@@ -243,9 +244,9 @@ module mdat2_m
END IF
!
! *** find Energy limits for the various processes --
- CALL Limits (Bcf, Cf2, Dopwid, Parext, Jflext,Parorr, &
+ CALL Limits (Bcf, Cf2, Dopwid, Parorr, &
Ecrnch, Endets, Sesese, Eseses, Parrpi, Edxrpi, Xxxrpi, Parudr, &
- Nud_E, Nud_T, UdE, UdR, UdT, UdR_E, UdT_E, Krext)
+ Nud_E, Nud_T, UdE, UdR, UdT, UdR_E, UdT_E, Krext, Iflrpi)
!
!
! *** check whether energies are redundant
diff --git a/sammy/src/dat/mdat3.f90 b/sammy/src/dat/mdat3.f90
index 08a4ddbf4f55c772e5046c506d83e8da17fb4620..cf8475618801f5774f7ca1e689de8969d7487bcd 100755
--- a/sammy/src/dat/mdat3.f90
+++ b/sammy/src/dat/mdat3.f90
@@ -323,6 +323,7 @@ module mdat3_M
end do
CALL Convert_To_Caps (keyword, 10, Kpound)
IF (keyword.EQ.'PARTIAL DE') THEN
+ call derivs%reserve(ener%getLength(), Numidc)
DO K=1,ener%getLength()
READ (30,10200) (X(1, I),I=1,Numidc)
Do I = 1, Numidc
diff --git a/sammy/src/dbd/mdbd3.f b/sammy/src/dbd/mdbd3.f
index ef7d74d5f6657b15d69f766ebecc778da5bc1a3c..4774baf9e111330775189445a967c6f9900d17ac 100644
--- a/sammy/src/dbd/mdbd3.f
+++ b/sammy/src/dbd/mdbd3.f
@@ -80,7 +80,7 @@ C
C *** purpose -- COPY DATA AND DERIVATIVES, CUZ THERE ARE TOO FEW
C *** POINTS TO BROADEN
C
- use fixedi_m, only : Nnnsig, Ndasig
+ use fixedi_m, only : Nnnsig, Ndasig, Ndbsig
use ifwrit_m, only : Kvtemp
IMPLICIT None
C
@@ -93,9 +93,11 @@ C
Now = Now + 1
IF (Kvtemp.GT.0) THEN
K = Kvtemp - Ndasig
- DO N=1,Nnnsig
- Dbsigx(N,K) = Zero
- END DO
+ if (k.gt.0.and.k.le.Ndbsig) then
+ DO N=1,Nnnsig
+ Dbsigx(N,K) = Zero
+ END DO
+ end if
END IF
RETURN
END
diff --git a/sammy/src/dop/mdop0.f90 b/sammy/src/dop/mdop0.f90
index 7fcf7f8d77176b010d017436ccc58e7cec7db45d..740c0a48721198f42e11b9777ad82e6545719767 100644
--- a/sammy/src/dop/mdop0.f90
+++ b/sammy/src/dop/mdop0.f90
@@ -58,7 +58,7 @@ module dop_m
Left = Msize - Icoef - 2*I2pls1
Ldatb = Ndatb
- ! ensure we have an auxillary energy grid
+ ! ensure we have an auxillary energy grid
if ( expData%getLength().lt.2) then
call expData%getGrid(grid, 1)
ipos = 1
@@ -70,6 +70,7 @@ module dop_m
end if
end if
call auxGrid%initialize()
+ call auxGrid%reserve(grid%getLength(),1)
do i = 1, grid%getLength()
call auxGrid%addData(i, 1, grid%getData(i, ipos))
end do
diff --git a/sammy/src/dop/mdop1.f90 b/sammy/src/dop/mdop1.f90
index c2b58cada0ba78c95a5e71ff2a06ac181053d560..411b65d7119f671ce6bcdd4bafa11c3fd7f53e4c 100644
--- a/sammy/src/dop/mdop1.f90
+++ b/sammy/src/dop/mdop1.f90
@@ -263,12 +263,14 @@ module dop1_m
!
iposJJ = (Jj - 1) * numcro + 1 ! all energies for each numcro are the same
ee = grid%getData(iposJJ, 1)
+ call grid%reserve(iposJJ + Numcro,1)
do Jjnum = iposJJ, iposJJ + Numcro -1
call grid%addData( Jjnum, 1, ee)
end do
J = J - 1
END DO
iposJJ = (Ngtvv - 1) * numcro + 1 ! all energies for each numcro are the same
+ call grid%reserve(iposJJ + Numcro,1)
do Jjnum = iposJJ, iposJJ + Numcro -1
call grid%addData( Jjnum, 1, 0.0d0)
end do
diff --git a/sammy/src/dop/mdop2.f90 b/sammy/src/dop/mdop2.f90
index 5e3b6bdfdaec1ac3564073b490f7a5c70e14ec78..290e00f2d4ef8807015e91bdc949ea2ebd32d718 100755
--- a/sammy/src/dop/mdop2.f90
+++ b/sammy/src/dop/mdop2.f90
@@ -26,6 +26,7 @@ module dop2_m
Mstopx = 0
Np1 = N + 1
Itimes = 0
+ call Coef%reserve(Np1, 1)
DO I=1,Np1
IF((I/1000)*1000.EQ.I) WRITE (6,66666) I, Coef%getData(I-1,1)
66666 FORMAT (' I, Coef(I-1)=', i10, 1PG20.10)
@@ -102,6 +103,7 @@ module dop2_m
! *** rearrange storage of Coef ... 1 to m+1 now goes to m+1 to 2m+1
C = Coef%getData(Np1, 1)
Ii = Np1
+ call Coef%reserve(Ii+Mmmmmm,1)
DO I=1,Mmmmmm
tmp = Coef%getData(I,1)
call Coef%addData(Ii,1,tmp)
@@ -111,6 +113,7 @@ module dop2_m
!
! *** now put M+2 to 2M+1 into [1 to M] in reverse order
Ii = M2pls1
+ call Coef%reserve(Ii+Mmmmmm,1)
DO I=1,Mmmmmm
tmp = Coef%getData(Ii,1)
call Coef%addData(I, 1, tmp)
diff --git a/sammy/src/end/mout.f b/sammy/src/end/mout.f
index 300fa10bd4037290c164b24ca3cd4632ca9424b4..45b7582be6ff1b3bfba273b7a5d4180206ba95fe 100644
--- a/sammy/src/end/mout.f
+++ b/sammy/src/end/mout.f
@@ -3,7 +3,7 @@ C
C --------------------------------------------------------------
C
SUBROUTINE Outpar (Iftit , Nunit , Parbrd, Iflbrd,
- * Pardet, Ifldet, Igrdet, Parext, Iflext,
+ * Pardet, Ifldet, Igrdet,
* Polar , Iflpol, Parmsc, Iflmsc, Iradms, Ijkmsc,
* Etaeee, Parpmc, Iflpmc, Isopmc,
* Parorr, Iflorr, Ecrnch, Endets, Sesese, Eseses, Sigdts,
@@ -39,7 +39,6 @@ C
type(ResonanceCovariance)::physCov
DIMENSION Parbrd(*), Iflbrd(*),
* 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(*),
@@ -55,7 +54,6 @@ C
C
C DIMENSION Parbrd(Numbrd), Iflbrd(Numbrd),
c * Pardet(Numdet), Ifldet(Numdet), Igrdet(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),
C * Etaeee(Mjetan),
@@ -399,10 +397,8 @@ C
C
140 CONTINUE
Iunit = Nunit
- IF (Numext.GT.0) THEN
- CALL Outext (Parext, Iflext, Dump, Iunit,
- * Ipar)
- END IF
+
+ CALL Outext (Dump, Iunit, Ipar)
C
CALL Outrad (Dump, Iunit, Ipar)
C
diff --git a/sammy/src/end/mout2.f b/sammy/src/end/mout2.f
index e67cb5298f48578f4cb3d14419e1b3257e7e54a0..06f69e47847c912bd9c0b758c97d00a2cb4b9e81 100644
--- a/sammy/src/end/mout2.f
+++ b/sammy/src/end/mout2.f
@@ -2,67 +2,99 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Outext (Parext, Iflext, Dump,
- * Iunit, Ipar)
+ SUBROUTINE Outext (Dump, Iunit, Ipar)
C
C *** PURPOSE -- OUTPUT R-EXTERNAL PARAMETERS
C
- use fixedi_m
- use ifwrit_m
- use fixedr_m
- use broad_common_m
- use Gachmi_common_m
- use titles_b32_common_m
- use EndfData_common_m
+ use Gachmi_common_m, only : Draw
+ use EndfData_common_m, only : resParData
use SammySpinGroupInfo_M
- use RMatResonanceParam_M
- IMPLICIT DOUBLE PRECISION (a-h,o-z)
+ use SammyRExternalInfo_M
+ use RMatResonanceParam_M
+ IMPLICIT None
C
- DIMENSION Parext(Nrext,Ntotc,*),
- * Iflext(Nrext,Ntotc,*), Dump(*)
-C DIMENSION Ntot(Ngroup), Parext(Nrext,Ntotc,Ngroup),
-C * Iflext(Nrext,Ntotc,Ngroup), Dump(Nvpall)
+ real(kind=8)::Dump(*)
+C DIMENSION Ntot(Ngroup), Dump(Nvpall)
C
type(SammySpinGroupInfo)::spinInfo
+ type(SammyRExternalInfo)::rextInfo
type(RMatSpinGroup)::spinGroup
+ type(RExternalFunction)::rext
+ integer::Iunit, Ipar
+ logical::hasRext
+ integer::Js(7)
+ real(kind=8)::Zero
+ integer::I, J, JJ, K, Mmax, NrextO
DATA Zero /0.0d0/
C
- WRITE (Iunit,99999)
- IF (Nrext.EQ.5) WRITE (Iunit,99990)
- IF (Nrext.EQ.7) WRITE (Iunit,99989)
+ if (resParData%getNumRext().eq.0) return ! no external R-matrix
+
+ ! assume all channels have the same number R-ext pars
+ call resParData%getRextInfo(rextInfo, 1)
+ NrextO = rextInfo%getNrext()
+
+ WRITE (Iunit,99999)
+ IF (NrextO.EQ.5) WRITE (Iunit,99990)
+ IF (NrextO.EQ.7) WRITE (Iunit,99989)
DO I=1,resParData%getNumSpinGroups()
call resParData%getSpinGroupInfo(spinInfo, I)
call resParData%getSpinGroup(spinGroup, spinInfo)
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)
- * I, spinGroup%getJ(),
- * (Parext(K,1,I),(Draw(J,K),J=1,5),K=1,Nrext)
- IF (Iflext(1,1,I).NE.-1 .AND. Nrext.EQ.7) WRITE (Iunit,99987)
- * I, spinGroup%getJ(),
- * (Parext(K,1,I),(Draw(J,K),J=1,5),K=1,Nrext)
- IF (Iflext(1,1,I).EQ.-1) THEN
- WRITE (Iunit,99986) I, spinGroup%getJ()
- END IF
- IF (Mmax.NE.1) THEN
- DO J=2,Mmax
- IF (Iflext(1,J,I).NE.-1) CALL Setflg(Iflext(1,J,I),
- * Nrext)
- IF (Iflext(1,J,I).NE.-1 .AND. Nrext.EQ.5) WRITE
- * (Iunit,99985) J, (Parext(K,J,I),(Draw(JJ,K),
- * JJ=1,5),K=1,Nrext)
- IF (Iflext(1,J,I).NE.-1 .AND. Nrext.EQ.7) WRITE
- * (Iunit,99984) J, (Parext(K,J,I),(Draw(JJ,K),
- * JJ=1,5),K=1,Nrext)
- END DO
+
+ hasRext = resParData%hasRexInfo(I, 1)
+ if (hasRext) then
+ call resParData%getRextInfoByGroup(rextInfo, I, 1)
+ Js = 0
+ DO K = 1, rextInfo%getNrext()
+ Js(K) = rextInfo%getIflSammyIndex(K)
+ end do
+ call Setflg(Js, 7)
+ ! currently in the input R-external can have 5 or seven parameters
+ ! The output should reflect the user input
+ call resParData%getRext(rext, rextInfo)
+ if (NrextO.eq.5) then
+ WRITE (Iunit,99988) I, spinGroup%getJ(),
+ * (rext%getSammyValue(K),
+ * (Draw(J,K),J=1,5),K=1,5)
+ else
+ WRITE (Iunit,99987) I, spinGroup%getJ(),
+ * (rext%getSammyValue(K),
+ * (Draw(J,K),J=1,5),K=1,7)
+ end if
+ else
+ WRITE (Iunit,99986) I, spinGroup%getJ()
END IF
+ DO J=2,Mmax
+ hasRext = resParData%hasRexInfo(I, J)
+ if (hasRext) then
+ call resParData%getRextInfoByGroup(rextInfo,I, J)
+ call resParData%getRext(rext, rextInfo)
+ Js = 0
+ DO K = 1, rextInfo%getNrext()
+ Js(K) = rextInfo%getIflSammyIndex(K)
+ end do
+ call Setflg(Js, 7)
+ ! currently in the input R-external can have 5 or seven parameters
+ ! The output should reflect the user input
+ if (NrextO.eq.5) Then
+ WRITE (Iunit,99985) J,
+ * (rext%getSammyValue(K),(Draw(JJ,K),
+ * JJ=1,5),K=1,5)
+ else
+ WRITE (Iunit,99984) J,
+ * (rext%getSammyValue(K),(Draw(JJ,K),
+ * JJ=1,5),K=1,7)
+ end if
+ end if
+ END DO
DO J=1,Mmax
- IF (Iflext(1,J,I).NE.-1) THEN
- DO K=1,Nrext
- IF (Iflext(K,J,I).NE.0) THEN
+ IF (resParData%hasRexInfo(I, J)) THEN
+ call resParData%getRextInfoByGroup(rextInfo, I, J)
+ call resParData%getRext(rext, rextInfo)
+ DO K=1,rextInfo%getNrext()
+ IF (rextInfo%getIflSammyIndex(K).NE.0) THEN
Ipar = Ipar + 1
- Dump(Ipar) = Parext(K,J,I)
+ Dump(Ipar) = rext%getSammyValue(K)
IF (Dump(Ipar).LT.Zero) Dump(Ipar) =
* -Dump(Ipar)
END IF
diff --git a/sammy/src/endf/CMakeLists.txt b/sammy/src/endf/CMakeLists.txt
index 704c23bbe9bc366d8286c80ab648e8d1fec09d72..25560403c0e34dd8bcfdf602de9ca29b53059f69 100644
--- a/sammy/src/endf/CMakeLists.txt
+++ b/sammy/src/endf/CMakeLists.txt
@@ -25,6 +25,7 @@ SET(HEADERS
interface/cpp/CovarianceContainerInterface.h
interface/cpp/EndfDataInterface.h
interface/cpp/AdjustedRadiusDataInterface.h
+ interface/cpp/SammyRExternalInfoInterface.h
CovarianceData.h
EndfData.h
EnumerationData.h
@@ -40,6 +41,7 @@ SET(HEADERS
WriteOutputData.h
WriteResonanceParameters.h
AdjustedRadiusData.h
+ SammyRExternalInfo.h
)
APPEND_SET(ENDF_SOURCES
@@ -150,6 +152,9 @@ APPEND_SET(ENDF_SOURCES
interface/fortran/AdjustedRadiusData_I.f90
interface/fortran/AdjustedRadiusData_M.f90
+ interface/cpp/SammyRExternalInfoInterface.cpp
+ interface/fortran/SammyRExternalInfo_I.f90
+ interface/fortran/SammyRExternalInfo_M.f90
)
diff --git a/sammy/src/endf/SammyRExternalInfo.h b/sammy/src/endf/SammyRExternalInfo.h
new file mode 100644
index 0000000000000000000000000000000000000000..2e6a8cd638f316342d29249cb900464284288bdf
--- /dev/null
+++ b/sammy/src/endf/SammyRExternalInfo.h
@@ -0,0 +1,154 @@
+#ifndef SAMMYREXTERNALINFO_H
+#define SAMMYREXTERNALINFO_H
+
+#include <exception>
+#include <stdexcept>
+#include <string>
+
+namespace sammy{
+ class SammyRExternalInfo{
+ public:
+ SammyRExternalInfo():grp(-1),
+ chan(-1),
+ iflConstantRext(0),
+ iflLinearRext(0),
+ iflQuadraticRext(0),
+ iflConstantCoeffLog(0),
+ iflLinearCoeffLog(0),
+ iflELowRange(0),
+ iflEUpRange(0),
+ iflPoleStrength(0),
+ iflAvgRadWidth(0),
+ nrext(0){}
+ SammyRExternalInfo(const SammyRExternalInfo & orig):grp(orig.grp),
+ chan(orig.chan),
+ iflConstantRext(orig.iflConstantRext),
+ iflLinearRext(orig.iflLinearRext),
+ iflQuadraticRext(orig.iflQuadraticRext),
+ iflConstantCoeffLog(orig.iflConstantCoeffLog),
+ iflLinearCoeffLog(orig.iflLinearCoeffLog),
+ iflELowRange(orig.iflELowRange),
+ iflEUpRange(orig.iflEUpRange),
+ iflPoleStrength(orig.iflPoleStrength),
+ iflAvgRadWidth(orig.iflAvgRadWidth),
+ nrext(orig.nrext){}
+
+ virtual ~SammyRExternalInfo(){}
+
+
+ int getGrp() const{ return grp;} // Sping group to which this belongs
+ int getChannel() const { return chan;}; // the channel to which this belongs
+
+ // r-external parameters
+ int getIflConstantRext() const{ return iflConstantRext;}
+ int getIflLinearRext() const{ return iflLinearRext;}
+ int getIflQuadraticRext() const{ return iflQuadraticRext;}
+ int getIflConstantCoeffLog() const{ return iflConstantCoeffLog;}
+ int getIflLinearCoeffLog() const{ return iflLinearCoeffLog;}
+ int getIflELowRange() const{ return iflELowRange;}
+ int getIflEUpRange() const{ return iflEUpRange;}
+ int getIflPoleStrength() const{ return iflPoleStrength;}
+ int getIflAvgRadWidth() const{ return iflAvgRadWidth;}
+
+ int getNrext() const{ return nrext;}
+
+ void setGrp(int g) { grp=g;} // Sping group to which this belongs
+ void setChannel(int c) { chan = c;}
+ // r-external parameters
+ void setIflConstantRext(int ifl) { iflConstantRext = ifl;}
+ void setIflLinearRext(int ifl) { iflLinearRext = ifl;}
+ void setIflQuadraticRext(int ifl) { iflQuadraticRext = ifl;}
+ void setIflConstantCoeffLog(int ifl) { iflConstantCoeffLog = ifl;}
+ void setIflLinearCoeffLog(int ifl) { iflLinearCoeffLog = ifl;}
+ void setIflELowRange(int ifl) { iflELowRange = ifl;}
+ void setIflEUpRange(int ifl) { iflEUpRange = ifl;}
+ void setIflPoleStrength(int ifl) { iflPoleStrength = ifl;}
+ void setIflAvgRadWidth(int ifl) { iflAvgRadWidth = ifl;}
+
+ void setNrext(int n) { nrext = n;} // determine whether 5, 7 or 0 parameters are given
+
+ /**
+ * Helper function to match function names to SAMMY indexing
+ *
+ * @param i the SAMMY index to the parameters
+ * @return the desired fit flag
+ */
+ int getIflSammyIndex(int i) const{
+ switch(i){
+ case 1:
+ return getIflELowRange();
+ case 2:
+ return getIflEUpRange();
+ case 3:
+ return getIflConstantRext();
+ case 4:
+ return getIflLinearRext();
+ case 5:
+ return getIflConstantCoeffLog();
+ case 6:
+ return getIflLinearCoeffLog();
+ case 7:
+ return getIflQuadraticRext();
+ default:
+ return 0;
+ }
+ }
+
+ /**
+ * Helper function to match function names to SAMMY indexing
+ *
+ * @param i the SAMMY index to the parameters
+ * @param flag the desired fit flag
+ */
+ void setIflSammyIndex(int i, int flag) {
+ switch(i){
+ case 1:
+ setIflELowRange(flag);
+ break;
+ case 2:
+ setIflEUpRange(flag);
+ break;
+ case 3:
+ setIflConstantRext(flag);
+ break;
+ case 4:
+ setIflLinearRext(flag);
+ break;
+ case 5:
+ setIflConstantCoeffLog(flag);
+ break;
+ case 6:
+ setIflLinearCoeffLog(flag);
+ break;
+ case 7:
+ setIflQuadraticRext(flag);
+ break;
+ default:
+ throw std::runtime_error("Invalid index " + std::to_string(i) + " to set R-external fit flags");
+ }
+ }
+
+ private:
+ int grp; // Sping group to which this belongs
+
+ int chan; // the channel to which this belongs
+
+ // r-external parameters
+ // names are as in the R-External data object
+ // prefixed by ifl to indicate that it is the
+ // corresponding fit flag
+ int iflConstantRext;
+ int iflLinearRext;
+ int iflQuadraticRext;
+ int iflConstantCoeffLog;
+ int iflLinearCoeffLog;
+ int iflELowRange;
+ int iflEUpRange;
+ int iflPoleStrength;
+ int iflAvgRadWidth;
+
+ int nrext;
+ };
+}
+
+#endif // SAMMYREXTERNALINFO_H
diff --git a/sammy/src/endf/SammyRMatrixParameters.cpp b/sammy/src/endf/SammyRMatrixParameters.cpp
index 9ad64c39334646ac36f84514fafbf6c197229666..6f09790a1881e975ac0974a5793511a0d68880d6 100644
--- a/sammy/src/endf/SammyRMatrixParameters.cpp
+++ b/sammy/src/endf/SammyRMatrixParameters.cpp
@@ -104,6 +104,51 @@ namespace sammy{
spinGroupData.push_back(spin);
}
+
+
+ void SammyRMatrixParameters::addRext(int grp, int chan){
+ SammySpinGroupInfo * spinInfo = getSpinGroupInfo(grp);
+ SammyChannelInfo *channelInfo = spinInfo->getChannelInfo(chan);
+ endf::RMatChannelParams *channel = getChannel(channelInfo);
+ channel->getRExternalFuncAlter().setFormat(2); // make it SAMMY format by default
+
+ std::shared_ptr<SammyRExternalInfo> rext = std::make_shared<SammyRExternalInfo>();
+ rext->setGrp(grp);
+ rext->setChannel(chan);
+ rextInfo.push_back(rext);
+ }
+
+ SammyRExternalInfo * SammyRMatrixParameters::getRextInfo(int index){
+ if (index < 0 || index >= (int)rextInfo.size()){
+ throw std::runtime_error("Invalid index in getRextInfo");
+ }
+
+ return rextInfo[index].get();
+ }
+
+ endf::RExternalFunction * SammyRMatrixParameters::getRext(SammyRExternalInfo * info){
+ SammySpinGroupInfo * spinInfo = getSpinGroupInfo(info->getGrp());
+ SammyChannelInfo *channelInfo = spinInfo->getChannelInfo(info->getChannel());
+ endf::RMatChannelParams *channel = getChannel(channelInfo);
+ return &(channel->getRExternalFuncAlter());
+ }
+
+ SammyRExternalInfo * SammyRMatrixParameters::getRextInfoByGroup(int grp, int channel){
+ for (auto & info : rextInfo){
+ if (info->getGrp() == grp && info->getChannel() == channel){
+ return info.get();
+ }
+ }
+ return nullptr;
+ }
+ bool SammyRMatrixParameters::hasRexInfo(int grp, int channel) const{
+ for (auto & info : rextInfo){
+ if (info->getGrp() == grp && info->getChannel() == channel){
+ return true;
+ }
+ }
+ return false;
+ }
void SammyRMatrixParameters::setAbundanceByIsotope(int iso, double abn){
if (resonanceData == NULL || iso < 0 || iso >= resonanceData->getNumIso()){
diff --git a/sammy/src/endf/SammyRMatrixParameters.h b/sammy/src/endf/SammyRMatrixParameters.h
index abe53bed07ce3ce899169e31241f07c4cf9d23a4..b3afecee3402d05020079f11d2229611af615872 100644
--- a/sammy/src/endf/SammyRMatrixParameters.h
+++ b/sammy/src/endf/SammyRMatrixParameters.h
@@ -9,6 +9,7 @@
#include "SammyIsoInfo.h"
#include "SammyParticlePairInfo.h"
#include "SammyChannelInfo.h"
+#include "SammyRExternalInfo.h"
#include <vector>
namespace sammy{
@@ -145,6 +146,37 @@ namespace sammy{
*/
void addSpinGroupData(int iso, endf::RMatSpinGroup * group, double abundance, double target);
+ /**
+ * Get the number of R-external information
+ * @return the number of R-external information
+ */
+ int getNumRext() const { return (int)rextInfo.size();}
+
+ /**
+ * Add r-external data for the indicated spin group and channel
+ *
+ * @param grp the group to which to add the data
+ * @param chan the channel to which to add the data
+ */
+ void addRext(int grp, int chan);
+
+ /**
+ * Get the R-external info at the indicated position
+ *
+ * @param index the desired index
+ * @return the R-external info
+ */
+ SammyRExternalInfo * getRextInfo(int index);
+ SammyRExternalInfo * getRextInfoByGroup(int grp, int channel);
+ bool hasRexInfo(int grp, int channel) const;
+
+ /**
+ * Get the underlying R-external R-Matrix object
+ * @param info the info needed to retrieve the data
+ * @return the underlying R-external R-Matrix object
+ */
+ endf::RExternalFunction * getRext(SammyRExternalInfo * info);
+
/**
* Get the resonance for the indicated Resonance information object
@@ -294,6 +326,8 @@ namespace sammy{
std::vector< std::shared_ptr<SammyParticlePairInfo> > particlePairInfo;
std::vector<std::shared_ptr<SammyIsoInfo> > isoInfo;
+
+ std::vector<std::shared_ptr<SammyRExternalInfo> > rextInfo;
/** The resonances in reduced width.
diff --git a/sammy/src/endf/interface/cix/RMatResonanceParam.cpp2f.xml b/sammy/src/endf/interface/cix/RMatResonanceParam.cpp2f.xml
index 610f364411806925c0a2272ba31e81560711adb6..8038f6db7077d70352c7d8ca4c9a5e68e2470356 100644
--- a/sammy/src/endf/interface/cix/RMatResonanceParam.cpp2f.xml
+++ b/sammy/src/endf/interface/cix/RMatResonanceParam.cpp2f.xml
@@ -29,6 +29,59 @@
<method name="isReducedWidth" return_type="bool"/>
</class>
+ <class name="RExternalFunction">
+ <method name="getConstantRext" return_type="double"/>
+ <method name="getLinearRext" return_type="double"/>
+ <method name="getQuadraticRext" return_type="double"/>
+ <method name="getConstantCoeffLogTerm" return_type="double"/>
+ <method name="getLinearCoeffLogTerm" return_type="double"/>
+ <method name="getSingularityBelowErange" return_type="double"/>
+ <method name="getSingularityAboveErange" return_type="double"/>
+ <method name="getPoleStrength" return_type="double"/>
+ <method name="getAvgRadiationWidth" return_type="double"/>
+ <method name="getRealTab1" return_type="Tab1"/>
+ <method name="getImagTab1" return_type="Tab1"/>
+
+ <method name="setConstantRext">
+ <param name="Rcon" type="double"/>
+ </method>
+ <method name="setLinearRext">
+ <param name="Rlin" type="double"/>
+ </method>
+ <method name="setQuadraticRext">
+ <param name="Rquad" type="double"/>
+ </method>
+ <method name="setConstantCoeffLogTerm">
+ <param name="scon" type="double"/>
+ </method>
+ <method name="setLinearCoeffLogTerm">
+ <param name="slin" type="double"/>
+ </method>
+ <method name="setSingularityBelowErange">
+ <param name="Edown" type="double"/>
+ </method>
+ <method name="setSingularityAboveErange">
+ <param name="Eup" type="double"/>
+ </method>
+ <method name="setPoleStrength">
+ <param name="ps" type="double"/>
+ </method>
+ <method name="setAvgRadiationWidth">
+ <param name="avgGg" type="double"/>
+ </method>
+
+ <method name="getFormat" return_type="int"/>
+ <method name="setFormat">
+ <param name="lbk" type="int"/>
+ </method>
+ <method name="setRealTab1">
+ <param name="tab1Val" type="Tab1"/>
+ </method>
+ <method name="setImagTab1">
+ <param name="tab1Val" type="Tab1"/>
+ </method>
+ </class>
+
<class name="RMatChannelParams">
<!-- we don't have a default constructor - edit after creation to make it no operational -->
<constructor name="initialize_DEFAULT">
@@ -61,6 +114,8 @@
</method>
<method name="getPpi" return_type="int"/>
+
+ <method name="getRExternalFunc" return_type="RExternalFunction"/>
</class>
<class name="RMatSpinGroup">
@@ -93,6 +148,8 @@
<method name="getChannel" return_type="RMatChannelParams*">
<param name="nc" type="int" offset="-1"/>
</method>
+
+ <method name="doesRExternalFunctionExist" return_type="bool"/>
</class>
@@ -149,8 +206,8 @@
<param name="index" type="int" offset="-1"/>
</method>
<method name="setPa">
- <param name="index" type="double" offset="-1"/>
- <param name="pa" type="int"/>
+ <param name="index" type="int" offset="-1"/>
+ <param name="pa" type="double"/>
</method>
<method name="getCalcShift" return_type="bool"/>
diff --git a/sammy/src/endf/interface/cix/SammyRExternalInfo.cpp2f.xml b/sammy/src/endf/interface/cix/SammyRExternalInfo.cpp2f.xml
new file mode 100644
index 0000000000000000000000000000000000000000..5ec4cbb335546bb7b0543f5efb057a1894ecef20
--- /dev/null
+++ b/sammy/src/endf/interface/cix/SammyRExternalInfo.cpp2f.xml
@@ -0,0 +1,68 @@
+<generate name="SammyRExternalInfo">
+ <include_relative name="../../SammyRExternalInfo.h"/>
+ <using_namespace name="sammy"/>
+
+ <class name="SammyRExternalInfo">
+ <method name="getGrp" return_type="int"/>
+ <method name="getChannel" return_type="int"/>
+
+ <method name="getIflConstantRext" return_type="int"/>
+ <method name="getIflLinearRext" return_type="int"/>
+ <method name="getIflQuadraticRext" return_type="int"/>
+ <method name="getIflConstantCoeffLog" return_type="int"/>
+ <method name="getIflLinearCoeffLog" return_type="int"/>
+ <method name="getIflELowRange" return_type="int"/>
+ <method name="getIflEUpRange" return_type="int"/>
+ <method name="getIflPoleStrength" return_type="int"/>
+ <method name="getIflAvgRadWidth" return_type="int"/>
+
+ <method name="getNrext" return_type="int"/>
+
+ <method name="setGrp">
+ <param name="index" type="int" offset="-1"/>
+ </method>
+ <method name="setChannel">
+ <param name="index" type="int" offset="-1"/>
+ </method>
+
+ <method name="setIflConstantRext">
+ <param name="ifl" type="int"/>
+ </method>
+ <method name="setIflLinearRext">
+ <param name="ifl" type="int"/>
+ </method>
+ <method name="setIflQuadraticRext">
+ <param name="ifl" type="int"/>
+ </method>
+ <method name="setIflConstantCoeffLog">
+ <param name="ifl" type="int"/>
+ </method>
+ <method name="setIflLinearCoeffLog">
+ <param name="ifl" type="int"/>
+ </method>
+ <method name="setIflELowRange">
+ <param name="ifl" type="int"/>
+ </method>
+ <method name="setIflEUpRange">
+ <param name="ifl" type="int"/>
+ </method>
+ <method name="setIflPoleStrength">
+ <param name="ifl" type="int"/>
+ </method>
+ <method name="setIflAvgRadWidth">
+ <param name="ifl" type="int"/>
+ </method>
+
+ <method name="getIflSammyIndex" return_type="int">
+ <param name="i" type="int"/>
+ </method>
+ <method name="setIflSammyIndex">
+ <param name="i" type="int"/>
+ <param name="ifl" type="int"/>
+ </method>
+
+ <method name="setNrext">
+ <param name="ifl" type="int"/>
+ </method>
+ </class>
+</generate>
diff --git a/sammy/src/endf/interface/cix/SammyRMatrixParameters.cpp2f.xml b/sammy/src/endf/interface/cix/SammyRMatrixParameters.cpp2f.xml
index e56b4821dfeeaec57016ab50b8457a2485ce0221..04d2dea37339de37420ebfc538330592f355ae36 100644
--- a/sammy/src/endf/interface/cix/SammyRMatrixParameters.cpp2f.xml
+++ b/sammy/src/endf/interface/cix/SammyRMatrixParameters.cpp2f.xml
@@ -117,7 +117,27 @@
<param name="info" type="SammyChannelInfo *"/>
<param name="channel" type="RMatChannelParams *"/>
</method>
-
+
+ <method name="getNumRext" return_type="int"/>
+ <method name="addRext" >
+ <param name="grp" type="int" offset="-1"/>
+ <param name="chan" type="int" offset="-1"/>
+ </method>
+ <method name="getRextInfo" return_type="SammyRExternalInfo *">
+ <param name="index" type="int" offset="-1"/>
+ </method>
+ <method name="getRext" return_type="RExternalFunction *">
+ <param name="info" type="SammyRExternalInfo *"/>
+ </method>
+ <method name="getRextInfoByGroup" return_type="SammyRExternalInfo *">
+ <param name="grp" type="int" offset="-1"/>
+ <param name="channel" type="int" offset="-1"/>
+ </method>
+ <method name="hasRexInfo" return_type="bool">
+ <param name="grp" type="int" offset="-1"/>
+ <param name="channel" type="int" offset="-1"/>
+ </method>
+
<method name="orderByGroupAndEnergy" return_type="int"/>
<method name="orderByEnergy" return_type="int"/>
</class>
diff --git a/sammy/src/endf/interface/cpp/RMatResonanceParamInterface.cpp b/sammy/src/endf/interface/cpp/RMatResonanceParamInterface.cpp
index d408cdb04560409dd5b54fe275aed6032651077e..b1d77ec9d6eb3ac30b12d05cfff519f83d18ed50 100644
--- a/sammy/src/endf/interface/cpp/RMatResonanceParamInterface.cpp
+++ b/sammy/src/endf/interface/cpp/RMatResonanceParamInterface.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: Mon Dec 17 09:52:53 EST 2018
+* Date Generated: Wed Jun 09 12:46:14 EDT 2021
* 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
*/
@@ -54,6 +54,138 @@ void RMatResonance_destroy(void * RMatResonance_ptr)
delete (RMatResonance*)RMatResonance_ptr;
}
+double RExternalFunction_getConstantRext(void * RExternalFunction_ptr)
+{
+ return ((RExternalFunction*)RExternalFunction_ptr)->getConstantRext();
+}
+
+double RExternalFunction_getLinearRext(void * RExternalFunction_ptr)
+{
+ return ((RExternalFunction*)RExternalFunction_ptr)->getLinearRext();
+}
+
+double RExternalFunction_getQuadraticRext(void * RExternalFunction_ptr)
+{
+ return ((RExternalFunction*)RExternalFunction_ptr)->getQuadraticRext();
+}
+
+double RExternalFunction_getConstantCoeffLogTerm(void * RExternalFunction_ptr)
+{
+ return ((RExternalFunction*)RExternalFunction_ptr)->getConstantCoeffLogTerm();
+}
+
+double RExternalFunction_getLinearCoeffLogTerm(void * RExternalFunction_ptr)
+{
+ return ((RExternalFunction*)RExternalFunction_ptr)->getLinearCoeffLogTerm();
+}
+
+double RExternalFunction_getSingularityBelowErange(void * RExternalFunction_ptr)
+{
+ return ((RExternalFunction*)RExternalFunction_ptr)->getSingularityBelowErange();
+}
+
+double RExternalFunction_getSingularityAboveErange(void * RExternalFunction_ptr)
+{
+ return ((RExternalFunction*)RExternalFunction_ptr)->getSingularityAboveErange();
+}
+
+double RExternalFunction_getPoleStrength(void * RExternalFunction_ptr)
+{
+ return ((RExternalFunction*)RExternalFunction_ptr)->getPoleStrength();
+}
+
+double RExternalFunction_getAvgRadiationWidth(void * RExternalFunction_ptr)
+{
+ return ((RExternalFunction*)RExternalFunction_ptr)->getAvgRadiationWidth();
+}
+
+void* RExternalFunction_getRealTab1(void * RExternalFunction_ptr)
+{
+ const endf::Tab1& tab1 = ((RExternalFunction*)RExternalFunction_ptr)->getRealTab1();
+ return (void*)const_cast<endf::Tab1*>(&tab1);
+}
+
+void* RExternalFunction_getImagTab1(void * RExternalFunction_ptr)
+{
+ const endf::Tab1& tab1 =((RExternalFunction*)RExternalFunction_ptr)->getImagTab1();
+ return (void*)const_cast<endf::Tab1*>(&tab1);
+}
+
+void RExternalFunction_setConstantRext(void * RExternalFunction_ptr,double * Rcon)
+{
+ ((RExternalFunction*)RExternalFunction_ptr)->setConstantRext(*Rcon);
+}
+
+void RExternalFunction_setLinearRext(void * RExternalFunction_ptr,double * Rlin)
+{
+ ((RExternalFunction*)RExternalFunction_ptr)->setLinearRext(*Rlin);
+}
+
+void RExternalFunction_setQuadraticRext(void * RExternalFunction_ptr,double * Rquad)
+{
+ ((RExternalFunction*)RExternalFunction_ptr)->setQuadraticRext(*Rquad);
+}
+
+void RExternalFunction_setConstantCoeffLogTerm(void * RExternalFunction_ptr,double * scon)
+{
+ ((RExternalFunction*)RExternalFunction_ptr)->setConstantCoeffLogTerm(*scon);
+}
+
+void RExternalFunction_setLinearCoeffLogTerm(void * RExternalFunction_ptr,double * slin)
+{
+ ((RExternalFunction*)RExternalFunction_ptr)->setLinearCoeffLogTerm(*slin);
+}
+
+void RExternalFunction_setSingularityBelowErange(void * RExternalFunction_ptr,double * Edown)
+{
+ ((RExternalFunction*)RExternalFunction_ptr)->setSingularityBelowErange(*Edown);
+}
+
+void RExternalFunction_setSingularityAboveErange(void * RExternalFunction_ptr,double * Eup)
+{
+ ((RExternalFunction*)RExternalFunction_ptr)->setSingularityAboveErange(*Eup);
+}
+
+void RExternalFunction_setPoleStrength(void * RExternalFunction_ptr,double * ps)
+{
+ ((RExternalFunction*)RExternalFunction_ptr)->setPoleStrength(*ps);
+}
+
+void RExternalFunction_setAvgRadiationWidth(void * RExternalFunction_ptr,double * avgGg)
+{
+ ((RExternalFunction*)RExternalFunction_ptr)->setAvgRadiationWidth(*avgGg);
+}
+
+int RExternalFunction_getFormat(void * RExternalFunction_ptr)
+{
+ return (int)((RExternalFunction*)RExternalFunction_ptr)->formatType;
+}
+
+void RExternalFunction_setFormat(void * RExternalFunction_ptr,int * lbk)
+{
+ ((RExternalFunction*)RExternalFunction_ptr)->setFormat(*lbk);
+}
+
+void RExternalFunction_setRealTab1(void * RExternalFunction_ptr,Tab1 * tab1Val)
+{
+ ((RExternalFunction*)RExternalFunction_ptr)->setRealTab1(*tab1Val);
+}
+
+void RExternalFunction_setImagTab1(void * RExternalFunction_ptr,Tab1 * tab1Val)
+{
+ ((RExternalFunction*)RExternalFunction_ptr)->setImagTab1(*tab1Val);
+}
+
+void* RExternalFunction_initialize()
+{
+ return new RExternalFunction();
+}
+
+void RExternalFunction_destroy(void * RExternalFunction_ptr)
+{
+ delete (RExternalFunction*)RExternalFunction_ptr;
+}
+
void* RMatChannelParams_initialize_DEFAULT(int * ppi )
{
return new RMatChannelParams(*ppi);
@@ -114,6 +246,12 @@ int RMatChannelParams_getPpi(void * RMatChannelParams_ptr)
return ((RMatChannelParams*)RMatChannelParams_ptr)->getPpi();
}
+void* RMatChannelParams_getRExternalFunc(void * RMatChannelParams_ptr)
+{
+ RExternalFunction & func = ((RMatChannelParams*)RMatChannelParams_ptr)->getRExternalFuncAlter();
+ return (void*)&func;
+}
+
void* RMatChannelParams_initialize()
{
throw std::runtime_error("Not implemented");
@@ -169,9 +307,14 @@ void* RMatSpinGroup_getChannel(void * RMatSpinGroup_ptr,int * nc)
return (void*)((RMatSpinGroup*)RMatSpinGroup_ptr)->getChannel(*nc);
}
+bool RMatSpinGroup_doesRExternalFunctionExist(void * RMatSpinGroup_ptr)
+{
+ return ((RMatSpinGroup*)RMatSpinGroup_ptr)->doesRExternalFunctionExist();
+}
+
void* RMatSpinGroup_initialize()
{
- throw std::runtime_error("Not implemented");
+ throw std::runtime_error("Not implemented");
}
void RMatSpinGroup_destroy(void * RMatSpinGroup_ptr)
@@ -227,8 +370,8 @@ int RMatParticlePair_getPnt(void * RMatParticlePair_ptr)
return 0;
}
-void RMatParticlePair_setPnt(void * RMatParticlePair_ptr,int* p)
-{
+void RMatParticlePair_setPnt(void * RMatParticlePair_ptr,int * p)
+{
if ( (*p) == 2) {
((RMatParticlePair*)RMatParticlePair_ptr)->setPnt(endf::RMatParticlePair::PenetrabilityFlag::ASSIGN);
}
@@ -265,7 +408,7 @@ double RMatParticlePair_getPa(void * RMatParticlePair_ptr,int * index)
return ((RMatParticlePair*)RMatParticlePair_ptr)->getPa(*index);
}
-void RMatParticlePair_setPa(void * RMatParticlePair_ptr,int * index,int * pa)
+void RMatParticlePair_setPa(void * RMatParticlePair_ptr,int * index,double * pa)
{
((RMatParticlePair*)RMatParticlePair_ptr)->setPa(*index,*pa);
}
@@ -282,7 +425,7 @@ void RMatParticlePair_setCalcShift(void * RMatParticlePair_ptr,bool * calc)
void* RMatParticlePair_initialize()
{
- throw std::runtime_error("Not implemented");
+ throw std::runtime_error("Not implemented");
}
void RMatParticlePair_destroy(void * RMatParticlePair_ptr)
@@ -352,7 +495,7 @@ void RMatResonanceParam_setCovariances(void * RMatResonanceParam_ptr,ResonanceCo
void* RMatResonanceParam_initialize()
{
- throw std::runtime_error("Not implemented");
+ throw std::runtime_error("Not implemented");
}
void RMatResonanceParam_destroy(void * RMatResonanceParam_ptr)
diff --git a/sammy/src/endf/interface/cpp/RMatResonanceParamInterface.h b/sammy/src/endf/interface/cpp/RMatResonanceParamInterface.h
index c85903bf6db795e331a0436c265e1bf7caeb0b4b..12214dd6a5c03b7803f6ab2c12a593ef5e14f8be 100644
--- a/sammy/src/endf/interface/cpp/RMatResonanceParamInterface.h
+++ b/sammy/src/endf/interface/cpp/RMatResonanceParamInterface.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: Mon Dec 17 09:52:53 EST 2018
+* Date Generated: Wed Jun 09 12:46:14 EDT 2021
* 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
*/
@@ -24,6 +24,32 @@ void RMatResonance_setWidth(void * RMatResonance_ptr,int * nc,double * x);
bool RMatResonance_isReducedWidth(void * RMatResonance_ptr);
void* RMatResonance_initialize();
void RMatResonance_destroy(void * RMatResonance_ptr);
+double RExternalFunction_getConstantRext(void * RExternalFunction_ptr);
+double RExternalFunction_getLinearRext(void * RExternalFunction_ptr);
+double RExternalFunction_getQuadraticRext(void * RExternalFunction_ptr);
+double RExternalFunction_getConstantCoeffLogTerm(void * RExternalFunction_ptr);
+double RExternalFunction_getLinearCoeffLogTerm(void * RExternalFunction_ptr);
+double RExternalFunction_getSingularityBelowErange(void * RExternalFunction_ptr);
+double RExternalFunction_getSingularityAboveErange(void * RExternalFunction_ptr);
+double RExternalFunction_getPoleStrength(void * RExternalFunction_ptr);
+double RExternalFunction_getAvgRadiationWidth(void * RExternalFunction_ptr);
+void* RExternalFunction_getRealTab1(void * RExternalFunction_ptr);
+void* RExternalFunction_getImagTab1(void * RExternalFunction_ptr);
+void RExternalFunction_setConstantRext(void * RExternalFunction_ptr,double * Rcon);
+void RExternalFunction_setLinearRext(void * RExternalFunction_ptr,double * Rlin);
+void RExternalFunction_setQuadraticRext(void * RExternalFunction_ptr,double * Rquad);
+void RExternalFunction_setConstantCoeffLogTerm(void * RExternalFunction_ptr,double * scon);
+void RExternalFunction_setLinearCoeffLogTerm(void * RExternalFunction_ptr,double * slin);
+void RExternalFunction_setSingularityBelowErange(void * RExternalFunction_ptr,double * Edown);
+void RExternalFunction_setSingularityAboveErange(void * RExternalFunction_ptr,double * Eup);
+void RExternalFunction_setPoleStrength(void * RExternalFunction_ptr,double * ps);
+void RExternalFunction_setAvgRadiationWidth(void * RExternalFunction_ptr,double * avgGg);
+int RExternalFunction_getFormat(void * RExternalFunction_ptr);
+void RExternalFunction_setFormat(void * RExternalFunction_ptr,int * lbk);
+void RExternalFunction_setRealTab1(void * RExternalFunction_ptr,Tab1 * tab1Val);
+void RExternalFunction_setImagTab1(void * RExternalFunction_ptr,Tab1 * tab1Val);
+void* RExternalFunction_initialize();
+void RExternalFunction_destroy(void * RExternalFunction_ptr);
void* RMatChannelParams_initialize_DEFAULT(int * ppi );
int RMatChannelParams_getL(void * RMatChannelParams_ptr);
void RMatChannelParams_setL(void * RMatChannelParams_ptr,int * l);
@@ -36,6 +62,7 @@ void RMatChannelParams_setApe(void * RMatChannelParams_ptr,double * s);
double RMatChannelParams_getApt(void * RMatChannelParams_ptr);
void RMatChannelParams_setApt(void * RMatChannelParams_ptr,double * s);
int RMatChannelParams_getPpi(void * RMatChannelParams_ptr);
+void* RMatChannelParams_getRExternalFunc(void * RMatChannelParams_ptr);
void* RMatChannelParams_initialize();
void RMatChannelParams_destroy(void * RMatChannelParams_ptr);
void* RMatSpinGroup_initialize_DEFAULT(double * j,double * pj );
@@ -47,6 +74,7 @@ void RMatSpinGroup_addChannel(void * RMatSpinGroup_ptr,RMatChannelParams* chan);
void RMatSpinGroup_addResonance(void * RMatSpinGroup_ptr,RMatResonance* res);
void* RMatSpinGroup_getResonance(void * RMatSpinGroup_ptr,int * nres);
void* RMatSpinGroup_getChannel(void * RMatSpinGroup_ptr,int * nc);
+bool RMatSpinGroup_doesRExternalFunctionExist(void * RMatSpinGroup_ptr);
void* RMatSpinGroup_initialize();
void RMatSpinGroup_destroy(void * RMatSpinGroup_ptr);
void* RMatParticlePair_initialize_DEFAULT(int * ppi );
@@ -64,7 +92,7 @@ void RMatParticlePair_setMt(void * RMatParticlePair_ptr,int * mt);
double RMatParticlePair_getIa(void * RMatParticlePair_ptr,int * index);
void RMatParticlePair_setIa(void * RMatParticlePair_ptr,int * index,double * ia);
double RMatParticlePair_getPa(void * RMatParticlePair_ptr,int * index);
-void RMatParticlePair_setPa(void * RMatParticlePair_ptr,int * index,int * pa);
+void RMatParticlePair_setPa(void * RMatParticlePair_ptr,int * index,double * pa);
bool RMatParticlePair_getCalcShift(void * RMatParticlePair_ptr);
void RMatParticlePair_setCalcShift(void * RMatParticlePair_ptr,bool * calc);
void* RMatParticlePair_initialize();
diff --git a/sammy/src/endf/interface/cpp/SammyRExternalInfoInterface.cpp b/sammy/src/endf/interface/cpp/SammyRExternalInfoInterface.cpp
new file mode 100644
index 0000000000000000000000000000000000000000..5b37a6cea8a097d7f75a5f3c7eadaebcb7d75d5f
--- /dev/null
+++ b/sammy/src/endf/interface/cpp/SammyRExternalInfoInterface.cpp
@@ -0,0 +1,151 @@
+/*!
+* 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: Thu Jun 10 11:48:13 EDT 2021
+* 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
+*/
+#include <string.h>
+#include "SammyRExternalInfoInterface.h"
+using namespace sammy;
+int SammyRExternalInfo_getGrp(void * SammyRExternalInfo_ptr)
+{
+ return ((SammyRExternalInfo*)SammyRExternalInfo_ptr)->getGrp();
+}
+
+int SammyRExternalInfo_getChannel(void * SammyRExternalInfo_ptr)
+{
+ return ((SammyRExternalInfo*)SammyRExternalInfo_ptr)->getChannel();
+}
+
+int SammyRExternalInfo_getIflConstantRext(void * SammyRExternalInfo_ptr)
+{
+ return ((SammyRExternalInfo*)SammyRExternalInfo_ptr)->getIflConstantRext();
+}
+
+int SammyRExternalInfo_getIflLinearRext(void * SammyRExternalInfo_ptr)
+{
+ return ((SammyRExternalInfo*)SammyRExternalInfo_ptr)->getIflLinearRext();
+}
+
+int SammyRExternalInfo_getIflQuadraticRext(void * SammyRExternalInfo_ptr)
+{
+ return ((SammyRExternalInfo*)SammyRExternalInfo_ptr)->getIflQuadraticRext();
+}
+
+int SammyRExternalInfo_getIflConstantCoeffLog(void * SammyRExternalInfo_ptr)
+{
+ return ((SammyRExternalInfo*)SammyRExternalInfo_ptr)->getIflConstantCoeffLog();
+}
+
+int SammyRExternalInfo_getIflLinearCoeffLog(void * SammyRExternalInfo_ptr)
+{
+ return ((SammyRExternalInfo*)SammyRExternalInfo_ptr)->getIflLinearCoeffLog();
+}
+
+int SammyRExternalInfo_getIflELowRange(void * SammyRExternalInfo_ptr)
+{
+ return ((SammyRExternalInfo*)SammyRExternalInfo_ptr)->getIflELowRange();
+}
+
+int SammyRExternalInfo_getIflEUpRange(void * SammyRExternalInfo_ptr)
+{
+ return ((SammyRExternalInfo*)SammyRExternalInfo_ptr)->getIflEUpRange();
+}
+
+int SammyRExternalInfo_getIflPoleStrength(void * SammyRExternalInfo_ptr)
+{
+ return ((SammyRExternalInfo*)SammyRExternalInfo_ptr)->getIflPoleStrength();
+}
+
+int SammyRExternalInfo_getIflAvgRadWidth(void * SammyRExternalInfo_ptr)
+{
+ return ((SammyRExternalInfo*)SammyRExternalInfo_ptr)->getIflAvgRadWidth();
+}
+
+int SammyRExternalInfo_getNrext(void * SammyRExternalInfo_ptr)
+{
+ return ((SammyRExternalInfo*)SammyRExternalInfo_ptr)->getNrext();
+}
+
+void SammyRExternalInfo_setGrp(void * SammyRExternalInfo_ptr,int * index)
+{
+ ((SammyRExternalInfo*)SammyRExternalInfo_ptr)->setGrp(*index);
+}
+
+void SammyRExternalInfo_setChannel(void * SammyRExternalInfo_ptr,int * index)
+{
+ ((SammyRExternalInfo*)SammyRExternalInfo_ptr)->setChannel(*index);
+}
+
+void SammyRExternalInfo_setIflConstantRext(void * SammyRExternalInfo_ptr,int * ifl)
+{
+ ((SammyRExternalInfo*)SammyRExternalInfo_ptr)->setIflConstantRext(*ifl);
+}
+
+void SammyRExternalInfo_setIflLinearRext(void * SammyRExternalInfo_ptr,int * ifl)
+{
+ ((SammyRExternalInfo*)SammyRExternalInfo_ptr)->setIflLinearRext(*ifl);
+}
+
+void SammyRExternalInfo_setIflQuadraticRext(void * SammyRExternalInfo_ptr,int * ifl)
+{
+ ((SammyRExternalInfo*)SammyRExternalInfo_ptr)->setIflQuadraticRext(*ifl);
+}
+
+void SammyRExternalInfo_setIflConstantCoeffLog(void * SammyRExternalInfo_ptr,int * ifl)
+{
+ ((SammyRExternalInfo*)SammyRExternalInfo_ptr)->setIflConstantCoeffLog(*ifl);
+}
+
+void SammyRExternalInfo_setIflLinearCoeffLog(void * SammyRExternalInfo_ptr,int * ifl)
+{
+ ((SammyRExternalInfo*)SammyRExternalInfo_ptr)->setIflLinearCoeffLog(*ifl);
+}
+
+void SammyRExternalInfo_setIflELowRange(void * SammyRExternalInfo_ptr,int * ifl)
+{
+ ((SammyRExternalInfo*)SammyRExternalInfo_ptr)->setIflELowRange(*ifl);
+}
+
+void SammyRExternalInfo_setIflEUpRange(void * SammyRExternalInfo_ptr,int * ifl)
+{
+ ((SammyRExternalInfo*)SammyRExternalInfo_ptr)->setIflEUpRange(*ifl);
+}
+
+void SammyRExternalInfo_setIflPoleStrength(void * SammyRExternalInfo_ptr,int * ifl)
+{
+ ((SammyRExternalInfo*)SammyRExternalInfo_ptr)->setIflPoleStrength(*ifl);
+}
+
+void SammyRExternalInfo_setIflAvgRadWidth(void * SammyRExternalInfo_ptr,int * ifl)
+{
+ ((SammyRExternalInfo*)SammyRExternalInfo_ptr)->setIflAvgRadWidth(*ifl);
+}
+
+int SammyRExternalInfo_getIflSammyIndex(void * SammyRExternalInfo_ptr,int * i)
+{
+ return ((SammyRExternalInfo*)SammyRExternalInfo_ptr)->getIflSammyIndex(*i);
+}
+
+void SammyRExternalInfo_setIflSammyIndex(void * SammyRExternalInfo_ptr,int * i,int * ifl)
+{
+ ((SammyRExternalInfo*)SammyRExternalInfo_ptr)->setIflSammyIndex(*i,*ifl);
+}
+
+void SammyRExternalInfo_setNrext(void * SammyRExternalInfo_ptr,int * ifl)
+{
+ ((SammyRExternalInfo*)SammyRExternalInfo_ptr)->setNrext(*ifl);
+}
+
+void* SammyRExternalInfo_initialize()
+{
+ return new SammyRExternalInfo();
+}
+
+void SammyRExternalInfo_destroy(void * SammyRExternalInfo_ptr)
+{
+ delete (SammyRExternalInfo*)SammyRExternalInfo_ptr;
+}
+
diff --git a/sammy/src/endf/interface/cpp/SammyRExternalInfoInterface.h b/sammy/src/endf/interface/cpp/SammyRExternalInfoInterface.h
new file mode 100644
index 0000000000000000000000000000000000000000..c2142258a2a228b9b8ce762b60b39c204526cf53
--- /dev/null
+++ b/sammy/src/endf/interface/cpp/SammyRExternalInfoInterface.h
@@ -0,0 +1,47 @@
+/*!
+* 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: Thu Jun 10 11:48:13 EDT 2021
+* 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
+*/
+#ifndef SAMMYREXTERNALINFOINTERFACE_H
+#define SAMMYREXTERNALINFOINTERFACE_H
+#include "../../SammyRExternalInfo.h"
+using namespace sammy;
+#ifdef __cplusplus
+extern "C" {
+#endif
+int SammyRExternalInfo_getGrp(void * SammyRExternalInfo_ptr);
+int SammyRExternalInfo_getChannel(void * SammyRExternalInfo_ptr);
+int SammyRExternalInfo_getIflConstantRext(void * SammyRExternalInfo_ptr);
+int SammyRExternalInfo_getIflLinearRext(void * SammyRExternalInfo_ptr);
+int SammyRExternalInfo_getIflQuadraticRext(void * SammyRExternalInfo_ptr);
+int SammyRExternalInfo_getIflConstantCoeffLog(void * SammyRExternalInfo_ptr);
+int SammyRExternalInfo_getIflLinearCoeffLog(void * SammyRExternalInfo_ptr);
+int SammyRExternalInfo_getIflELowRange(void * SammyRExternalInfo_ptr);
+int SammyRExternalInfo_getIflEUpRange(void * SammyRExternalInfo_ptr);
+int SammyRExternalInfo_getIflPoleStrength(void * SammyRExternalInfo_ptr);
+int SammyRExternalInfo_getIflAvgRadWidth(void * SammyRExternalInfo_ptr);
+int SammyRExternalInfo_getNrext(void * SammyRExternalInfo_ptr);
+void SammyRExternalInfo_setGrp(void * SammyRExternalInfo_ptr,int * index);
+void SammyRExternalInfo_setChannel(void * SammyRExternalInfo_ptr,int * index);
+void SammyRExternalInfo_setIflConstantRext(void * SammyRExternalInfo_ptr,int * ifl);
+void SammyRExternalInfo_setIflLinearRext(void * SammyRExternalInfo_ptr,int * ifl);
+void SammyRExternalInfo_setIflQuadraticRext(void * SammyRExternalInfo_ptr,int * ifl);
+void SammyRExternalInfo_setIflConstantCoeffLog(void * SammyRExternalInfo_ptr,int * ifl);
+void SammyRExternalInfo_setIflLinearCoeffLog(void * SammyRExternalInfo_ptr,int * ifl);
+void SammyRExternalInfo_setIflELowRange(void * SammyRExternalInfo_ptr,int * ifl);
+void SammyRExternalInfo_setIflEUpRange(void * SammyRExternalInfo_ptr,int * ifl);
+void SammyRExternalInfo_setIflPoleStrength(void * SammyRExternalInfo_ptr,int * ifl);
+void SammyRExternalInfo_setIflAvgRadWidth(void * SammyRExternalInfo_ptr,int * ifl);
+int SammyRExternalInfo_getIflSammyIndex(void * SammyRExternalInfo_ptr,int * i);
+void SammyRExternalInfo_setIflSammyIndex(void * SammyRExternalInfo_ptr,int * i,int * ifl);
+void SammyRExternalInfo_setNrext(void * SammyRExternalInfo_ptr,int * ifl);
+void* SammyRExternalInfo_initialize();
+void SammyRExternalInfo_destroy(void * SammyRExternalInfo_ptr);
+#ifdef __cplusplus
+}
+#endif
+#endif /* SAMMYREXTERNALINFOINTERFACE_H */
diff --git a/sammy/src/endf/interface/cpp/SammyRMatrixParametersInterface.cpp b/sammy/src/endf/interface/cpp/SammyRMatrixParametersInterface.cpp
index 2aa76219687faced651baad030e9f6c414886729..261eaafdb47075c0b3baaffa183f57889bfa2e7a 100644
--- a/sammy/src/endf/interface/cpp/SammyRMatrixParametersInterface.cpp
+++ b/sammy/src/endf/interface/cpp/SammyRMatrixParametersInterface.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: Wed Sep 18 17:36:12 EDT 2019
+* Date Generated: Thu Jun 10 11:51:58 EDT 2021
* 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
*/
@@ -164,6 +164,36 @@ void SammyRMatrixParameters_addChannelData(void * SammyRMatrixParameters_ptr,Sam
((SammyRMatrixParameters*)SammyRMatrixParameters_ptr)->addChannelData(info,channel);
}
+int SammyRMatrixParameters_getNumRext(void * SammyRMatrixParameters_ptr)
+{
+ return ((SammyRMatrixParameters*)SammyRMatrixParameters_ptr)->getNumRext();
+}
+
+void SammyRMatrixParameters_addRext(void * SammyRMatrixParameters_ptr,int * grp,int * chan)
+{
+ ((SammyRMatrixParameters*)SammyRMatrixParameters_ptr)->addRext(*grp,*chan);
+}
+
+void* SammyRMatrixParameters_getRextInfo(void * SammyRMatrixParameters_ptr,int * index)
+{
+ return (void*)((SammyRMatrixParameters*)SammyRMatrixParameters_ptr)->getRextInfo(*index);
+}
+
+void* SammyRMatrixParameters_getRext(void * SammyRMatrixParameters_ptr,SammyRExternalInfo * info)
+{
+ return (void*)((SammyRMatrixParameters*)SammyRMatrixParameters_ptr)->getRext(info);
+}
+
+void* SammyRMatrixParameters_getRextInfoByGroup(void * SammyRMatrixParameters_ptr,int * grp,int * channel)
+{
+ return (void*)((SammyRMatrixParameters*)SammyRMatrixParameters_ptr)->getRextInfoByGroup(*grp,*channel);
+}
+
+bool SammyRMatrixParameters_hasRexInfo(void * SammyRMatrixParameters_ptr,int * grp,int * channel)
+{
+ return ((SammyRMatrixParameters*)SammyRMatrixParameters_ptr)->hasRexInfo(*grp,*channel);
+}
+
int SammyRMatrixParameters_orderByGroupAndEnergy(void * SammyRMatrixParameters_ptr)
{
return ((SammyRMatrixParameters*)SammyRMatrixParameters_ptr)->orderByGroupAndEnergy();
diff --git a/sammy/src/endf/interface/cpp/SammyRMatrixParametersInterface.h b/sammy/src/endf/interface/cpp/SammyRMatrixParametersInterface.h
index c568754fa75a82d50dd092f0da24f94e96a21777..9dc5d2e94049cc32f08bb17f6db096acc00e1438 100644
--- a/sammy/src/endf/interface/cpp/SammyRMatrixParametersInterface.h
+++ b/sammy/src/endf/interface/cpp/SammyRMatrixParametersInterface.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: Wed Sep 18 17:36:12 EDT 2019
+* Date Generated: Thu Jun 10 11:51:58 EDT 2021
* 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
*/
@@ -47,6 +47,12 @@ int SammyRMatrixParameters_getNumParticlePair(void * SammyRMatrixParameters_ptr)
void SammyRMatrixParameters_transferParticlePairData(void * SammyRMatrixParameters_ptr,SammyRMatrixParameters * data);
void* SammyRMatrixParameters_getChannel(void * SammyRMatrixParameters_ptr,SammyChannelInfo* info);
void SammyRMatrixParameters_addChannelData(void * SammyRMatrixParameters_ptr,SammyChannelInfo * info,endf::RMatChannelParams * channel);
+int SammyRMatrixParameters_getNumRext(void * SammyRMatrixParameters_ptr);
+void SammyRMatrixParameters_addRext(void * SammyRMatrixParameters_ptr,int * grp,int * chan);
+void* SammyRMatrixParameters_getRextInfo(void * SammyRMatrixParameters_ptr,int * index);
+void* SammyRMatrixParameters_getRext(void * SammyRMatrixParameters_ptr,SammyRExternalInfo * info);
+void* SammyRMatrixParameters_getRextInfoByGroup(void * SammyRMatrixParameters_ptr,int * grp,int * channel);
+bool SammyRMatrixParameters_hasRexInfo(void * SammyRMatrixParameters_ptr,int * grp,int * channel);
int SammyRMatrixParameters_orderByGroupAndEnergy(void * SammyRMatrixParameters_ptr);
int SammyRMatrixParameters_orderByEnergy(void * SammyRMatrixParameters_ptr);
void* SammyRMatrixParameters_initialize();
diff --git a/sammy/src/endf/interface/fortran/RMatResonanceParam_I.f90 b/sammy/src/endf/interface/fortran/RMatResonanceParam_I.f90
index 8dfa3c8c435bf77fb14e488f10d658eb5d643d07..5cc65210f561aa9d2aa1b512c8284ba995f0700c 100644
--- a/sammy/src/endf/interface/fortran/RMatResonanceParam_I.f90
+++ b/sammy/src/endf/interface/fortran/RMatResonanceParam_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: Mon Dec 17 09:52:53 EST 2018
+!! Date Generated: Wed Jun 09 12:46:14 EDT 2021
!! 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
!!/
@@ -61,6 +61,148 @@ subroutine f_RMatResonance_destroy(this) BIND(C,name="RMatResonance_destroy")
implicit none
type(C_PTR), value :: this;
end subroutine
+real(C_DOUBLE) function f_RExternalFunction_getConstantRext(RExternalFunction_ptr ) BIND(C,name="RExternalFunction_getConstantRext")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: RExternalFunction_ptr;
+end function
+real(C_DOUBLE) function f_RExternalFunction_getLinearRext(RExternalFunction_ptr ) BIND(C,name="RExternalFunction_getLinearRext")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: RExternalFunction_ptr;
+end function
+real(C_DOUBLE) function f_RExternalFunction_getQuadraticRext(RExternalFunction_ptr ) BIND(C,name="RExternalFunction_getQuadraticRext")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: RExternalFunction_ptr;
+end function
+real(C_DOUBLE) function f_RExternalFunction_getConstantCoeffLogTerm(RExternalFunction_ptr ) BIND(C,name="RExternalFunction_getConstantCoeffLogTerm")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: RExternalFunction_ptr;
+end function
+real(C_DOUBLE) function f_RExternalFunction_getLinearCoeffLogTerm(RExternalFunction_ptr ) BIND(C,name="RExternalFunction_getLinearCoeffLogTerm")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: RExternalFunction_ptr;
+end function
+real(C_DOUBLE) function f_RExternalFunction_getSingularityBelowErange(RExternalFunction_ptr ) BIND(C,name="RExternalFunction_getSingularityBelowErange")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: RExternalFunction_ptr;
+end function
+real(C_DOUBLE) function f_RExternalFunction_getSingularityAboveErange(RExternalFunction_ptr ) BIND(C,name="RExternalFunction_getSingularityAboveErange")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: RExternalFunction_ptr;
+end function
+real(C_DOUBLE) function f_RExternalFunction_getPoleStrength(RExternalFunction_ptr ) BIND(C,name="RExternalFunction_getPoleStrength")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: RExternalFunction_ptr;
+end function
+real(C_DOUBLE) function f_RExternalFunction_getAvgRadiationWidth(RExternalFunction_ptr ) BIND(C,name="RExternalFunction_getAvgRadiationWidth")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: RExternalFunction_ptr;
+end function
+type(C_PTR) function f_RExternalFunction_getRealTab1(RExternalFunction_ptr ) BIND(C,name="RExternalFunction_getRealTab1")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: RExternalFunction_ptr;
+end function
+type(C_PTR) function f_RExternalFunction_getImagTab1(RExternalFunction_ptr ) BIND(C,name="RExternalFunction_getImagTab1")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: RExternalFunction_ptr;
+end function
+subroutine f_RExternalFunction_setConstantRext(RExternalFunction_ptr, Rcon ) BIND(C,name="RExternalFunction_setConstantRext")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: RExternalFunction_ptr;
+ real(C_DOUBLE) :: Rcon;
+end subroutine
+subroutine f_RExternalFunction_setLinearRext(RExternalFunction_ptr, Rlin ) BIND(C,name="RExternalFunction_setLinearRext")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: RExternalFunction_ptr;
+ real(C_DOUBLE) :: Rlin;
+end subroutine
+subroutine f_RExternalFunction_setQuadraticRext(RExternalFunction_ptr, Rquad ) BIND(C,name="RExternalFunction_setQuadraticRext")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: RExternalFunction_ptr;
+ real(C_DOUBLE) :: Rquad;
+end subroutine
+subroutine f_RExternalFunction_setConstantCoeffLogTerm(RExternalFunction_ptr, scon ) BIND(C,name="RExternalFunction_setConstantCoeffLogTerm")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: RExternalFunction_ptr;
+ real(C_DOUBLE) :: scon;
+end subroutine
+subroutine f_RExternalFunction_setLinearCoeffLogTerm(RExternalFunction_ptr, slin ) BIND(C,name="RExternalFunction_setLinearCoeffLogTerm")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: RExternalFunction_ptr;
+ real(C_DOUBLE) :: slin;
+end subroutine
+subroutine f_RExternalFunction_setSingularityBelowErange(RExternalFunction_ptr, Edown ) BIND(C,name="RExternalFunction_setSingularityBelowErange")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: RExternalFunction_ptr;
+ real(C_DOUBLE) :: Edown;
+end subroutine
+subroutine f_RExternalFunction_setSingularityAboveErange(RExternalFunction_ptr, Eup ) BIND(C,name="RExternalFunction_setSingularityAboveErange")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: RExternalFunction_ptr;
+ real(C_DOUBLE) :: Eup;
+end subroutine
+subroutine f_RExternalFunction_setPoleStrength(RExternalFunction_ptr, ps ) BIND(C,name="RExternalFunction_setPoleStrength")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: RExternalFunction_ptr;
+ real(C_DOUBLE) :: ps;
+end subroutine
+subroutine f_RExternalFunction_setAvgRadiationWidth(RExternalFunction_ptr, avgGg ) BIND(C,name="RExternalFunction_setAvgRadiationWidth")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: RExternalFunction_ptr;
+ real(C_DOUBLE) :: avgGg;
+end subroutine
+integer(C_INT) function f_RExternalFunction_getFormat(RExternalFunction_ptr ) BIND(C,name="RExternalFunction_getFormat")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: RExternalFunction_ptr;
+end function
+subroutine f_RExternalFunction_setFormat(RExternalFunction_ptr, lbk ) BIND(C,name="RExternalFunction_setFormat")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: RExternalFunction_ptr;
+ integer(C_INT) :: lbk;
+end subroutine
+subroutine f_RExternalFunction_setRealTab1(RExternalFunction_ptr, tab1Val ) BIND(C,name="RExternalFunction_setRealTab1")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: RExternalFunction_ptr;
+ type(C_PTR), value :: tab1Val;
+end subroutine
+subroutine f_RExternalFunction_setImagTab1(RExternalFunction_ptr, tab1Val ) BIND(C,name="RExternalFunction_setImagTab1")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: RExternalFunction_ptr;
+ type(C_PTR), value :: tab1Val;
+end subroutine
+type(C_PTR) function f_RExternalFunction_initialize( )BIND(C,name="RExternalFunction_initialize")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR) :: RExternalFunction_ptr;
+end function
+subroutine f_RExternalFunction_destroy(this) BIND(C,name="RExternalFunction_destroy")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: this;
+end subroutine
type(C_PTR) function f_RMatChannelParams_initialize_DEFAULT( ppi )BIND(C,name="RMatChannelParams_initialize_DEFAULT")
use,intrinsic :: ISO_C_BINDING
implicit none
@@ -127,6 +269,11 @@ integer(C_INT) function f_RMatChannelParams_getPpi(RMatChannelParams_ptr ) BIND(
implicit none
type(C_PTR), value :: RMatChannelParams_ptr;
end function
+type(C_PTR) function f_RMatChannelParams_getRExternalFunc(RMatChannelParams_ptr ) BIND(C,name="RMatChannelParams_getRExternalFunc")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: RMatChannelParams_ptr;
+end function
type(C_PTR) function f_RMatChannelParams_initialize( )BIND(C,name="RMatChannelParams_initialize")
use,intrinsic :: ISO_C_BINDING
implicit none
@@ -188,6 +335,11 @@ type(C_PTR) function f_RMatSpinGroup_getChannel(RMatSpinGroup_ptr, nc ) BIND(C,n
type(C_PTR), value :: RMatSpinGroup_ptr;
integer(C_INT) :: nc;
end function
+logical(C_BOOL) function f_RMatSpinGroup_doesRExternalFunctionExist(RMatSpinGroup_ptr ) BIND(C,name="RMatSpinGroup_doesRExternalFunctionExist")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: RMatSpinGroup_ptr;
+end function
type(C_PTR) function f_RMatSpinGroup_initialize( )BIND(C,name="RMatSpinGroup_initialize")
use,intrinsic :: ISO_C_BINDING
implicit none
@@ -246,7 +398,7 @@ subroutine f_RMatParticlePair_setQ(RMatParticlePair_ptr, q ) BIND(C,name="RMatPa
type(C_PTR), value :: RMatParticlePair_ptr;
real(C_DOUBLE) :: q;
end subroutine
-integer(C_INT) function f_RMatParticlePair_getPnt(RMatParticlePair_ptr) BIND(C,name="RMatParticlePair_getPnt")
+integer(C_INT) function f_RMatParticlePair_getPnt(RMatParticlePair_ptr ) BIND(C,name="RMatParticlePair_getPnt")
use,intrinsic :: ISO_C_BINDING
implicit none
type(C_PTR), value :: RMatParticlePair_ptr;
@@ -292,7 +444,7 @@ subroutine f_RMatParticlePair_setPa(RMatParticlePair_ptr, index,pa ) BIND(C,name
implicit none
type(C_PTR), value :: RMatParticlePair_ptr;
integer(C_INT) :: index;
- integer(C_INT) :: pa;
+ real(C_DOUBLE) :: pa;
end subroutine
logical(C_BOOL) function f_RMatParticlePair_getCalcShift(RMatParticlePair_ptr ) BIND(C,name="RMatParticlePair_getCalcShift")
use,intrinsic :: ISO_C_BINDING
diff --git a/sammy/src/endf/interface/fortran/RMatResonanceParam_M.f90 b/sammy/src/endf/interface/fortran/RMatResonanceParam_M.f90
index c9f938d2e705ea79af73c3a370717751fa16673d..f36833e490ae3f343fb64e56e00c0f6b50f9c6c2 100644
--- a/sammy/src/endf/interface/fortran/RMatResonanceParam_M.f90
+++ b/sammy/src/endf/interface/fortran/RMatResonanceParam_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: Mon Dec 17 09:52:53 EST 2018
+!! Date Generated: Wed Jun 09 12:46:14 EDT 2021
!! 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
!!/
@@ -10,7 +10,7 @@ module RMatResonanceParam_M
use, intrinsic :: ISO_C_BINDING
use RMatResonanceParam_I
use ResonanceCovariance_M
-use EnumerationData_M
+use Tab1_M
type RMatResonance
type(C_PTR) :: instance_ptr=C_NULL_PTR
contains
@@ -24,6 +24,38 @@ type RMatResonance
procedure, pass(this) :: initialize => RMatResonance_initialize
procedure, pass(this) :: destroy => RMatResonance_destroy
end type RMatResonance
+type RExternalFunction
+ type(C_PTR) :: instance_ptr=C_NULL_PTR
+ contains
+ procedure, pass(this) :: getConstantRext => RExternalFunction_getConstantRext
+ procedure, pass(this) :: getLinearRext => RExternalFunction_getLinearRext
+ procedure, pass(this) :: getQuadraticRext => RExternalFunction_getQuadraticRext
+ procedure, pass(this) :: getConstantCoeffLogTerm => RExternalFunction_getConstantCoeffLogTerm
+ procedure, pass(this) :: getLinearCoeffLogTerm => RExternalFunction_getLinearCoeffLogTerm
+ procedure, pass(this) :: getSingularityBelowErange => RExternalFunction_getSingularityBelowErange
+ procedure, pass(this) :: getSingularityAboveErange => RExternalFunction_getSingularityAboveErange
+ procedure, pass(this) :: getPoleStrength => RExternalFunction_getPoleStrength
+ procedure, pass(this) :: getAvgRadiationWidth => RExternalFunction_getAvgRadiationWidth
+ procedure, pass(this) :: getRealTab1 => RExternalFunction_getRealTab1
+ procedure, pass(this) :: getImagTab1 => RExternalFunction_getImagTab1
+ procedure, pass(this) :: setConstantRext => RExternalFunction_setConstantRext
+ procedure, pass(this) :: setLinearRext => RExternalFunction_setLinearRext
+ procedure, pass(this) :: setQuadraticRext => RExternalFunction_setQuadraticRext
+ procedure, pass(this) :: setConstantCoeffLogTerm => RExternalFunction_setConstantCoeffLogTerm
+ procedure, pass(this) :: setLinearCoeffLogTerm => RExternalFunction_setLinearCoeffLogTerm
+ procedure, pass(this) :: setSingularityBelowErange => RExternalFunction_setSingularityBelowErange
+ procedure, pass(this) :: setSingularityAboveErange => RExternalFunction_setSingularityAboveErange
+ procedure, pass(this) :: setPoleStrength => RExternalFunction_setPoleStrength
+ procedure, pass(this) :: setAvgRadiationWidth => RExternalFunction_setAvgRadiationWidth
+ procedure, pass(this) :: getFormat => RExternalFunction_getFormat
+ procedure, pass(this) :: setFormat => RExternalFunction_setFormat
+ procedure, pass(this) :: setRealTab1 => RExternalFunction_setRealTab1
+ procedure, pass(this) :: setImagTab1 => RExternalFunction_setImagTab1
+ procedure, pass(this) :: setSammyValue => RExternalFunction_setSammyValue
+ procedure, pass(this) :: getSammyValue => RExternalFunction_getSammyValue
+ procedure, pass(this) :: initialize => RExternalFunction_initialize
+ procedure, pass(this) :: destroy => RExternalFunction_destroy
+end type RExternalFunction
type RMatChannelParams
type(C_PTR) :: instance_ptr=C_NULL_PTR
contains
@@ -39,6 +71,7 @@ type RMatChannelParams
procedure, pass(this) :: getApt => RMatChannelParams_getApt
procedure, pass(this) :: setApt => RMatChannelParams_setApt
procedure, pass(this) :: getPpi => RMatChannelParams_getPpi
+ procedure, pass(this) :: getRExternalFunc => RMatChannelParams_getRExternalFunc
procedure, pass(this) :: initialize => RMatChannelParams_initialize
procedure, pass(this) :: destroy => RMatChannelParams_destroy
end type RMatChannelParams
@@ -54,6 +87,7 @@ type RMatSpinGroup
procedure, pass(this) :: addResonance => RMatSpinGroup_addResonance
procedure, pass(this) :: getResonance => RMatSpinGroup_getResonance
procedure, pass(this) :: getChannel => RMatSpinGroup_getChannel
+ procedure, pass(this) :: doesRExternalFunctionExist => RMatSpinGroup_doesRExternalFunctionExist
procedure, pass(this) :: initialize => RMatSpinGroup_initialize
procedure, pass(this) :: destroy => RMatSpinGroup_destroy
end type RMatSpinGroup
@@ -157,6 +191,206 @@ subroutine RMatResonance_destroy(this)
call f_RMatResonance_destroy(this%instance_ptr)
this%instance_ptr = C_NULL_PTR
end subroutine
+function RExternalFunction_getConstantRext(this) result(result2Return)
+ implicit none
+ class(RExternalFunction)::this
+ real(C_DOUBLE):: result2Return
+ result2Return=f_RExternalFunction_getConstantRext(this%instance_ptr)
+end function
+function RExternalFunction_getLinearRext(this) result(result2Return)
+ implicit none
+ class(RExternalFunction)::this
+ real(C_DOUBLE):: result2Return
+ result2Return=f_RExternalFunction_getLinearRext(this%instance_ptr)
+end function
+function RExternalFunction_getQuadraticRext(this) result(result2Return)
+ implicit none
+ class(RExternalFunction)::this
+ real(C_DOUBLE):: result2Return
+ result2Return=f_RExternalFunction_getQuadraticRext(this%instance_ptr)
+end function
+function RExternalFunction_getConstantCoeffLogTerm(this) result(result2Return)
+ implicit none
+ class(RExternalFunction)::this
+ real(C_DOUBLE):: result2Return
+ result2Return=f_RExternalFunction_getConstantCoeffLogTerm(this%instance_ptr)
+end function
+function RExternalFunction_getLinearCoeffLogTerm(this) result(result2Return)
+ implicit none
+ class(RExternalFunction)::this
+ real(C_DOUBLE):: result2Return
+ result2Return=f_RExternalFunction_getLinearCoeffLogTerm(this%instance_ptr)
+end function
+function RExternalFunction_getSingularityBelowErange(this) result(result2Return)
+ implicit none
+ class(RExternalFunction)::this
+ real(C_DOUBLE):: result2Return
+ result2Return=f_RExternalFunction_getSingularityBelowErange(this%instance_ptr)
+end function
+function RExternalFunction_getSingularityAboveErange(this) result(result2Return)
+ implicit none
+ class(RExternalFunction)::this
+ real(C_DOUBLE):: result2Return
+ result2Return=f_RExternalFunction_getSingularityAboveErange(this%instance_ptr)
+end function
+function RExternalFunction_getPoleStrength(this) result(result2Return)
+ implicit none
+ class(RExternalFunction)::this
+ real(C_DOUBLE):: result2Return
+ result2Return=f_RExternalFunction_getPoleStrength(this%instance_ptr)
+end function
+function RExternalFunction_getAvgRadiationWidth(this) result(result2Return)
+ implicit none
+ class(RExternalFunction)::this
+ real(C_DOUBLE):: result2Return
+ result2Return=f_RExternalFunction_getAvgRadiationWidth(this%instance_ptr)
+end function
+subroutine RExternalFunction_getRealTab1(this, object_ptr)
+ implicit none
+ class(RExternalFunction)::this
+ class(Tab1) :: object_ptr
+ object_ptr%instance_ptr = f_RExternalFunction_getRealTab1(this%instance_ptr)
+end subroutine
+subroutine RExternalFunction_getImagTab1(this, object_ptr)
+ implicit none
+ class(RExternalFunction)::this
+ class(Tab1) :: object_ptr
+ object_ptr%instance_ptr = f_RExternalFunction_getImagTab1(this%instance_ptr)
+end subroutine
+subroutine RExternalFunction_setConstantRext(this, Rcon)
+ implicit none
+ class(RExternalFunction)::this
+ real(C_DOUBLE)::Rcon
+ call f_RExternalFunction_setConstantRext(this%instance_ptr, Rcon)
+end subroutine
+subroutine RExternalFunction_setLinearRext(this, Rlin)
+ implicit none
+ class(RExternalFunction)::this
+ real(C_DOUBLE)::Rlin
+ call f_RExternalFunction_setLinearRext(this%instance_ptr, Rlin)
+end subroutine
+subroutine RExternalFunction_setQuadraticRext(this, Rquad)
+ implicit none
+ class(RExternalFunction)::this
+ real(C_DOUBLE)::Rquad
+ call f_RExternalFunction_setQuadraticRext(this%instance_ptr, Rquad)
+end subroutine
+subroutine RExternalFunction_setConstantCoeffLogTerm(this, scon)
+ implicit none
+ class(RExternalFunction)::this
+ real(C_DOUBLE)::scon
+ call f_RExternalFunction_setConstantCoeffLogTerm(this%instance_ptr, scon)
+end subroutine
+subroutine RExternalFunction_setLinearCoeffLogTerm(this, slin)
+ implicit none
+ class(RExternalFunction)::this
+ real(C_DOUBLE)::slin
+ call f_RExternalFunction_setLinearCoeffLogTerm(this%instance_ptr, slin)
+end subroutine
+subroutine RExternalFunction_setSingularityBelowErange(this, Edown)
+ implicit none
+ class(RExternalFunction)::this
+ real(C_DOUBLE)::Edown
+ call f_RExternalFunction_setSingularityBelowErange(this%instance_ptr, Edown)
+end subroutine
+subroutine RExternalFunction_setSingularityAboveErange(this, Eup)
+ implicit none
+ class(RExternalFunction)::this
+ real(C_DOUBLE)::Eup
+ call f_RExternalFunction_setSingularityAboveErange(this%instance_ptr, Eup)
+end subroutine
+subroutine RExternalFunction_setPoleStrength(this, ps)
+ implicit none
+ class(RExternalFunction)::this
+ real(C_DOUBLE)::ps
+ call f_RExternalFunction_setPoleStrength(this%instance_ptr, ps)
+end subroutine
+subroutine RExternalFunction_setAvgRadiationWidth(this, avgGg)
+ implicit none
+ class(RExternalFunction)::this
+ real(C_DOUBLE)::avgGg
+ call f_RExternalFunction_setAvgRadiationWidth(this%instance_ptr, avgGg)
+end subroutine
+function RExternalFunction_getFormat(this) result(result2Return)
+ implicit none
+ class(RExternalFunction)::this
+ integer(C_INT):: result2Return
+ result2Return=f_RExternalFunction_getFormat(this%instance_ptr)
+end function
+subroutine RExternalFunction_setFormat(this, lbk)
+ implicit none
+ class(RExternalFunction)::this
+ integer(C_INT)::lbk
+ call f_RExternalFunction_setFormat(this%instance_ptr, lbk)
+end subroutine
+subroutine RExternalFunction_setRealTab1(this, tab1Val)
+ implicit none
+ class(RExternalFunction)::this
+ class(Tab1)::tab1Val
+ call f_RExternalFunction_setRealTab1(this%instance_ptr, tab1Val%instance_ptr)
+end subroutine
+subroutine RExternalFunction_setImagTab1(this, tab1Val)
+ implicit none
+ class(RExternalFunction)::this
+ class(Tab1)::tab1Val
+ call f_RExternalFunction_setImagTab1(this%instance_ptr, tab1Val%instance_ptr)
+end subroutine
+subroutine RExternalFunction_setSammyValue(this, i, val)
+ implicit none
+ class(RExternalFunction)::this
+ integer::I
+ real(kind=8)::val
+ select case(i)
+ case(1)
+ call this%setSingularityBelowErange(val)
+ case(2)
+ call this%setSingularityAboveErange(val)
+ case(3)
+ call this%setConstantRext(val)
+ case(4)
+ call this%setLinearRext(val)
+ case(5)
+ call this%setConstantCoeffLogTerm(val)
+ case(6)
+ call this%setLinearCoeffLogTerm(val)
+ case(7)
+ call this%setQuadraticRext(val)
+ end select
+end subroutine
+real(kind=8) function RExternalFunction_getSammyValue(this, i) result(val)
+ implicit none
+ class(RExternalFunction)::this
+ integer::I
+
+ val = 0.0d0
+ select case(i)
+ case(1)
+ val = this%getSingularityBelowErange()
+ case(2)
+ val = this%getSingularityAboveErange()
+ case(3)
+ val = this%getConstantRext()
+ case(4)
+ val = this%getLinearRext()
+ case(5)
+ val = this%getConstantCoeffLogTerm()
+ case(6)
+ val = this%getLinearCoeffLogTerm()
+ case(7)
+ val = this%getQuadraticRext()
+ end select
+end function
+subroutine RExternalFunction_initialize(this)
+ implicit none
+ class(RExternalFunction) :: this
+ this%instance_ptr = f_RExternalFunction_initialize()
+end subroutine
+subroutine RExternalFunction_destroy(this)
+ implicit none
+ class(RExternalFunction) :: this
+ call f_RExternalFunction_destroy(this%instance_ptr)
+ this%instance_ptr = C_NULL_PTR
+end subroutine
subroutine RMatChannelParams_initialize_DEFAULT(this, ppi)
implicit none
class(RMatChannelParams) :: this
@@ -229,6 +463,12 @@ function RMatChannelParams_getPpi(this) result(result2Return)
integer(C_INT):: result2Return
result2Return=f_RMatChannelParams_getPpi(this%instance_ptr)
end function
+subroutine RMatChannelParams_getRExternalFunc(this, object_ptr)
+ implicit none
+ class(RMatChannelParams)::this
+ class(RExternalFunction) :: object_ptr
+ object_ptr%instance_ptr = f_RMatChannelParams_getRExternalFunc(this%instance_ptr)
+end subroutine
subroutine RMatChannelParams_initialize(this)
implicit none
class(RMatChannelParams) :: this
@@ -297,6 +537,12 @@ subroutine RMatSpinGroup_getChannel(this, object_ptr, nc)
integer(C_INT)::nc
object_ptr%instance_ptr = f_RMatSpinGroup_getChannel(this%instance_ptr, nc-1)
end subroutine
+function RMatSpinGroup_doesRExternalFunctionExist(this) result(result2Return)
+ implicit none
+ class(RMatSpinGroup)::this
+ logical(C_BOOL):: result2Return
+ result2Return=f_RMatSpinGroup_doesRExternalFunctionExist(this%instance_ptr)
+end function
subroutine RMatSpinGroup_initialize(this)
implicit none
class(RMatSpinGroup) :: this
@@ -338,7 +584,7 @@ function RMatParticlePair_getZa(this, index) result(result2Return)
implicit none
class(RMatParticlePair)::this
integer(C_INT)::index
- integer(C_INT)::result2Return
+ integer(C_INT):: result2Return
result2Return=f_RMatParticlePair_getZa(this%instance_ptr, index-1)
end function
subroutine RMatParticlePair_setZa(this, index, za)
@@ -362,8 +608,8 @@ subroutine RMatParticlePair_setQ(this, q)
end subroutine
function RMatParticlePair_getPnt(this) result(result2Return)
implicit none
- integer(C_INT)::result2Return
- class(RMatParticlePair)::this
+ class(RMatParticlePair)::this
+ integer(C_INT):: result2Return
result2Return=f_RMatParticlePair_getPnt(this%instance_ptr)
end function
subroutine RMatParticlePair_setPnt(this, p)
@@ -409,7 +655,7 @@ subroutine RMatParticlePair_setPa(this, index, pa)
implicit none
class(RMatParticlePair)::this
integer(C_INT)::index
- integer(C_INT)::pa
+ real(C_DOUBLE)::pa
call f_RMatParticlePair_setPa(this%instance_ptr, index-1,pa)
end subroutine
function RMatParticlePair_getCalcShift(this) result(result2Return)
diff --git a/sammy/src/endf/interface/fortran/SammyRExternalInfo_I.f90 b/sammy/src/endf/interface/fortran/SammyRExternalInfo_I.f90
new file mode 100644
index 0000000000000000000000000000000000000000..32d3a51b647e6a47efd9e361fe9e42a522a639b3
--- /dev/null
+++ b/sammy/src/endf/interface/fortran/SammyRExternalInfo_I.f90
@@ -0,0 +1,168 @@
+!>
+!! 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: Thu Jun 10 11:48:13 EDT 2021
+!! 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
+!!/
+module SammyRExternalInfo_I
+use, intrinsic :: ISO_C_BINDING
+interface
+integer(C_INT) function f_SammyRExternalInfo_getGrp(SammyRExternalInfo_ptr ) BIND(C,name="SammyRExternalInfo_getGrp")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRExternalInfo_ptr;
+end function
+integer(C_INT) function f_SammyRExternalInfo_getChannel(SammyRExternalInfo_ptr ) BIND(C,name="SammyRExternalInfo_getChannel")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRExternalInfo_ptr;
+end function
+integer(C_INT) function f_SammyRExternalInfo_getIflConstantRext(SammyRExternalInfo_ptr ) BIND(C,name="SammyRExternalInfo_getIflConstantRext")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRExternalInfo_ptr;
+end function
+integer(C_INT) function f_SammyRExternalInfo_getIflLinearRext(SammyRExternalInfo_ptr ) BIND(C,name="SammyRExternalInfo_getIflLinearRext")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRExternalInfo_ptr;
+end function
+integer(C_INT) function f_SammyRExternalInfo_getIflQuadraticRext(SammyRExternalInfo_ptr ) BIND(C,name="SammyRExternalInfo_getIflQuadraticRext")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRExternalInfo_ptr;
+end function
+integer(C_INT) function f_SammyRExternalInfo_getIflConstantCoeffLog(SammyRExternalInfo_ptr ) BIND(C,name="SammyRExternalInfo_getIflConstantCoeffLog")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRExternalInfo_ptr;
+end function
+integer(C_INT) function f_SammyRExternalInfo_getIflLinearCoeffLog(SammyRExternalInfo_ptr ) BIND(C,name="SammyRExternalInfo_getIflLinearCoeffLog")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRExternalInfo_ptr;
+end function
+integer(C_INT) function f_SammyRExternalInfo_getIflELowRange(SammyRExternalInfo_ptr ) BIND(C,name="SammyRExternalInfo_getIflELowRange")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRExternalInfo_ptr;
+end function
+integer(C_INT) function f_SammyRExternalInfo_getIflEUpRange(SammyRExternalInfo_ptr ) BIND(C,name="SammyRExternalInfo_getIflEUpRange")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRExternalInfo_ptr;
+end function
+integer(C_INT) function f_SammyRExternalInfo_getIflPoleStrength(SammyRExternalInfo_ptr ) BIND(C,name="SammyRExternalInfo_getIflPoleStrength")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRExternalInfo_ptr;
+end function
+integer(C_INT) function f_SammyRExternalInfo_getIflAvgRadWidth(SammyRExternalInfo_ptr ) BIND(C,name="SammyRExternalInfo_getIflAvgRadWidth")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRExternalInfo_ptr;
+end function
+integer(C_INT) function f_SammyRExternalInfo_getNrext(SammyRExternalInfo_ptr ) BIND(C,name="SammyRExternalInfo_getNrext")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRExternalInfo_ptr;
+end function
+subroutine f_SammyRExternalInfo_setGrp(SammyRExternalInfo_ptr, index ) BIND(C,name="SammyRExternalInfo_setGrp")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRExternalInfo_ptr;
+ integer(C_INT) :: index;
+end subroutine
+subroutine f_SammyRExternalInfo_setChannel(SammyRExternalInfo_ptr, index ) BIND(C,name="SammyRExternalInfo_setChannel")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRExternalInfo_ptr;
+ integer(C_INT) :: index;
+end subroutine
+subroutine f_SammyRExternalInfo_setIflConstantRext(SammyRExternalInfo_ptr, ifl ) BIND(C,name="SammyRExternalInfo_setIflConstantRext")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRExternalInfo_ptr;
+ integer(C_INT) :: ifl;
+end subroutine
+subroutine f_SammyRExternalInfo_setIflLinearRext(SammyRExternalInfo_ptr, ifl ) BIND(C,name="SammyRExternalInfo_setIflLinearRext")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRExternalInfo_ptr;
+ integer(C_INT) :: ifl;
+end subroutine
+subroutine f_SammyRExternalInfo_setIflQuadraticRext(SammyRExternalInfo_ptr, ifl ) BIND(C,name="SammyRExternalInfo_setIflQuadraticRext")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRExternalInfo_ptr;
+ integer(C_INT) :: ifl;
+end subroutine
+subroutine f_SammyRExternalInfo_setIflConstantCoeffLog(SammyRExternalInfo_ptr, ifl ) BIND(C,name="SammyRExternalInfo_setIflConstantCoeffLog")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRExternalInfo_ptr;
+ integer(C_INT) :: ifl;
+end subroutine
+subroutine f_SammyRExternalInfo_setIflLinearCoeffLog(SammyRExternalInfo_ptr, ifl ) BIND(C,name="SammyRExternalInfo_setIflLinearCoeffLog")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRExternalInfo_ptr;
+ integer(C_INT) :: ifl;
+end subroutine
+subroutine f_SammyRExternalInfo_setIflELowRange(SammyRExternalInfo_ptr, ifl ) BIND(C,name="SammyRExternalInfo_setIflELowRange")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRExternalInfo_ptr;
+ integer(C_INT) :: ifl;
+end subroutine
+subroutine f_SammyRExternalInfo_setIflEUpRange(SammyRExternalInfo_ptr, ifl ) BIND(C,name="SammyRExternalInfo_setIflEUpRange")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRExternalInfo_ptr;
+ integer(C_INT) :: ifl;
+end subroutine
+subroutine f_SammyRExternalInfo_setIflPoleStrength(SammyRExternalInfo_ptr, ifl ) BIND(C,name="SammyRExternalInfo_setIflPoleStrength")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRExternalInfo_ptr;
+ integer(C_INT) :: ifl;
+end subroutine
+subroutine f_SammyRExternalInfo_setIflAvgRadWidth(SammyRExternalInfo_ptr, ifl ) BIND(C,name="SammyRExternalInfo_setIflAvgRadWidth")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRExternalInfo_ptr;
+ integer(C_INT) :: ifl;
+end subroutine
+integer(C_INT) function f_SammyRExternalInfo_getIflSammyIndex(SammyRExternalInfo_ptr, i ) BIND(C,name="SammyRExternalInfo_getIflSammyIndex")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRExternalInfo_ptr;
+ integer(C_INT) :: i;
+end function
+subroutine f_SammyRExternalInfo_setIflSammyIndex(SammyRExternalInfo_ptr, i,ifl ) BIND(C,name="SammyRExternalInfo_setIflSammyIndex")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRExternalInfo_ptr;
+ integer(C_INT) :: i;
+ integer(C_INT) :: ifl;
+end subroutine
+subroutine f_SammyRExternalInfo_setNrext(SammyRExternalInfo_ptr, ifl ) BIND(C,name="SammyRExternalInfo_setNrext")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRExternalInfo_ptr;
+ integer(C_INT) :: ifl;
+end subroutine
+type(C_PTR) function f_SammyRExternalInfo_initialize( )BIND(C,name="SammyRExternalInfo_initialize")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR) :: SammyRExternalInfo_ptr;
+end function
+subroutine f_SammyRExternalInfo_destroy(this) BIND(C,name="SammyRExternalInfo_destroy")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: this;
+end subroutine
+end interface
+end module SammyRExternalInfo_I
diff --git a/sammy/src/endf/interface/fortran/SammyRExternalInfo_M.f90 b/sammy/src/endf/interface/fortran/SammyRExternalInfo_M.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ad6150ad977c194510ac73511faf46b6b9eebdef
--- /dev/null
+++ b/sammy/src/endf/interface/fortran/SammyRExternalInfo_M.f90
@@ -0,0 +1,214 @@
+!>
+!! 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: Thu Jun 10 11:48:13 EDT 2021
+!! 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
+!!/
+module SammyRExternalInfo_M
+use, intrinsic :: ISO_C_BINDING
+use SammyRExternalInfo_I
+type SammyRExternalInfo
+ type(C_PTR) :: instance_ptr=C_NULL_PTR
+ contains
+ procedure, pass(this) :: getGrp => SammyRExternalInfo_getGrp
+ procedure, pass(this) :: getChannel => SammyRExternalInfo_getChannel
+ procedure, pass(this) :: getIflConstantRext => SammyRExternalInfo_getIflConstantRext
+ procedure, pass(this) :: getIflLinearRext => SammyRExternalInfo_getIflLinearRext
+ procedure, pass(this) :: getIflQuadraticRext => SammyRExternalInfo_getIflQuadraticRext
+ procedure, pass(this) :: getIflConstantCoeffLog => SammyRExternalInfo_getIflConstantCoeffLog
+ procedure, pass(this) :: getIflLinearCoeffLog => SammyRExternalInfo_getIflLinearCoeffLog
+ procedure, pass(this) :: getIflELowRange => SammyRExternalInfo_getIflELowRange
+ procedure, pass(this) :: getIflEUpRange => SammyRExternalInfo_getIflEUpRange
+ procedure, pass(this) :: getIflPoleStrength => SammyRExternalInfo_getIflPoleStrength
+ procedure, pass(this) :: getIflAvgRadWidth => SammyRExternalInfo_getIflAvgRadWidth
+ procedure, pass(this) :: getNrext => SammyRExternalInfo_getNrext
+ procedure, pass(this) :: setGrp => SammyRExternalInfo_setGrp
+ procedure, pass(this) :: setChannel => SammyRExternalInfo_setChannel
+ procedure, pass(this) :: setIflConstantRext => SammyRExternalInfo_setIflConstantRext
+ procedure, pass(this) :: setIflLinearRext => SammyRExternalInfo_setIflLinearRext
+ procedure, pass(this) :: setIflQuadraticRext => SammyRExternalInfo_setIflQuadraticRext
+ procedure, pass(this) :: setIflConstantCoeffLog => SammyRExternalInfo_setIflConstantCoeffLog
+ procedure, pass(this) :: setIflLinearCoeffLog => SammyRExternalInfo_setIflLinearCoeffLog
+ procedure, pass(this) :: setIflELowRange => SammyRExternalInfo_setIflELowRange
+ procedure, pass(this) :: setIflEUpRange => SammyRExternalInfo_setIflEUpRange
+ procedure, pass(this) :: setIflPoleStrength => SammyRExternalInfo_setIflPoleStrength
+ procedure, pass(this) :: setIflAvgRadWidth => SammyRExternalInfo_setIflAvgRadWidth
+ procedure, pass(this) :: getIflSammyIndex => SammyRExternalInfo_getIflSammyIndex
+ procedure, pass(this) :: setIflSammyIndex => SammyRExternalInfo_setIflSammyIndex
+ procedure, pass(this) :: setNrext => SammyRExternalInfo_setNrext
+ procedure, pass(this) :: initialize => SammyRExternalInfo_initialize
+ procedure, pass(this) :: destroy => SammyRExternalInfo_destroy
+end type SammyRExternalInfo
+contains
+function SammyRExternalInfo_getGrp(this) result(result2Return)
+ implicit none
+ class(SammyRExternalInfo)::this
+ integer(C_INT):: result2Return
+ result2Return=f_SammyRExternalInfo_getGrp(this%instance_ptr) + 1
+end function
+function SammyRExternalInfo_getChannel(this) result(result2Return)
+ implicit none
+ class(SammyRExternalInfo)::this
+ integer(C_INT):: result2Return
+ result2Return=f_SammyRExternalInfo_getChannel(this%instance_ptr) + 1
+end function
+function SammyRExternalInfo_getIflConstantRext(this) result(result2Return)
+ implicit none
+ class(SammyRExternalInfo)::this
+ integer(C_INT):: result2Return
+ result2Return=f_SammyRExternalInfo_getIflConstantRext(this%instance_ptr)
+end function
+function SammyRExternalInfo_getIflLinearRext(this) result(result2Return)
+ implicit none
+ class(SammyRExternalInfo)::this
+ integer(C_INT):: result2Return
+ result2Return=f_SammyRExternalInfo_getIflLinearRext(this%instance_ptr)
+end function
+function SammyRExternalInfo_getIflQuadraticRext(this) result(result2Return)
+ implicit none
+ class(SammyRExternalInfo)::this
+ integer(C_INT):: result2Return
+ result2Return=f_SammyRExternalInfo_getIflQuadraticRext(this%instance_ptr)
+end function
+function SammyRExternalInfo_getIflConstantCoeffLog(this) result(result2Return)
+ implicit none
+ class(SammyRExternalInfo)::this
+ integer(C_INT):: result2Return
+ result2Return=f_SammyRExternalInfo_getIflConstantCoeffLog(this%instance_ptr)
+end function
+function SammyRExternalInfo_getIflLinearCoeffLog(this) result(result2Return)
+ implicit none
+ class(SammyRExternalInfo)::this
+ integer(C_INT):: result2Return
+ result2Return=f_SammyRExternalInfo_getIflLinearCoeffLog(this%instance_ptr)
+end function
+function SammyRExternalInfo_getIflELowRange(this) result(result2Return)
+ implicit none
+ class(SammyRExternalInfo)::this
+ integer(C_INT):: result2Return
+ result2Return=f_SammyRExternalInfo_getIflELowRange(this%instance_ptr)
+end function
+function SammyRExternalInfo_getIflEUpRange(this) result(result2Return)
+ implicit none
+ class(SammyRExternalInfo)::this
+ integer(C_INT):: result2Return
+ result2Return=f_SammyRExternalInfo_getIflEUpRange(this%instance_ptr)
+end function
+function SammyRExternalInfo_getIflPoleStrength(this) result(result2Return)
+ implicit none
+ class(SammyRExternalInfo)::this
+ integer(C_INT):: result2Return
+ result2Return=f_SammyRExternalInfo_getIflPoleStrength(this%instance_ptr)
+end function
+function SammyRExternalInfo_getIflAvgRadWidth(this) result(result2Return)
+ implicit none
+ class(SammyRExternalInfo)::this
+ integer(C_INT):: result2Return
+ result2Return=f_SammyRExternalInfo_getIflAvgRadWidth(this%instance_ptr)
+end function
+function SammyRExternalInfo_getNrext(this) result(result2Return)
+ implicit none
+ class(SammyRExternalInfo)::this
+ integer(C_INT):: result2Return
+ result2Return=f_SammyRExternalInfo_getNrext(this%instance_ptr)
+end function
+subroutine SammyRExternalInfo_setGrp(this, index)
+ implicit none
+ class(SammyRExternalInfo)::this
+ integer(C_INT)::index
+ call f_SammyRExternalInfo_setGrp(this%instance_ptr, index-1)
+end subroutine
+subroutine SammyRExternalInfo_setChannel(this, index)
+ implicit none
+ class(SammyRExternalInfo)::this
+ integer(C_INT)::index
+ call f_SammyRExternalInfo_setChannel(this%instance_ptr, index-1)
+end subroutine
+subroutine SammyRExternalInfo_setIflConstantRext(this, ifl)
+ implicit none
+ class(SammyRExternalInfo)::this
+ integer(C_INT)::ifl
+ call f_SammyRExternalInfo_setIflConstantRext(this%instance_ptr, ifl)
+end subroutine
+subroutine SammyRExternalInfo_setIflLinearRext(this, ifl)
+ implicit none
+ class(SammyRExternalInfo)::this
+ integer(C_INT)::ifl
+ call f_SammyRExternalInfo_setIflLinearRext(this%instance_ptr, ifl)
+end subroutine
+subroutine SammyRExternalInfo_setIflQuadraticRext(this, ifl)
+ implicit none
+ class(SammyRExternalInfo)::this
+ integer(C_INT)::ifl
+ call f_SammyRExternalInfo_setIflQuadraticRext(this%instance_ptr, ifl)
+end subroutine
+subroutine SammyRExternalInfo_setIflConstantCoeffLog(this, ifl)
+ implicit none
+ class(SammyRExternalInfo)::this
+ integer(C_INT)::ifl
+ call f_SammyRExternalInfo_setIflConstantCoeffLog(this%instance_ptr, ifl)
+end subroutine
+subroutine SammyRExternalInfo_setIflLinearCoeffLog(this, ifl)
+ implicit none
+ class(SammyRExternalInfo)::this
+ integer(C_INT)::ifl
+ call f_SammyRExternalInfo_setIflLinearCoeffLog(this%instance_ptr, ifl)
+end subroutine
+subroutine SammyRExternalInfo_setIflELowRange(this, ifl)
+ implicit none
+ class(SammyRExternalInfo)::this
+ integer(C_INT)::ifl
+ call f_SammyRExternalInfo_setIflELowRange(this%instance_ptr, ifl)
+end subroutine
+subroutine SammyRExternalInfo_setIflEUpRange(this, ifl)
+ implicit none
+ class(SammyRExternalInfo)::this
+ integer(C_INT)::ifl
+ call f_SammyRExternalInfo_setIflEUpRange(this%instance_ptr, ifl)
+end subroutine
+subroutine SammyRExternalInfo_setIflPoleStrength(this, ifl)
+ implicit none
+ class(SammyRExternalInfo)::this
+ integer(C_INT)::ifl
+ call f_SammyRExternalInfo_setIflPoleStrength(this%instance_ptr, ifl)
+end subroutine
+subroutine SammyRExternalInfo_setIflAvgRadWidth(this, ifl)
+ implicit none
+ class(SammyRExternalInfo)::this
+ integer(C_INT)::ifl
+ call f_SammyRExternalInfo_setIflAvgRadWidth(this%instance_ptr, ifl)
+end subroutine
+function SammyRExternalInfo_getIflSammyIndex(this, i) result(result2Return)
+ implicit none
+ class(SammyRExternalInfo)::this
+ integer(C_INT)::i
+ integer(C_INT):: result2Return
+ result2Return=f_SammyRExternalInfo_getIflSammyIndex(this%instance_ptr, i)
+end function
+subroutine SammyRExternalInfo_setIflSammyIndex(this, i, ifl)
+ implicit none
+ class(SammyRExternalInfo)::this
+ integer(C_INT)::i
+ integer(C_INT)::ifl
+ call f_SammyRExternalInfo_setIflSammyIndex(this%instance_ptr, i,ifl)
+end subroutine
+subroutine SammyRExternalInfo_setNrext(this, ifl)
+ implicit none
+ class(SammyRExternalInfo)::this
+ integer(C_INT)::ifl
+ call f_SammyRExternalInfo_setNrext(this%instance_ptr, ifl)
+end subroutine
+subroutine SammyRExternalInfo_initialize(this)
+ implicit none
+ class(SammyRExternalInfo) :: this
+ this%instance_ptr = f_SammyRExternalInfo_initialize()
+end subroutine
+subroutine SammyRExternalInfo_destroy(this)
+ implicit none
+ class(SammyRExternalInfo) :: this
+ call f_SammyRExternalInfo_destroy(this%instance_ptr)
+ this%instance_ptr = C_NULL_PTR
+end subroutine
+end module SammyRExternalInfo_M
diff --git a/sammy/src/endf/interface/fortran/SammyRMatrixParameters_I.f90 b/sammy/src/endf/interface/fortran/SammyRMatrixParameters_I.f90
index c6115eb06ead6f271d4f40a64eb011a44ed467dd..9ad4fb52028feb6604df6a53d61991e2c91a9382 100644
--- a/sammy/src/endf/interface/fortran/SammyRMatrixParameters_I.f90
+++ b/sammy/src/endf/interface/fortran/SammyRMatrixParameters_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: Wed Sep 18 17:36:12 EDT 2019
+!! Date Generated: Thu Jun 10 11:51:58 EDT 2021
!! 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
!!/
@@ -201,6 +201,44 @@ subroutine f_SammyRMatrixParameters_addChannelData(SammyRMatrixParameters_ptr, i
type(C_PTR), value :: info;
type(C_PTR), value :: channel;
end subroutine
+integer(C_INT) function f_SammyRMatrixParameters_getNumRext(SammyRMatrixParameters_ptr ) BIND(C,name="SammyRMatrixParameters_getNumRext")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRMatrixParameters_ptr;
+end function
+subroutine f_SammyRMatrixParameters_addRext(SammyRMatrixParameters_ptr, grp,chan ) BIND(C,name="SammyRMatrixParameters_addRext")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRMatrixParameters_ptr;
+ integer(C_INT) :: grp;
+ integer(C_INT) :: chan;
+end subroutine
+type(C_PTR) function f_SammyRMatrixParameters_getRextInfo(SammyRMatrixParameters_ptr, index ) BIND(C,name="SammyRMatrixParameters_getRextInfo")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRMatrixParameters_ptr;
+ integer(C_INT) :: index;
+end function
+type(C_PTR) function f_SammyRMatrixParameters_getRext(SammyRMatrixParameters_ptr, info ) BIND(C,name="SammyRMatrixParameters_getRext")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRMatrixParameters_ptr;
+ type(C_PTR), value :: info;
+end function
+type(C_PTR) function f_SammyRMatrixParameters_getRextInfoByGroup(SammyRMatrixParameters_ptr, grp,channel ) BIND(C,name="SammyRMatrixParameters_getRextInfoByGroup")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRMatrixParameters_ptr;
+ integer(C_INT) :: grp;
+ integer(C_INT) :: channel;
+end function
+logical(C_BOOL) function f_SammyRMatrixParameters_hasRexInfo(SammyRMatrixParameters_ptr, grp,channel ) BIND(C,name="SammyRMatrixParameters_hasRexInfo")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: SammyRMatrixParameters_ptr;
+ integer(C_INT) :: grp;
+ integer(C_INT) :: channel;
+end function
integer(C_INT) function f_SammyRMatrixParameters_orderByGroupAndEnergy(SammyRMatrixParameters_ptr ) BIND(C,name="SammyRMatrixParameters_orderByGroupAndEnergy")
use,intrinsic :: ISO_C_BINDING
implicit none
diff --git a/sammy/src/endf/interface/fortran/SammyRMatrixParameters_M.f90 b/sammy/src/endf/interface/fortran/SammyRMatrixParameters_M.f90
index b9c76b758ab87377495ee03c53066040b439d33b..db7c713548879796720434ad202929e9a811c7e9 100644
--- a/sammy/src/endf/interface/fortran/SammyRMatrixParameters_M.f90
+++ b/sammy/src/endf/interface/fortran/SammyRMatrixParameters_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: Wed Sep 18 17:36:12 EDT 2019
+!! Date Generated: Thu Jun 10 11:51:58 EDT 2021
!! 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
!!/
@@ -14,6 +14,7 @@ use RMatResonanceParam_M
use SammyChannelInfo_M
use SammyIsoInfo_M
use SammyParticlePairInfo_M
+use SammyRExternalInfo_M
use SammyResonanceInfo_M
use SammySpinGroupInfo_M
type SammyRMatrixParameters
@@ -50,6 +51,12 @@ type SammyRMatrixParameters
procedure, pass(this) :: transferParticlePairData => SammyRMatrixParameters_transferParticlePairData
procedure, pass(this) :: getChannel => SammyRMatrixParameters_getChannel
procedure, pass(this) :: addChannelData => SammyRMatrixParameters_addChannelData
+ procedure, pass(this) :: getNumRext => SammyRMatrixParameters_getNumRext
+ procedure, pass(this) :: addRext => SammyRMatrixParameters_addRext
+ procedure, pass(this) :: getRextInfo => SammyRMatrixParameters_getRextInfo
+ procedure, pass(this) :: getRext => SammyRMatrixParameters_getRext
+ procedure, pass(this) :: getRextInfoByGroup => SammyRMatrixParameters_getRextInfoByGroup
+ procedure, pass(this) :: hasRexInfo => SammyRMatrixParameters_hasRexInfo
procedure, pass(this) :: orderByGroupAndEnergy => SammyRMatrixParameters_orderByGroupAndEnergy
procedure, pass(this) :: orderByEnergy => SammyRMatrixParameters_orderByEnergy
procedure, pass(this) :: initialize => SammyRMatrixParameters_initialize
@@ -180,7 +187,7 @@ subroutine SammyRMatrixParameters_getResonanceInfoByInput(this, object_ptr, ig,
integer(C_INT)::ig
integer(C_INT)::current
object_ptr%instance_ptr = f_SammyRMatrixParameters_getResonanceInfoByInput(this%instance_ptr, ig-1,current)
- current = current + 1
+ current = current + 1
end subroutine
subroutine SammyRMatrixParameters_addResonanceData(this, info, res)
implicit none
@@ -236,7 +243,7 @@ subroutine SammyRMatrixParameters_getParticlePairInfoByInput(this, object_ptr, i
integer(C_INT)::ig
integer(C_INT)::current
object_ptr%instance_ptr = f_SammyRMatrixParameters_getParticlePairInfoByInput(this%instance_ptr, ig-1,current)
- current = current + 1
+ current = current + 1
end subroutine
subroutine SammyRMatrixParameters_getParticlePair(this, object_ptr, info)
implicit none
@@ -271,6 +278,49 @@ subroutine SammyRMatrixParameters_addChannelData(this, info, channel)
class(RMatChannelParams)::channel
call f_SammyRMatrixParameters_addChannelData(this%instance_ptr, info%instance_ptr,channel%instance_ptr)
end subroutine
+function SammyRMatrixParameters_getNumRext(this) result(result2Return)
+ implicit none
+ class(SammyRMatrixParameters)::this
+ integer(C_INT):: result2Return
+ result2Return=f_SammyRMatrixParameters_getNumRext(this%instance_ptr)
+end function
+subroutine SammyRMatrixParameters_addRext(this, grp, chan)
+ implicit none
+ class(SammyRMatrixParameters)::this
+ integer(C_INT)::grp
+ integer(C_INT)::chan
+ call f_SammyRMatrixParameters_addRext(this%instance_ptr, grp-1,chan-1)
+end subroutine
+subroutine SammyRMatrixParameters_getRextInfo(this, object_ptr, index)
+ implicit none
+ class(SammyRMatrixParameters)::this
+ class(SammyRExternalInfo) :: object_ptr
+ integer(C_INT)::index
+ object_ptr%instance_ptr = f_SammyRMatrixParameters_getRextInfo(this%instance_ptr, index-1)
+end subroutine
+subroutine SammyRMatrixParameters_getRext(this, object_ptr, info)
+ implicit none
+ class(SammyRMatrixParameters)::this
+ class(RExternalFunction) :: object_ptr
+ class(SammyRExternalInfo)::info
+ object_ptr%instance_ptr = f_SammyRMatrixParameters_getRext(this%instance_ptr, info%instance_ptr)
+end subroutine
+subroutine SammyRMatrixParameters_getRextInfoByGroup(this, object_ptr, grp, channel)
+ implicit none
+ class(SammyRMatrixParameters)::this
+ class(SammyRExternalInfo) :: object_ptr
+ integer(C_INT)::grp
+ integer(C_INT)::channel
+ object_ptr%instance_ptr = f_SammyRMatrixParameters_getRextInfoByGroup(this%instance_ptr, grp-1,channel-1)
+end subroutine
+function SammyRMatrixParameters_hasRexInfo(this, grp, channel) result(result2Return)
+ implicit none
+ class(SammyRMatrixParameters)::this
+ integer(C_INT)::grp
+ integer(C_INT)::channel
+ logical(C_BOOL):: result2Return
+ result2Return=f_SammyRMatrixParameters_hasRexInfo(this%instance_ptr, grp-1,channel-1)
+end function
function SammyRMatrixParameters_orderByGroupAndEnergy(this) result(result2Return)
implicit none
class(SammyRMatrixParameters)::this
diff --git a/sammy/src/fin/mfin0.f90 b/sammy/src/fin/mfin0.f90
index 04db845bc5ae03d80820be9fa79234e0852ddf3d..006c2e75b57fcab63bd970fe9563c0fecbf9ebeb 100644
--- a/sammy/src/fin/mfin0.f90
+++ b/sammy/src/fin/mfin0.f90
@@ -96,7 +96,7 @@ module fin
CALL Convrt ( A_Iprbrd , I_Iflbrd , A_Isiabn , &
A_Iechan , &
A_Idpiso , A_Idsiso , &
- A_Iprdet , I_Ifldet , A_Iprext , I_Iflext , &
+ A_Iprdet , I_Ifldet , &
A_Ipolar , A_Iprmsc , I_Iflmsc , I_Irdmsc , A_Iprpmc , &
I_Iflpmc , A_Iprorr , I_Iflorr , A_Iprrpi , I_Iflrpi , &
A_Iprudr , I_Ifludr , A_Iprnbk , I_Iflnbk , &
@@ -133,7 +133,6 @@ module fin
Nowrt = 1
CALL Wrcov (A_Iprbrd , I_Iflbrd , &
A_Iprdet , I_Ifldet , I_Iigrde , &
- A_Iprext , I_Iflext , &
A_Ipolar , I_Iflpol , &
A_Iprmsc , I_Iflmsc , I_Irdmsc , I_Ijkmsc , A_Ietaee , &
A_Iprpmc , I_Iflpmc , I_Isopmc , &
@@ -215,7 +214,6 @@ module fin
CALL Oldord ( A_Iprbrd , I_Iflbrd , A_Idebrd , &
I_Ifexcl , &
A_Iprdet , I_Ifldet , A_Idedet , I_Iigrde , &
- A_Iprext , I_Iflext , &
I_Iflpol , &
A_Iprmsc , I_Iflmsc , A_Idemsc , I_Irdmsc , I_Ijkmsc , &
A_Ietaee , &
diff --git a/sammy/src/fin/mfin1.f90 b/sammy/src/fin/mfin1.f90
index 4511720e27902bfe64bd4bbcdd96448f7c3d518d..a38e246da141df323e75f89c0a44aa0229dc0b03 100644
--- a/sammy/src/fin/mfin1.f90
+++ b/sammy/src/fin/mfin1.f90
@@ -62,7 +62,7 @@ module fin1
!
SUBROUTINE Convrt ( Parbrd, Iflbrd, Siabnd, &
Echan , Dopwid, Doswid, &
- Pardet, Ifldet, Parext, Iflext, &
+ Pardet, Ifldet, &
Polar , Parmsc, Iflmsc, Iradms, Parpmc, Iflpmc, &
Parorr, Iflorr, Parrpi, Iflrpi, Parudr, Ifludr, &
Parnbk, Iflnbk, Parbgf, Iflbgf, Pardtp, Ifldtp, Parusd, &
@@ -83,7 +83,6 @@ module fin1
Echan(Ntotc,*), &
Dopwid(*), Doswid(*), &
Pardet(*), Ifldet(*), &
- Parext(Nrext,Ntotc,*), Iflext(Nrext,Ntotc,*), &
Polar(2,*), Parmsc(*), Iflmsc(*), Iradms(*), &
Parpmc(4,*), Iflpmc(4,*), &
Parorr(*), Iflorr(*), Parrpi(*), Iflrpi(*), &
@@ -96,7 +95,6 @@ module fin1
! * Echan(Ntotc,Ngroup),
! * Dopwid(Numiso), Doswid(Numiso),
! * Pardet(Numdet), Ifldet(Numdet),
-! * Parext(Nrext,Ntotc,Ngroup), Iflext(Nrext,Ntotc,Ngroup),
! * Polar(2,Nres), Parmsc(Nummsc), Iflmsc(Nummsc), Iradms(Ngroup),
! * Parpmc(4,Numpmc), Iflpmc(4,Numpmc),
! * Parorr(Numorr), Iflorr(Numorr), Parrpi(Numrpi), Iflrpi(Numrpi),
@@ -126,9 +124,7 @@ module fin1
CALL Update (Ipar, Kpar, Nvp, Nfpres, Nvpres)
IF (Nvp.EQ.Nvpall) RETURN
!
- IF (Nvpext.NE.0) THEN
- CALL Cnvext(Parext, Iflext, Tempy, Ipar)
- END IF
+ CALL Cnvext(Tempy, Ipar)
CALL Update (Ipar, Kpar, Nvp, Nfpext, Nvpext)
IF (Nvp.EQ.Nvpall) RETURN
!
@@ -733,51 +729,50 @@ module fin1
!
! --------------------------------------------------------------
!
- SUBROUTINE Cnvext (Parext, Iflext, Tempy, Ipar)
+ SUBROUTINE Cnvext (Tempy, Ipar)
!
! *** PURPOSE --CONVERT FROM NEW U-PARAMETERS TO PHYSICAL
! *** R-EXTERNAL PARAMETERS
!
- use fixedi_m
- use ifwrit_m
- use fixedr_m
- use broad_common_m
- use EndfData_common_m
- use SammyResonanceInfo_M
+ use fixedi_m, only : Nrext, Ntotc
+ use EndfData_common_m, only : resparData, covData
use RMatResonanceParam_M
- IMPLICIT DOUBLE PRECISION (a-h,o-z)
+ use SammyRExternalInfo_M
+ IMPLICIT None
!
- type(SammySpinGroupInfo)::spinInfo
- DIMENSION Parext(Nrext,Ntotc,*), &
- Iflext(Nrext,Ntotc,*), Tempy(*)
-!
-! DIMENSION Parext(Nrext,Ntotc,Ngroup),
-! * Iflext(Nrext,Ntotc,Ngroup), Tempy(Nvpall)
-!
- DATA One /1.0d0/, Two /2.0d0/
-!
-!
- DO Igrp=1,resParData%getNumSpinGroups()
- call resparData%getSpinGroupInfo(spinInfo, Igrp)
- Ntotn = spinInfo%getNumChannels()
- DO I=1,Ntotn
- IF (Iflext(1,I,Igrp).GE.0) THEN
- DO J=1,Nrext
- IF (Iflext(J,I,Igrp).GT.0) THEN
- Ipar = Ipar + 1
- Keep = covData%getCovIndex(Ipar)
- IF (.not.covData%isPupedParameter(Ipar)) THEN
- val = covData%getUParamValue(Keep)
- Parext(J,I,Igrp) = val
- Tempy(Keep) = One
- IF (J.EQ.5) Parext(J,I,Igrp) = val**2
- IF (J.EQ.5) Tempy(Keep) = Two*val
- END IF
- END IF
- END DO
- END IF
- END DO
- END DO
+ type(SammyRExternalInfo)::rextInfo
+ type(RExternalFunction)::rext
+ real(kind=8)::Tempy(*)
+ integer::Ipar
+ real(kind=8)::Two, val
+ integer::Irext, I, Ifl, Keep
+!
+! DIMENSION Tempy(Nvpall)
+!
+ DATA Two /2.0d0/
+!
+!
+ DO Irext=1,resparData%getNumRext()
+ call resParData%getRextInfo(rextInfo, Irext)
+ call resparData%getRext(rext, rextInfo)
+ do I = 1, rextInfo%getNrext()
+ ifl = rextInfo%getIflSammyIndex(I)
+ if (ifl.le.0) cycle ! not adjusted
+ Ipar = Ipar + 1
+ if (covData%isPupedParameter(Ifl)) cycle ! don't need to update pup'ed parameters
+
+ Keep = covData%getCovIndex(Ifl)
+ val = covData%getUParamValue(Keep)
+
+ if (I.eq.5) then ! special treatment for ConstantCoeffLogTerm
+ val = val * val
+ Tempy(Keep) = Two*val
+ end if
+
+ call rext%setSammyValue(I, val)
+ end do
+ end do
+
RETURN
END
!
diff --git a/sammy/src/fin/mfin3.f90 b/sammy/src/fin/mfin3.f90
index b743f1c2b3acdabdc55d1602d6aa8be4c0f0fc02..42cd15c645f24f0d82e79a4c523ecbb66ff73918 100644
--- a/sammy/src/fin/mfin3.f90
+++ b/sammy/src/fin/mfin3.f90
@@ -6,7 +6,7 @@ module fin3
!
SUBROUTINE Oldord (Parbrd, Iflbrd, Delbrd, &
If_Excl, &
- Pardet, Ifldet, Deldet, Igrdet, Parext, Iflext, &
+ Pardet, Ifldet, Deldet, Igrdet, &
Iflpol, &
Parmsc, Iflmsc, Delmsc, Iradms, Ijkmsc, Etaeee, &
Parpmc, Iflpmc, Delpmc, Isopmc, &
@@ -37,8 +37,7 @@ module fin3
DIMENSION Parbrd(*), Iflbrd(*), Delbrd(*), &
If_Excl(Ntotc,*), &
Pardet(*), Ifldet(*), Deldet(*), Igrdet(*), &
- Parext(Nrext,Ntotc,*), Iflext(Nrext,Ntotc,*), &
- Iflpol(2,*), &
+ Iflpol(2,*), &
Parmsc(*), Iflmsc(*), Delmsc(*), Iradms(*), Ijkmsc(*), &
Etaeee(*), &
Parpmc(4,*), Iflpmc(4,*), Delpmc(4,*), Isopmc(*), &
@@ -58,7 +57,6 @@ module fin3
! * IFltru(Numrad),
! * Pardet(Numdet), Ifldet(Numdet),
! * Deldet(Numdet), Igrdet(Ngroup),
-! * Parext(Nrext,Ntotc,Ngroup), Iflext(Nrext,Ntotc,Ngroup),
! * Parmsc(Nummsc), Iflmsc(Nummsc), Delmsc(Nummsc), Iradms(Ngroup),
! * Ijkmsc(Nummsc), Etaeee(Mjetan),
! * Parpmc(4,Numpmc), Iflpmc(4,Numpmc), Delpmc(4,Numpmc),Isopmc(Numpmc),
@@ -100,7 +98,7 @@ module fin3
END IF
END IF
!
- IF (Numext.NE.0) CALL Ordext (Parext, Iflext)
+ CALL Ordext
!
CALL Ordrad
!
@@ -598,67 +596,77 @@ module fin3
!
! ----------------------------------------------------------------
!
- SUBROUTINE Ordext (Parext, Iflext)
- use fixedi_m
- use EndfData_common_m
- IMPLICIT DOUBLE PRECISION (a-h,o-z)
- DIMENSION Parext(Nrext,Ntotc,*), Iflext(Nrext,Ntotc,*)
-!
-! *** Write external R-function parameters
- IF (Nrext.EQ.5) WRITE (38,99995)
- IF (Nrext.EQ.7) WRITE (38,99994)
- IF (Nrext.EQ.5) WRITE (36,99995)
- IF (Nrext.EQ.7) WRITE (36,99994)
+ SUBROUTINE Ordext
+ use fixedi_m, only : Ifrel
+ use EndfData_common_m, only : resParData, covData
+ use RMatResonanceParam_M
+ use SammyRExternalInfo_M
+ use SammySpinGroupInfo_M
+ IMPLICIT None
+ type(SammyRExternalInfo)::rextInfo
+ type(SammySpinGroupInfo)::spinInfo
+ type(RExternalFunction)::rext
+ integer::Js(7)
+ real(kind=8)::Val(7)
+ integer::NrextO, N, I, J
+
+ if (resParData%getNumRext().eq.0) return ! no external R-matrix
+
+ ! assume all values for getNrext are the same
+ call resParData%getRextInfo(rextInfo, 1)
+ NrextO = rextInfo%getNrext()
+!
+! *** Write external R-function parameters
+ IF (NrextO.EQ.5) WRITE (38,99995)
+ IF (NrextO.EQ.7) WRITE (38,99994)
+ IF (NrextO.EQ.5) WRITE (36,99995)
+ IF (NrextO.EQ.7) WRITE (36,99994)
99995 FORMAT ('EXTERNAL R-FUNCTION PARAMETERS FOLLOW')
99994 FORMAT ('R-EXTERNAL PARAMETERS FOLLOW')
IF (Ifrel.EQ.1) THEN
- IF (Nrext.EQ.5) WRITE (40,99995)
- IF (Nrext.EQ.7) WRITE (40,99994)
+ IF (NrextO.EQ.5) WRITE (40,99995)
+ IF (NrextO.EQ.7) WRITE (40,99994)
END IF
- DO N=1,Ngroup
- DO I=1,Ntotc
- IF (Iflext(1,I,N).GE.0) THEN
- DO J=1,Nrext
- Ifl = Iflext(J,I,N)
- IF (Ifl.GT.0) THEN
- IF (covData%isPupedParameter(Iflext(J,I,N))) then
- Iflext(J,I,N) = 3
- else
- Iflext(J,I,N) = 1
- end if
- END IF
- END DO
- END IF
- END DO
- DO I=1,Ntotc
- IF (Iflext(1,I,N).GE.0 .AND. Nrext.EQ.7) THEN
- WRITE (38,99992) N, I, (Iflext(J,I,N),J=1,7), &
- (Parext(J,I,N),J=1,7)
- WRITE (36,99992) N, I, (Iflext(J,I,N),J=1,7), &
- (Parext(J,I,N),J=1,7)
- ELSE IF (Iflext(1,I,N).GE.0 .AND. Nrext.EQ.5) THEN
- WRITE (38,99993) N, I, (Parext(J,I,N),J=1,Nrext), &
- (Iflext(J,I,N),J=1,Nrext)
- WRITE (36,99993) N, I, (Parext(J,I,N),J=1,Nrext), &
- (Iflext(J,I,N),J=1,Nrext)
+
+ DO N=1,resParData%getNumSpinGroups()
+ call resParData%getSpinGroupInfo(spinInfo, N)
+
+ DO I=1,spinInfo%getNumChannels()
+ if (.not.resParData%hasRexInfo(N, I)) cycle
+ call resParData%getRextInfoByGroup(rextInfo, N, I)
+ call resParData%getRext(rext, rextInfo)
+ Js = 0
+ DO J = 1, rextInfo%getNrext()
+ Js(J) = rextInfo%getIflSammyIndex(J)
+ val(J) = rext%getSammyValue(J)
+ if (Js(J).gt.0) then
+ IF (covData%isPupedParameter(Js(J))) then
+ Js(J) = 3
+ else
+ Js(J) = 1
+ end if
+ end if
+ end do
+ IF (NrextO.EQ.7) THEN
+ WRITE (38,99992) N, I, (Js(J),J=1,7), (val(J),J=1,7)
+ WRITE (36,99992) N, I, (Js(J),J=1,7), (val(J),J=1,7)
+ If (Ifrel.EQ.1) THEN
+ WRITE (40,99992) N, I, (Js(J),J=1,7), (val(J),J=1,7)
+ end if
+ ELSE IF (NrextO.EQ.5) THEN
+ WRITE (38,99993) N, I, (val(J),J=1,5), (Js(J),J=1,5)
+ WRITE (36,99993) N, I, (val(J),J=1,5), (Js(J),J=1,5)
+ If (Ifrel.EQ.1) THEN
+ WRITE (40,99993) N, I, (val(J),J=1,5), (Js(J),J=1,5)
+ end if
END IF
99992 FORMAT (I2, 8I1, 7(1PE10.3))
99993 FORMAT (I3, I2, 5(1PE11.4), 5I2)
END DO
END DO
WRITE (38,99996)
-99996 FORMAT (' ')
- IF (Ifrel.EQ.1) THEN
- DO N=1,Ngroup
- DO I=1,Ntotc
- IF (Iflext(1,I,N).GE.0 .AND. Nrext.EQ.7) WRITE &
- (40,99992) N, I, (Iflext(J,I,N),J=1,7), &
- (Parext(J,I,N),J=1,7)
- IF (Iflext(1,I,N).GE.0 .AND. Nrext.EQ.5) WRITE &
- (40,99993) N, I, (Parext(J,I,N),J=1,Nrext), &
- (Iflext(J,I,N),J=1,Nrext)
- END DO
- END DO
+99996 FORMAT (' ')
+ IF (Ifrel.EQ.1) THEN
WRITE (40,99996)
END IF
RETURN
diff --git a/sammy/src/fin/mfin4.f90 b/sammy/src/fin/mfin4.f90
index e3a58a8a3403cbc4fd608bdb733fde7c537b8997..caece63563545e8c3681aff2bf1d5b4e44965783 100644
--- a/sammy/src/fin/mfin4.f90
+++ b/sammy/src/fin/mfin4.f90
@@ -60,7 +60,6 @@ module fin4
! write partial width data (indicated by last .false. in the argument list)
CALL Outpar ( Iftit, Nunit , A_Iprbrd , I_Iflbrd , &
A_Iprdet , I_Ifldet , I_Iigrde , &
- A_Iprext , I_Iflext , &
A_Ipolar , I_Iflpol , A_Iprmsc , I_Iflmsc , &
I_Irdmsc , I_Ijkmsc , A_Ietaee , &
A_Iprpmc , I_Iflpmc , I_Isopmc , A_Iprorr , &
@@ -77,7 +76,6 @@ module fin4
! write reduced width data (indicated by last .true. in the argument list)
CALL Outpar ( Iftit, Nunit , A_Iprbrd , I_Iflbrd , &
A_Iprdet , I_Ifldet , I_Iigrde , &
- A_Iprext , I_Iflext , &
A_Ipolar , I_Iflpol , A_Iprmsc , I_Iflmsc , &
I_Irdmsc , I_Ijkmsc , A_Ietaee , &
A_Iprpmc , I_Iflpmc , I_Isopmc , A_Iprorr , &
diff --git a/sammy/src/fin/mfin5.f90 b/sammy/src/fin/mfin5.f90
index ce21e8d37895a2d0408115cf2bf19a5eb1b42d79..917642433e4ea09b18f292ac55168d5674938f0d 100644
--- a/sammy/src/fin/mfin5.f90
+++ b/sammy/src/fin/mfin5.f90
@@ -438,7 +438,7 @@ module fin5
! --------------------------------------------------------------
!
SUBROUTINE Wrcov ( Parbrd, Iflbrd, &
- Pardet, Ifldet, Igrdet, Parext, Iflext, &
+ Pardet, Ifldet, Igrdet, &
Polar , Iflpol, Parmsc, Iflmsc, Iradms, Ijkmsc, Etaeee, &
Parpmc, Iflpmc, Isopmc, &
Parorr, Iflorr, Ecrnch, Endets, Sesese, Eseses, Sigdts, &
@@ -462,14 +462,14 @@ module fin5
use SammyResonanceInfo_M
use RMatResonanceParam_M
use ReadCovarianceInfo_m
- use ResonanceCovariance_M
+ use ResonanceCovariance_M
+ use SammyRExternalInfo_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
!
!
type(ResonanceCovariance)::physCov
DIMENSION Parbrd(*), Iflbrd(*), &
Pardet(*), Ifldet(*), Igrdet(*), &
- Parext(Nrext,Ntotc,*), Iflext(Nrext,Ntotc,*), &
Polar(2,*), Iflpol(2,*), &
Parmsc(*), Iflmsc(*), Iradms(*), Ijkmsc(*), Etaeee(*), &
Parpmc(4,*), Iflpmc(4,*), Isopmc(*), &
@@ -484,7 +484,6 @@ module fin5
!
! DIMENSION Parbrd(Numbrd), Iflbrd(Numbrd),
! * Pardet(Numdet), Ifldet(Numdet), Igrdet(Ngroup),
-! * Parext(Nrext,Ntotc,Ngroup), Iflext(Nrext,Ntotc,Ngroup),
! * Polar(2,Nres), Iflpol(2,Nres),
! * Parmsc(Nummsc), Iflmsc(Nummsc), Iradms(Ngroup), Ijkmsc(Nummsc),
! * Parpmc(4,Numpmc), Iflpmc(4,Numpmc), Isopmc(Numpmc),
@@ -504,10 +503,14 @@ module fin5
type(RMatResonance)::resonance
type(SammyResonanceInfo)::resInfo
type(ResonanceCovariance)::uCov
+ type(SammyRExternalInfo)::rextInfo
+ type(RExternalFunction)::rext
real(kind=8),allocatable,dimension(:,:)::resTmpData
integer,allocatable,dimension(:)::spinData
integer,allocatable,dimension(:,:)::fitFlags
integer,allocatable,dimension(:)::Ifliso
+ integer,allocatable,dimension(:,:,:)::Iflext
+ real(kind=8),allocatable,dimension(:,:,:)::Parext
integer::nradInfo
CHARACTER*3 Versn
@@ -682,13 +685,33 @@ module fin5
END IF
!
! *** WRITE R-EXTERNAL PARAMETERS
- IF (Numext.NE.0) THEN
+ if (resParData%getNumRext().gt.0) then
+ allocate(Iflext(Nrext, Ntotc, resParData%getNumSpinGroups()))
+ allocate(Parext(Nrext, Ntotc, resParData%getNumSpinGroups()))
+ Iflext = 0
+ Parext = 0.0d0
+ do I = 1, resParData%getNumSpinGroups()
+ do j = 1, Ntotc
+ if (.not.resParData%hasRexInfo(I, J)) then
+ Iflext(1, J, I) = -1
+ else
+ call resParData%getRextInfoByGroup(rextInfo, I, J)
+ call resParData%getRext(rext, rextInfo)
+ do K = 1, Nrext
+ Iflext(K, J, I) = rextInfo%getIflSammyIndex(k)
+ Parext(K, J, I) = rext%getSammyValue(K)
+ end do
+ end if
+ end do
+ end do
!# WRITE (Iu64) 'Iflext', Nrext, Ntotc*Ngroup
WRITE (Iu64) (((Iflext(K,J,I),K=1,Nrext),J=1,Ntotc),I=1, &
resParData%getNumSpinGroups() )
!# WRITE (Iu64) 'Parext', Nrext, Ntotc*Ngroup
WRITE (Iu64) (((Parext(K,J,I),K=1,Nrext),J=1,Ntotc),I=1, &
resParData%getNumSpinGroups() )
+ deallocate(Iflext)
+ deallocate(Parext)
END IF
!
! *** RADIUS PARAMETERS
diff --git a/sammy/src/inp/minp01.f b/sammy/src/inp/minp01.f
index ba82206208b93d3a1a231d72366c7780a51838c7..93a1572433c4dbb9be5adbc062eb438e7214e5cc 100644
--- a/sammy/src/inp/minp01.f
+++ b/sammy/src/inp/minp01.f
@@ -369,17 +369,6 @@ C *** six.one
END IF
C
C *** seven
- numparRpi = max(Medrpi + 25, 37)
- ! number of parameters of RPI resolution function
-C ! number was counted from use in function Gen_Rpi_E_Independent
- IF (Nrext.NE.0) THEN
- N = Nrext*Ngroup*Ntotc + numparRpi
- call make_A_Iprext(N)
- call make_I_Iflext(N)
- else ! account for rpi resolution function data
- call make_I_Iflext(numparRpi)
- END IF
-
C
IF (Nppair.EQ.0) Nppair = Ntotc*Ngroup
C gross overestimate, most likely
@@ -454,8 +443,11 @@ C
C *** five PAR
IF (Numrpi.NE.0) THEN
M = Numrpi
+ numparRpi = max(Medrpi + 25, 37)
+ ! number of parameters of RPI resolution function
+ ! number was counted from use in function Gen_Rpi_E_Independent
call make_A_Iprrpi(M)
- call make_I_Iflrpi(M)
+ call make_I_Iflrpi(max(M, numparRpi))
call make_A_Iderpi(M)
END IF
C
diff --git a/sammy/src/int/mint1.f b/sammy/src/int/mint1.f
index 30461a1dce68db491a47d22c441ac993b662047e..2b4f65d186ecd7084e23d0076a1a6d3afb8e36c1 100644
--- a/sammy/src/int/mint1.f
+++ b/sammy/src/int/mint1.f
@@ -162,6 +162,12 @@ C
C
DO Iso=1,calcData%getNumberIsotopes()
! update cross section (ipar=0) as well as derivatives
+ DO N=1,calcData%getNnnsig()
+ call calcData%reserveColumnsNs(Idat,N, Ndasig+Ndbsig+1) ! derivs + cross
+ end do
+ if (Ksindi.ne.0) then
+ call calcDataSelf%reserveColumns(Idat,Ndasig+Ndbsig+1) ! derivs + cross
+ end if
DO Ipar=0,Ndasig+Ndbsig
DO N=1,calcData%getNnnsig()
val1 = calcData%getDataNs(Iw1, N, Ipar, Iso)
diff --git a/sammy/src/ipq/FillFitData_m.f90 b/sammy/src/ipq/FillFitData_m.f90
index 427c8076f2581835a7373d361b9f99c0f7d4fc87..bd2082ae31c84e9e3331c7b55722e28ace2756c5 100644
--- a/sammy/src/ipq/FillFitData_m.f90
+++ b/sammy/src/ipq/FillFitData_m.f90
@@ -117,8 +117,9 @@ contains
! copy the user supplied deriviatives as needed
call grid%getImplicitDerivs(implGrid)
if (C_ASSOCIATED(implGrid%instance_ptr)) then
+ call resultData%reserve(implGrid%getLength(), nimplgiven+npars+derivStart)
do i = 1, implGrid%getLength()
- do j = 1, nimplgiven
+ do j = 1, nimplgiven
call resultData%addData(i, j + npars + derivStart, implGrid%getData(i,j))
end do
end do
diff --git a/sammy/src/mlb/mmlb0.f b/sammy/src/mlb/mmlb0.f
index 16a102b3fb8ac2460e296e84d0ce57a4ec3e178a..a719821fe84b15719f68374ce974dc65964aabdb 100644
--- a/sammy/src/mlb/mmlb0.f
+++ b/sammy/src/mlb/mmlb0.f
@@ -22,7 +22,7 @@ C
use rsl7_m
use xct_m
use mxct27_m
- use EndfData_common_m, only : covData, resParData
+ use EndfData_common_m, only : covData, resParData, radFitFlags
use AuxGridHelper_M, only : setAuxGridOffset, setAuxGridRowMax
IMPLICIT DOUBLE PRECISION (a-h,o-z)
real(kind=8),allocatable,dimension(:)::A_Idum
@@ -74,7 +74,7 @@ C
C ### one ###
Ks_Res = Ksolve
CALL Set_Kws_Xct
- call calcData%setUpList(resParData, Iq_Iso)
+ call calcData%setUpList(resParData, radFitFlags, Iq_Iso)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - <
C
C ### three ###
diff --git a/sammy/src/mxw/mmxw5.f b/sammy/src/mxw/mmxw5.f
index ef60f8946c223cb3eac7004cefdb44fbacb9c2fe..44bb8d3c28821fefa8bde6557131aa642f788ecc 100644
--- a/sammy/src/mxw/mmxw5.f
+++ b/sammy/src/mxw/mmxw5.f
@@ -170,6 +170,7 @@ C
Gj1 = Gj1 + Aa*val2
val = calcData%getDataNs(J, 1, 0, 1)
val = val + Aa*val2
+ call calcData%reserveColumnsNs(J, 1, Ndasig+Ndbsig+1) ! derivs + cross
call calcData%addDataNs(J, 1, 0, 1, val)
IF (Ksolve.NE.2) then
DO Ipar=1,Ndasig + Ndbsig
diff --git a/sammy/src/new/SetUExternalRMatrix_M.f90 b/sammy/src/new/SetUExternalRMatrix_M.f90
index 3c851e987b54c544848aca684da6317d6d77d879..dce1cbad02de632cd63a0a58bcf6c7c8d317b8c7 100644
--- a/sammy/src/new/SetUExternalRMatrix_M.f90
+++ b/sammy/src/new/SetUExternalRMatrix_M.f90
@@ -4,6 +4,7 @@ use SetCovData_M
use CovarianceData_M
use SammyRMatrixParameters_M
use SammySpinGroupInfo_M
+use SammyRExternalInfo_M
type , extends(SetCovData) :: SetUExternalRMatrix
contains
procedure, pass(this) :: setParameterNumber => SetUExternalRMatrix_setParameterNumber
@@ -15,75 +16,84 @@ type , extends(SetCovData) :: SetUExternalRMatrix
end type SetUExternalRMatrix
contains
-subroutine SetUExternalRMatrix_setParameterNumber(this, resData, covData, iflext, nrext, ntotc, nnrext, initial)
+subroutine SetUExternalRMatrix_setParameterNumber(this, resData, covData, initial)
implicit none
class(SetUExternalRMatrix)::this
class(SammyRMatrixParameters)::resData
class(CovarianceData)::covData
logical(C_BOOL)::initial
- integer::nrext, ntotc, nnrext
- integer::Iflext(Nnrext,Ntotc,*)
-
- integer::isp, ich, k
+ integer::isp, ich, k, flag
type(SammySpinGroupInfo)::spinInfo
+ type(SammyRExternalInfo)::rextInfo
+ if (resData%getNumRext().le.0) return ! nothing to do
+
do isp = 1, resData%getNumSpinGroups()
call resData%getSpinGroupInfo(spinInfo, isp)
do ich = 1, spinInfo%getNumChannels()
- if (nrext.eq.0) cycle
- if ( iflext(1, ich, isp).lt.0) cycle
- do k = 1, nrext
- call this%updateNumbers(iflext(k, ich, isp), covData, initial);
+ call resData%getRextInfoByGroup(rextInfo, isp, ich)
+
+ if (.not.resData%hasRexInfo(isp, ich)) cycle
+ call resData%getRextInfoByGroup(rextInfo, isp, ich)
+
+ do k = 1, rextInfo%getNrext()
+ flag = rextInfo%getIflSammyIndex(k)
+ call this%updateNumbers(flag, covData, initial)
end do
end do
end do
end subroutine SetUExternalRMatrix_setParameterNumber
-subroutine SetUExternalRMatrix_updateFitFlags(this, resData, covData, iflext, nrext, ntotc, nnrext, indexVar, indexPup)
+subroutine SetUExternalRMatrix_updateFitFlags(this, resData, covData, indexVar, indexPup)
implicit none
class(SetUExternalRMatrix)::this
class(SammyRMatrixParameters)::resData
class(CovarianceData)::covData
logical(C_BOOL)::initial
- integer::nrext, ntotc, nnrext, indexVar,indexPup
- integer::Iflext(Nnrext,Ntotc,nrext)
-
+ integer:: indexVar,indexPup
integer::isp, ich, k, flag, index
type(SammySpinGroupInfo)::spinInfo
+ type(SammyRExternalInfo)::rextInfo
+
+ if (resData%getNumRext().le.0) return ! nothing to do
index = this%getStartParam() - 1
do isp = 1, resData%getNumSpinGroups()
call resData%getSpinGroupInfo(spinInfo, isp)
do ich = 1, spinInfo%getNumChannels()
- if (nrext.eq.0) cycle
- if ( iflext(1, ich, isp).lt.0) cycle
- do k = 1, nrext
- flag = this%getUpdatedFitFlag(iflext(k, ich, isp), covData, index, indexVar, indexPup)
- iflext(k, ich, isp) = flag
+ if (.not.resData%hasRexInfo(isp, ich)) cycle
+ call resData%getRextInfoByGroup(rextInfo, isp, ich)
+
+ do k = 1, rextInfo%getNrext()
+ flag = rextInfo%getIflSammyIndex(k)
+ flag = this%getUpdatedFitFlag(flag, covData, index, indexVar, indexPup)
+ call rextInfo%setIflSammyIndex(k, flag)
end do
end do
end do
end subroutine SetUExternalRMatrix_updateFitFlags
-integer function SetUExternalRMatrix_getCovIndex(this, resData, covData, iflext, nnrext, nrext, ntotc, &
+integer function SetUExternalRMatrix_getCovIndex(this, resData, covData, &
nn, mm) result(irow)
implicit none
class(SetUExternalRMatrix)::this
class(SammyRMatrixParameters)::resData
class(CovarianceData)::covData
- integer::ntotc, nnrext, nrext, nn, mm
- integer::Iflext(Nnrext,Ntotc,*)
+ integer::nn, mm
- integer::igroup, flag, ich, mint
+ integer::igroup, flag, ich, mint, nrext
type(SammySpinGroupInfo)::spinInfo
+ type(SammyRExternalInfo)::rextInfo
irow = -1
- if (nrext.eq.0) return ! no external R matrix data
+ if (resData%getNumRext().eq.0) return ! no external R matrix data
+ call resData%getRextInfo(rextInfo, 1)
+ nrext = rextInfo%getNrext()
if (nn.le.1000.or.nn.ge.2000) return ! out of range for R-External (see SAMMY manual Table VI b2)
igroup = nn - 1000
@@ -95,7 +105,10 @@ integer function SetUExternalRMatrix_getCovIndex(this, resData, covData, iflext,
flag = -1
do ich = 1, spinInfo%getNumChannels()
if ( mint.le.nrext) then
- flag = iflext(mint, ich, igroup)
+ if (resData%hasRexInfo(igroup, ich)) then
+ call resData%getRextInfoByGroup(rextInfo, igroup, ich)
+ flag = rextInfo%getIflSammyIndex(mint)
+ end if
else
mint = mint - nrext
end if
@@ -106,39 +119,36 @@ integer function SetUExternalRMatrix_getCovIndex(this, resData, covData, iflext,
end if
end function SetUExternalRMatrix_getCovIndex
-subroutine SetUExternalRMatrix_setCovarianceDefault (this, resData, covData, factor, iflext, nnrext, nrext, ntotc)
+subroutine SetUExternalRMatrix_setCovarianceDefault (this, resData, covData, factor)
implicit none
class(SetUExternalRMatrix)::this
class(SammyRMatrixParameters)::resData
class(CovarianceData)::covData
- integer::ntotc, nnrext, nrext
real(kind=8)::factor
- integer::Iflext(Nnrext,Ntotc,*)
-
- integer::isp, ich, k, flag, irow
+ type(SammyRExternalInfo)::rextInfo
+ integer::irext, ich, k, flag, irow
real(kind=8)::val, have
- type(SammySpinGroupInfo)::spinInfo
+
type(ResonanceCovariance)::physCov
call covData%getCovariance(physCov)
- do isp = 1, resData%getNumSpinGroups()
- call resData%getSpinGroupInfo(spinInfo, isp)
+ do irext = 1, resData%getNumRext()
+ call resData%getRextInfo(rextInfo, irext)
+ do k = 1, rextInfo%getNrext()
+ flag = rextInfo%getIflSammyIndex(k)
+ if( flag.le.0) cycle
- do ich = 1, spinInfo%getNumChannels()
- do k = 1, nrext
- flag = iflext(k, ich, isp)
-
- if (k.ne.5) then ! setDefault converts to flag to covariance index
+
+ if (k.ne.5) then ! setDefault converts flag to covariance index
call this%setDefaultCovariance(covData, flag, factor)
- cycle
- end if
-
- if ( flag.gt.0) then ! varied parameter and k == 5
+ irow = covData%getCovIndex(flag)
+ have = physCov%getCovariance(irow,irow)
+ else ! different for k == 5 as value is treated differently
! covariance index
irow = covData%getCovIndex(flag)
! do not set if we already have a value
- have = physCov%getCovariance(irow,irow)
+ have = physCov%getCovariance(irow,irow)
if (have.ne.0.0d0) cycle
@@ -152,10 +162,8 @@ subroutine SetUExternalRMatrix_setCovarianceDefault (this, resData, covData, f
val = val * val
! set the diagonal
- call physCov%setCovariance(irow,irow, val)
+ call physCov%setCovariance(irow,irow, val)
end if
-
- end do
end do
end do
end subroutine SetUExternalRMatrix_setCovarianceDefault
diff --git a/sammy/src/new/SetUParameters_M.f90 b/sammy/src/new/SetUParameters_M.f90
index 366d3b73bf9d848324b8681c38e24fa0962ab022..8cdab8b7911be20eb3cc6319bb1796891609097c 100644
--- a/sammy/src/new/SetUParameters_M.f90
+++ b/sammy/src/new/SetUParameters_M.f90
@@ -110,16 +110,15 @@ end subroutine updateFitNumbers
!! in a different class
subroutine SetUParameters_countParameters(this, nVaried, nPuped, &
Iflbrd, Ifldet, &
- Iflext, Iflmsc, Iradms, Iflpmc, Iflorr, Iflrpi, &
- Iflnbk, Iflbgf, Ifldtp, Iflusd, Nnrext)
+ Iflmsc, Iradms, Iflpmc, Iflorr, Iflrpi, &
+ Iflnbk, Iflbgf, Ifldtp, Iflusd)
use fixedi_m
use EndfData_common_m
implicit none
class(SetUParameters) :: this
integer::nVaried, nPuped
- integer::Nnrext
integer::Iflbrd(*), &
- Ifldet(*), Iflext(Nnrext,Ntotc,*), &
+ Ifldet(*), &
Iflmsc(*), Iradms(*), Iflpmc(4,*), Iflorr(*), Iflrpi(*), &
Iflnbk(*), Iflbgf(*), Ifldtp(*), Iflusd(*)
@@ -130,7 +129,7 @@ subroutine SetUParameters_countParameters(this, nVaried, nPuped, &
nPuped = 0
call this%resData%setParameterNumber(resParData, covData, initial)
- call this%externalR%setParameterNumber(resParData, covData, iflext, nrext, ntotc, nnrext, initial)
+ call this%externalR%setParameterNumber(resParData, covData, initial)
call this%channelRadii%setParameterNumber(radFitFlags, covData, initial)
call this%abundances%setParameterNumber(resParData, covData, initial)
call this%detector%updateNumbersFromArray(covData, initial, Numdet, Ifldet(1:NumDet))
@@ -169,15 +168,14 @@ end subroutine SetUParameters_countParameters
!!
subroutine SetUParameters_updateFitParameters(this, &
Iflbrd, Ifldet, &
- Iflext, Iflmsc, Iradms, Iflpmc, Iflorr, Iflrpi, &
- Iflnbk, Iflbgf, Ifldtp, Iflusd, Nnrext)
+ Iflmsc, Iradms, Iflpmc, Iflorr, Iflrpi, &
+ Iflnbk, Iflbgf, Ifldtp, Iflusd)
use fixedi_m
use EndfData_common_m
implicit none
class(SetUParameters) :: this
- integer::Nnrext
integer::Iflbrd(*), &
- Ifldet(*), Iflext(Nnrext,Ntotc,*), &
+ Ifldet(*), &
Iflmsc(*), Iradms(*), Iflpmc(4,*), Iflorr(*), Iflrpi(*), &
Iflnbk(*), Iflbgf(*), Ifldtp(*), Iflusd(*)
@@ -187,8 +185,8 @@ subroutine SetUParameters_updateFitParameters(this, &
! count the total number of varied parameters
call this%countParameters(nVar, nPup, &
Iflbrd, Ifldet, &
- Iflext, Iflmsc, Iradms, Iflpmc, Iflorr, Iflrpi, &
- Iflnbk, Iflbgf, Ifldtp, Iflusd, Nnrext)
+ Iflmsc, Iradms, Iflpmc, Iflorr, Iflrpi, &
+ Iflnbk, Iflbgf, Ifldtp, Iflusd)
@@ -208,7 +206,7 @@ subroutine SetUParameters_updateFitParameters(this, &
! order matters here as that is how the parameters in the covariance
! will be accessed in SAMMY
call this%resData%updateFitFlags(resParData, covData, nVar, nPup)
- call this%externalR%updateFitFlags(resParData, covData, iflext, nrext, ntotc, nnrext, nVar, nPup)
+ call this%externalR%updateFitFlags(resParData, covData, nVar, nPup)
call this%channelRadii%updateFitFlags(covData, radFitFlags, nVar, nPup)
call this%abundances%updateFitFlags(resParData, covData, nVar, nPup)
call this%detector%updateFlagsFromArray(covData, Numdet, Ifldet(1:NumDet), nVar, nPup)
@@ -231,7 +229,6 @@ end subroutine SetUParameters_updateFitParameters
!!
!! @return the index into the covariance matrix
integer function SetUParameters_getExplicitCovIndex(this, &
- Iflext, Nnrext, &
Ifldet, &
Iflbrd, &
Iflmsc, &
@@ -247,8 +244,7 @@ integer function SetUParameters_getExplicitCovIndex(this, &
use EndfData_common_m
implicit none
class(SetUParameters) :: this
- integer::Nnrext
- integer::Iflext(Nnrext,Ntotc,*), Ifldet(*)
+ integer::Ifldet(*)
integer::Iflbrd(*), Iflmsc(*), Iflpmc(4,*),Iflorr(*), Iflrpi(*), Ifludr(*)
integer::Iflnbk(*), Iflbgf(*), Ifldtp(*)
integer::nn, mm
@@ -278,7 +274,7 @@ integer function SetUParameters_getExplicitCovIndex(this, &
! 6000+i 130000+i data-reduction parameters
irow = -1
if( irow.le.0) irow = this%resData%getCovIndex(resParData,covData,nn,mm)
- if (irow.le.0) irow = this%externalR%getCovIndex(resParData, covData, iflext, nnrext, nrext, ntotc, nn, mm)
+ if (irow.le.0) irow = this%externalR%getCovIndex(resParData, covData, nn, mm)
if (irow.le.0) irow = this%channelRadii%getCovIndex(covData, radFitFlags, nn, mm)
if (irow.le.0) irow = this%abundances%getCovIndexNn(resParData, covData, nn)
if (irow.le.0) irow = this%detector%getCovIndexFromNn(covData, ifldet(1:numdet), numdet, nn, 4000, allFalse)
@@ -303,7 +299,6 @@ end function SetUParameters_getExplicitCovIndex
!! by user input data.
!!
subroutine SetUParameters_setCovarianceExplicit(this, &
- Iflext, Nnrext, &
Ifldet, Iflbrd, &
Iflmsc, &
Iflpmc, &
@@ -318,8 +313,6 @@ subroutine SetUParameters_setCovarianceExplicit(this, &
use EndfData_common_m
implicit none
class(SetUParameters) :: this
- integer::Nnrext
- integer::Iflext(Nnrext,Ntotc,*)
integer::Ifldet(*), Iflbrd(*), Iflmsc(*), Iflpmc(4,*)
integer::Iflorr(*), Iflrpi(*), Ifludr(*)
integer::Iflnbk(*), Iflbgf(*), Ifldtp(*)
@@ -342,7 +335,6 @@ subroutine SetUParameters_setCovarianceExplicit(this, &
val = vv(i)* vv(i)
irow = this%getExplicitCovIndex( &
- Iflext, Nnrext, &
Ifldet, &
Iflbrd, &
Iflmsc, &
@@ -376,7 +368,6 @@ end subroutine SetUParameters_setCovarianceExplicit
!! by user input data.
!!
subroutine SetUParameters_setCovarianceOffExplicit(this, &
- Iflext, Nnrext, &
Ifldet, Iflbrd, &
Iflmsc, &
Iflpmc, &
@@ -391,8 +382,6 @@ subroutine SetUParameters_setCovarianceOffExplicit(this, &
use EndfData_common_m
implicit none
class(SetUParameters) :: this
- integer::Nnrext
- integer::Iflext(Nnrext,Ntotc,*)
integer::Ifldet(*), Iflbrd(*), Iflmsc(*), Iflpmc(4,*)
integer::Iflorr(*), Iflrpi(*), Ifludr(*)
integer::Iflnbk(*), Iflbgf(*), Ifldtp(*)
@@ -413,7 +402,6 @@ subroutine SetUParameters_setCovarianceOffExplicit(this, &
if ( ll(i).eq.0.or.ll(i).eq.mm(i)) cycle
irow = this%getExplicitCovIndex( &
- Iflext, Nnrext, &
Ifldet, &
Iflbrd, &
Iflmsc, &
@@ -428,7 +416,6 @@ subroutine SetUParameters_setCovarianceOffExplicit(this, &
if(irow.le.0) cycle
icol = this%getExplicitCovIndex( &
- Iflext, Nnrext, &
Ifldet, &
Iflbrd, &
Iflmsc, &
@@ -463,7 +450,6 @@ end subroutine SetUParameters_setCovarianceOffExplicit
!! this function as the last step to fill in missing covariance data
!!
subroutine SetUParameters_setCovarianceDefault(this, factor, &
- Iflext, Nnrext, &
Ifldet, Deldet, &
Iflbrd, delbrd, &
Iflmsc, delmsc, &
@@ -479,8 +465,7 @@ subroutine SetUParameters_setCovarianceDefault(this, factor, &
use constn_common_m
implicit none
class(SetUParameters) :: this
- integer::Nnrext
- integer::Iflext(Nnrext,Ntotc,*), Ifldet(*)
+ integer::Ifldet(*)
integer::Iflbrd(*), iflmsc(*), iflpmc(4,*)
integer::Iflorr(*), Iflrpi(*), Ifludr(*)
integer::Iflnbk(*), Iflbgf(*), Ifldtp(*)
@@ -496,7 +481,7 @@ subroutine SetUParameters_setCovarianceDefault(this, factor, &
call this%resData%setDefaultUncertainty(resParData, covData, factor, polarFission, pi)
- call this%externalR%setCovarianceDefault(resParData, covData, factor, iflext, nnrext, nrext, ntotc)
+ call this%externalR%setCovarianceDefault(resParData, covData, factor)
call this%channelRadii%setCovarianceDefault(covData, radFitFlags, factor)
call this%abundances%uncertUserDefault(resParData, covData, factor)
call this%detector%setDiagonalFromUserDefault(covData, Ifldet(1:Numdet), Numdet, deldet(1:Numdet), factor)
diff --git a/sammy/src/new/mnew0.f b/sammy/src/new/mnew0.f
index b20d717fef633978a518546ce1a10d8e648d530a..c95877b6222362aa37d4a6790869d86f57b1be78 100644
--- a/sammy/src/new/mnew0.f
+++ b/sammy/src/new/mnew0.f
@@ -58,7 +58,6 @@ C
IF (Kkrext.EQ.0) Kkrext = 1
CALL Betset ( A_Iprbrd , I_Iflbrd , A_Iechan ,
* A_Iprdet , I_Ifldet ,
- * A_Iprext , I_Iflext ,
* A_Ipolar , A_Iprmsc , I_Iflmsc , I_Irdmsc ,
* A_Iprpmc , I_Iflpmc , A_Iprorr , I_Iflorr ,
* A_Iprrpi , I_Iflrpi , A_Iprudr , I_Ifludr ,
@@ -167,7 +166,7 @@ C *** information provided by the user
C
CALL Rparfl ( I_Iflbrd , A_Idebrd , A_Ibcf ,
* A_Icf2 ,
- * I_Ifldet , A_Idedet , I_Iflext ,
+ * I_Ifldet , A_Idedet ,
* I_Iflmsc , A_Idemsc , I_Irdmsc , I_Iflpmc , A_Idepmc ,
* I_Iflorr , A_Ideorr , I_Iflrpi , A_Iderpi ,
* I_Ifludr , A_Ideudr ,
@@ -316,7 +315,6 @@ C *** Purpose -- Put quantum numbers into PARameter file
type(SammyRMatrixParameters)::relevantData
integer,allocatable,dimension(:)::I_Jflbrd
integer,allocatable,dimension(:)::I_Jfldet
- integer,allocatable,dimension(:)::I_Jflext
integer,allocatable,dimension(:)::I_Jflmsc
integer,allocatable,dimension(:)::I_Jflpmc
integer,allocatable,dimension(:)::I_Jflorr
@@ -340,11 +338,7 @@ C
call allocate_integer_data(I_Jflbrd, Numbrd)
IF (Numdet.GT.0) then
call allocate_integer_data(I_Jfldet, Numdet)
- end if
- N = Nrext*resParData%getNumSpinGroups()*Ntotc
- if (N.GT.0) then
- call allocate_integer_data(I_Jflext, N)
- end if
+ end if
if (Nummsc.GT.0) then
call allocate_integer_data(I_Jflmsc, Nummsc)
end if
@@ -374,11 +368,11 @@ C
call allocate_integer_data(I_Jflbag, Numbag)
end if
CALL Copy_Jfl (I_Iflbrd ,
- * I_Ifldet , I_Iflext , I_Iflmsc ,
+ * I_Ifldet , I_Iflmsc ,
* I_Iflpmc , I_Iflorr , I_Iflrpi , I_Ifludr , I_Iflnbk ,
* I_Iflbgf , I_Ifldtp , I_Iflbag ,
* I_Jflbrd ,
- * I_Jfldet , I_Jflext , I_flmsc ,
+ * I_Jfldet , I_flmsc ,
* I_Jflpmc , I_Jflorr , I_Jflrpi , I_Jfludr , I_Jflnbk ,
* I_Jflbgf , I_Jfldtp , I_Jflbag )
Ifrex = Ifrel
@@ -390,7 +384,6 @@ C write the par file but with the new fit values
CALL Oldord ( A_Iprbrd , I_Jflbrd , A_Idebrd ,
* I_Ifexcl ,
* A_Iprdet , I_Jfldet , A_Idedet , I_Iigrde ,
- * A_Iprext , I_Jflext ,
* I_Iflpol ,
* A_Iprmsc , I_Jflmsc , A_Idemsc , I_Irdmsc , I_Ijkmsc ,
* A_Ietaee ,
@@ -413,7 +406,6 @@ C and remove temporary arrays
Kquanx = 0
if (allocated(I_Jflbrd)) deallocate(I_Jflbrd)
if (allocated(I_Jfldet)) deallocate(I_Jfldet)
- if (allocated(I_Jflext)) deallocate(I_Jflext)
if (allocated(I_Jflmsc)) deallocate(I_Jflmsc)
if (allocated(I_Jflpmc)) deallocate(I_Jflpmc)
if (allocated(I_Jflorr)) deallocate(I_Jflorr)
diff --git a/sammy/src/new/mnew3.f90 b/sammy/src/new/mnew3.f90
index 511cfaadc02f1b8c19961c9fec07afdc5f70e456..811f68266fe191141647d280b8b01f6a321312b4 100644
--- a/sammy/src/new/mnew3.f90
+++ b/sammy/src/new/mnew3.f90
@@ -4,7 +4,6 @@
!C
SUBROUTINE Betset (Parbrd, Iflbrd, Echan , &
Pardet, Ifldet, &
- Parext, Iflext, &
Polar , Parmsc, Iflmsc, Iradms, Parpmc, Iflpmc, &
Parorr, Iflorr, Parrpi, Iflrpi, Parudr, Ifludr, Parnbk, Iflnbk, &
Parbgf, Iflbgf, Pardtp, Ifldtp, Zke , Zeta , &
@@ -19,13 +18,14 @@
use EndfData_common_m
use RMatResonanceParam_M
use SammyResonanceInfo_M
+ use SammyRExternalInfo_M
+
IMPLICIT DOUBLE PRECISION (a-h,o-z)
!C
EXTERNAL pf
DIMENSION Parbrd(*), Iflbrd(*), &
Echan(Ntotc,*), &
Pardet(*), Ifldet(*), &
- Parext(Kkrext,Ntotc,*), Iflext(Kkrext,Ntotc,*), &
Polar(2,*), Parmsc(*), Iflmsc(*), Iradms(*), &
Parpmc(4,*), Iflpmc(4,*), Parorr(*), Iflorr(*), &
Parrpi(*), Iflrpi(*), Parudr(*), Ifludr(*), &
@@ -35,12 +35,13 @@
type(SammyResonanceInfo)::resInfo
type(RMatResonance)::resonance
type(SammySpinGroupInfo)::spinInfo
+ type(SammyRExternalInfo)::rextInfo
+ type(RExternalFunction)::rext
integer::iflFlag
!C
!C DIMENSION Parbrd(Numbrd), Iflbrd(Numbrd),
!C * Echan(Ntotc,Ngroup),
-!C * Pardet(Numdet), Ifldet(Numdet), Parext(Nrext,Ntotc,Ngroup),
-!C * Iflext(Nrext,Ntotc,Ngroup),
+!C * Pardet(Numdet), Ifldet(Numdet),
!C * Parmsc(Nummsc), Iflmsc(Nummsc), Iradms(Ngroup),
!C * Parpmc(4,Numpmc), Iflpmc(4,Numpmc),
!C * Parorr(Numorr), Iflorr(Numorr), Parrpi(Numrpi), Iflrpi(Numrpi),
@@ -176,38 +177,25 @@
K1 = Nvpres
END IF
!C
- IF (Nfpext.GT.0) THEN
!C *** REXTERNAL PARAMETERS
- 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
- IF (Iflext(Kqq,J,Kgroup).GT.0) THEN
- Knpar = Knpar + 1
- IF (covData%isPupedParameter( &
- Iflext(Kqq,J,Kgroup))) THEN
- K3 = K3 + 1
- ELSE
- K1 = K1 + 1
- END IF
- IF (Kqq.NE.5) then
- UKnpar = Parext(Kqq,J,Kgroup)
- call covData%setUParamValue(Knpar, UKnpar)
- end if
- IF (Kqq.EQ.5) then
- UKnpar = &
- dSQRT(Parext(Kqq,J,Kgroup))
- call covData%setUParamValue(Knpar, UKnpar)
- end if
- END IF
- END DO
- END IF
- END DO
- END DO
- END IF
-
+ DO K=1,resParData%getNumRext()
+ call resParData%getRextInfo(rextInfo, K)
+ call resParData%getRext(rext, rextInfo)
+ DO Kqq=1,rextInfo%getNrext()
+ Ifl = rextInfo%getIflSammyIndex(Kqq)
+ IF (Ifl.GT.0) THEN
+ Knpar = Knpar + 1
+ IF (covData%isPupedParameter(Ifl)) THEN
+ K3 = K3 + 1
+ ELSE
+ K1 = K1 + 1
+ END IF
+ UKnpar = rext%getSammyValue(Kqq)
+ if (Kqq.eq.5) UKnpar = dSQRT(UKnpar)
+ call covData%setUParamValue(Knpar, UKnpar)
+ END IF
+ END DO
+ END DO
!C
!C
!C *** RADIUS PARAMETERS
@@ -666,26 +654,23 @@
!C ----------------------------------------------------------------
!C
SUBROUTINE Copy_Jfl (Iflbrd, Ifldet, &
- Iflext, Iflmsc, Iflpmc, Iflorr, Iflrpi, &
+ Iflmsc, Iflpmc, Iflorr, Iflrpi, &
Ifludr, Iflnbk, Iflbgf, Ifldtp, Iflbag, &
Jflbrd, Jfldet, &
- Jflext, Jflmsc, Jflpmc, Jflorr, Jflrpi, &
+ Jflmsc, Jflpmc, Jflorr, Jflrpi, &
Jfludr, Jflnbk, Jflbgf, Jfldtp, Jflbag)
use fixedi_m
use ifwrit_m
use broad_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
DIMENSION Iflbrd(*), Ifldet(*), &
- Iflext(Nrext,Ntotc,*), &
Iflmsc(*), Iflpmc(4,*), Iflorr(*), Iflrpi(*), Ifludr(*), &
Iflnbk(*), Iflbgf(*), Ifldtp(*), Iflbag(*)
DIMENSION Jflbrd(*), Jfldet(*), &
- Jflext(Nrext,Ntotc,*), &
Jflmsc(*), Jflpmc(4,*), Jflorr(*), Jflrpi(*), Jfludr(*), &
Jflnbk(*), Jflbgf(*), Jfldtp(*), Jflbag(*)
CALL Set_Equal (Iflbrd, Jflbrd, Numbrd)
CALL Set_Equal (Ifldet, Jfldet, Numdet)
- CALL Set_Equal (Iflext, Jflext, Nrext*Ngroup*Ntotc)
CALL Set_Equal (Iflmsc, Jflmsc, Nummsc)
CALL Set_Equal (Iflpmc, Jflpmc, Numpmc*4)
N = Numorr
diff --git a/sammy/src/new/mnew4.f b/sammy/src/new/mnew4.f
index 71a703362597e9e3f9e0585daac977ccc1757aad..e00f141ffbd8ca10e52beeeb0deaa18173b5f27c 100644
--- a/sammy/src/new/mnew4.f
+++ b/sammy/src/new/mnew4.f
@@ -4,7 +4,7 @@ C
C --------------------------------------------------------------
C
SUBROUTINE Rparfl (Iflbrd, Delbrd, Bcf, Cf2,
- * Ifldet, Deldet, Iflext,
+ * Ifldet, Deldet,
* Iflmsc, Delmsc, Iradms, Iflpmc, Delpmc,
* Iflorr, Delorr, Iflrpi, Delrpi, Ifludr, Deludr,
* Iflnbk, Delnbk, Iflbgf, Delbgf, Ifldtp, Deldtp,
@@ -40,7 +40,7 @@ C
* Prior(*)
integer::Iflbrd(*),
* Iflpmc(*),
- * IFldet(*), Iflext(Nrext,Ntotc,*),
+ * IFldet(*),
* Iflmsc(*), Iradms(*),
* Iflorr(*), Iflrpi(*),
* Ifludr(*), Iflnbk(*),
@@ -84,7 +84,6 @@ C
nnrext = nrext
if( nrext.eq.0) nnrext = 1 ! make sure we don't dimension by 0
call covarianceSetter%setCovarianceExplicit(
- * Iflext, Nnrext,
* Ifldet,
* Iflbrd, Iflmsc,
* Iflpmc,
@@ -106,7 +105,6 @@ C
! finally set default values if not set
call covarianceSetter%setCovarianceDefault(Fudge,
- * Iflext, Nnrext,
* Ifldet, DelDet,
* Iflbrd, Delbrd,
* Iflmsc, Delmsc,
@@ -144,7 +142,7 @@ C
C *** CHECK TO BE SURE ALL UNCERTAINTIES ARE GREATER THAN ZERO
Nzero = 0
DO I=1,covData%getNumTotalParam()
- cov = dSqrt(physCov%getCovariance(i,i))
+ cov = dSqrt(physCov%getCovariance(i,i))
IF (cov.EQ.0.0d0) THEN
Nzero = Nzero + 1
WRITE (6,99999) I
@@ -169,7 +167,6 @@ C are given as correlations
nnrext = nrext
if( nrext.eq.0) nnrext = 1 ! make sure we don't dimension by 0
call covarianceSetter%setCovarianceOffExplicit(
- * Iflext, Nnrext,
* Ifldet,
* Iflbrd, Iflmsc,
* Iflpmc,
@@ -200,7 +197,7 @@ C are given as correlations
! adjust the ones that are not
call OffresConv(.false.)
- call OffextConv (Iflext, .false.)
+ call OffextConv (.false.)
call OffmscConv(Iflmsc, .false.)
do i = 1, covData%getNumTotalParam()
diff --git a/sammy/src/new/mnew6.f b/sammy/src/new/mnew6.f
index 83a894fca25ac16144cb658af514363a3382086e..561c7047d3017f69e7e811f608ef43a0d182588f 100644
--- a/sammy/src/new/mnew6.f
+++ b/sammy/src/new/mnew6.f
@@ -100,19 +100,18 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE OffextConv (Iflext, onlyPups)
+ SUBROUTINE OffextConv (onlyPups)
C
use fixedi_m
use ifwrit_m
use kzznew_common_m
use EndfData_common_m
use ResonanceCovariance_M
- use SammySpinGroupInfo_M
+ use SammyRExternalInfo_M
IMPLICIT NONE
C
- Integer:: Iflext(Nrext,Ntotc,*)
type(ResonanceCovariance)::uCov
- type(SammySpinGroupInfo)::spinInfo
+ type(SammyRExternalInfo)::rextInfo
integer::n, m, ipar, jpar
logical::onlyPups
real(kind=8)::cov, A, uVal
@@ -120,12 +119,13 @@ C
call covData%getUCovariance(uCov)
- DO N=1, resParData%getNumSpinGroups()
- call resParData%getSpinGroupInfo(spinInfo, N)
-
- DO M = 1,spinInfo%getNumChannels()
- ! only need to change data for i==5
- ipar = Iflext(5,M,N)
+ DO N=1, resParData%getNumRext()
+ call resParData%getRextInfo(rextInfo, N)
+
+
+ ! only need to change data for i==5, since it is the only one
+ ! with u and p parameter differences
+ ipar = rextInfo%getIflSammyIndex(5)
if (ipar.le.0) cycle
! skip if we only want to convert pup'ed parameters
@@ -154,7 +154,7 @@ C
call uCov%setCovariance(ipar, jpar,cov)
end do
- END DO
+
end do
END
C
diff --git a/sammy/src/ntg/mntg4.f b/sammy/src/ntg/mntg4.f
index edd0039a97f766273c45ba9424bf966e2f6a7444..6548a90b89e2ecb51b0970712692a2baea462a9d 100644
--- a/sammy/src/ntg/mntg4.f
+++ b/sammy/src/ntg/mntg4.f
@@ -462,6 +462,8 @@ C
Aaold = Bb
val1 = val1 + Alfa*Aa
val2 = val2 + Etaa*Aa*Xnu
+ call calcData%reserveColumns(Kountr, Ndasig+Ndbsig+1) ! derivs + cross
+ call calcData%reserveColumns(Kountr+1, Ndasig+Ndbsig+1) ! derivs + cross
call calcData%addData(Kountr, 0, 1, val1)
call calcData%addData(Kountr+1, 0, 1, val2)
DO Ipar=1,Ndasig + Ndbsig
diff --git a/sammy/src/ntg/mntg5.f b/sammy/src/ntg/mntg5.f
index 75bb258a8c716f5a323b5502e3f448c09770a7fd..95c3b7ab4cef0edda50ee09479d4d1ac4fc6518d 100644
--- a/sammy/src/ntg/mntg5.f
+++ b/sammy/src/ntg/mntg5.f
@@ -110,6 +110,7 @@ C
W12 = calcData%getData(Kountr-12, 0, 1)
W13 = calcData%getData(Kountr-13, 0, 1)
val = (Xnu*W12-W13)*Tosp
+ call calcData%reserveColumns(Kountr, Ndasig+Ndbsig+1) ! derivs + cross
call calcData%addData(Kountr, 0, 1, val)
IF (Ndasig.NE.0) THEN
DO Ipar=1,Ndasig
@@ -137,9 +138,7 @@ C
Kountr = Kountr + 1
if (calcData%getLength().lt.Kountr) then
! update cross section (ipar=0) as well as derivatives
- do Ipar = 0, Ndasig + Ndbsig
- call calcData%setSharedDataVal(Kountr, Ipar, 0.0d0)
- end do
+ call calcData%reserveColumns(Kountr, Ndasig+Ndbsig+1) ! derivs + cross
end if
RETURN
END
@@ -164,6 +163,7 @@ C
IF (W16.EQ.0.0d0) return
W15 = calcData%getData(Kountr-15,0,1)
WK = W15 / W16
+ call calcData%reserveColumns(Kountr, Ndasig+Ndbsig+1) ! derivs + cross
call calcData%addData(Kountr,0,1,WK)
IF (Ndasig.GE.0) THEN
DO Ipar=1,Ndasig
@@ -178,9 +178,7 @@ C
Kountr = Kountr + 1
if (calcData%getLength().lt.Kountr) then
! update cross section (ipar=0) as well as derivatives
- do Ipar = 0, Ndasig + Ndbsig
- call calcData%setSharedDataVal(Kountr, Ipar, 0.0d0)
- end do
+ call calcData%reserveColumns(Kountr, Ndasig+Ndbsig+1) ! derivs + cross
end if
RETURN
END
diff --git a/sammy/src/ntg/mntg6.f b/sammy/src/ntg/mntg6.f
index 34f104271d7b52cd1a75d8f35836328abe1e8d68..ee34daae2ae01771273fa030ab20f9dfeab1b30f 100644
--- a/sammy/src/ntg/mntg6.f
+++ b/sammy/src/ntg/mntg6.f
@@ -152,6 +152,7 @@ C
C
IF (Nnnsig.EQ.1) THEN
val = calcData%getData(Kountr, 0, 1) + Const(2,Kountr)
+ call calcData%reserveColumns(Kountr, Ndasig+Ndbsig+1) ! derivs + cross
call calcData%addData(Kountr, 0, 1, val)
WRITE (21,10400) val
Kountr = Kountr + 1
@@ -165,16 +166,13 @@ C
ELSE
eIp0 = grid%getEnergy(JEquit , expData)
val = calcData%getData(Kountr, 0, 1) + Const(2,Kountr)
+ call calcData%reserveColumns(Kountr, Ndasig+Ndbsig+1) ! derivs + cross
call calcData%addData(Kountr, 0, 1, val)
WRITE (21,10200) val, eIp0, Equit
10200 FORMAT (' RIABS = Resonance integrl Absrptn =', 1P4G14.6)
Kountr = Kountr + 1
- if (calcData%getLength().lt.Kountr) then
- ! update cross section (ipar=0) as well as derivatives
- do Ipar = 0, Ndasig + Ndbsig
- call calcData%setSharedDataVal(Kountr, Ipar, 0.0d0)
- end do
- end if
+ ! update cross section (ipar=0) as well as derivatives
+ call calcData%reserveColumns(Kountr, Ndasig+Ndbsig+1) ! derivs + cross
val = calcData%getData(Kountr, 0, 1) + Const(2,Kountr)
call calcData%addData(Kountr, 0, 1, val)
WRITE (21,10300) val, eIp0, Equit
@@ -191,12 +189,8 @@ C
WRITE (21,10400) val, eIp0, Equit
10400 FORMAT (' RICAP = Resonance integrl Capture =', 1P4G14.6)
Kountr = Kountr + 1
- if (calcData%getLength().lt.Kountr) then
- ! update cross section (ipar=0) as well as derivatives
- do Ipar = 0, Ndasig + Ndbsig
- call calcData%setSharedDataVal(Kountr, Ipar, 0.0d0)
- end do
- end if
+ ! update cross section (ipar=0) as well as derivatives
+ call calcData%reserveColumns(Kountr, Ndasig+Ndbsig+1) ! derivs + cross
END IF
call grid%destroy()
RETURN
diff --git a/sammy/src/old/mold0.f b/sammy/src/old/mold0.f
index aa2229dc02052de9cbd6e82a3e92a57a512baeed..146c12124c1def24329c00a9579aac8f6d50edf4 100644
--- a/sammy/src/old/mold0.f
+++ b/sammy/src/old/mold0.f
@@ -57,7 +57,7 @@ C *** Sub routine Rdcov reads binary file containing information from
C *** previous run, including covariance matrices & parameter values
C *** Read the COVariance file, extract information
CALL Rdcov ( A_Iprbrd , I_Iflbrd ,
- * A_Iprdet , I_Ifldet , I_Iigrde , A_Iprext , I_Iflext ,
+ * A_Iprdet , I_Ifldet , I_Iigrde ,
* A_Ipolar , I_Iflpol ,
* A_Iprmsc , I_Iflmsc , I_Irdmsc , I_Ijkmsc , A_Ietaee ,
* A_Iprpmc , I_Iflpmc , I_Isopmc ,
@@ -78,7 +78,6 @@ C *** Note that call to Rdcovx should not need updating because obsolete
Nsingl = Nsingl*2
C *** Read the very old COVariance file, extract information
CALL Rdcovx ( A_Iprbrd , I_Iflbrd ,
- * A_Iprext , I_Iflext ,
* A_Ipolar , I_Iflpol , A_Iprmsc , I_Iflmsc , I_Irdmsc ,
* A_Iprpmc , I_Iflpmc , I_Isopmc ,
* A_Iprorr , I_Iflorr , A_Icrnch , A_Iedets ,
@@ -211,7 +210,6 @@ C
IF (Kkrext.EQ.0) Kkrext = 1
CALL Bet_Pup( A_Iprbrd , I_Iflbrd , A_Iechan ,
* A_Iprdet , I_Ifldet ,
- * A_Iprext , I_Iflext ,
* A_Ipolar , A_Iprmsc , I_Iflmsc , I_Irdmsc ,
* A_Iprpmc , I_Iflpmc , A_Iprorr , I_Iflorr ,
* A_Iprrpi , I_Iflrpi , A_Iprudr , I_Ifludr ,
@@ -220,7 +218,7 @@ C
* Kkrext)
CALL Rparfl_Pup (I_Iflbrd , A_Idebrd ,
* A_Ibcf , A_Icf2 ,
- * I_Ifldet , A_Idedet , I_Iflext ,
+ * I_Ifldet , A_Idedet ,
* A_Iprmsc , I_Iflmsc , A_Idemsc , I_Irdmsc ,
* I_Iflpmc , A_Idepmc ,
* I_Iflorr , A_Ideorr , I_Iflrpi , A_Iderpi ,
diff --git a/sammy/src/old/mold2.f b/sammy/src/old/mold2.f
index 3affb73b560e95cbb51a793b271079c4ae7e2c6c..545069ff41a57595083440d6a3429f33a64f17a4 100644
--- a/sammy/src/old/mold2.f
+++ b/sammy/src/old/mold2.f
@@ -98,7 +98,7 @@ C
C --------------------------------------------------------------
C
SUBROUTINE Rdcov ( Parbrd, Iflbrd,
- * Pardet, Ifldet, Igrdet, Parext, Iflext,
+ * Pardet, Ifldet, Igrdet,
* Polar , Iflpol, Parmsc, Iflmsc, Iradms, Ijkmsc, Etaeee,
* Parpmc, Iflpmc, Isopmc,
* Parorr, Iflorr, Ecrnch, Endets,
@@ -122,6 +122,7 @@ C
use SammyResonanceInfo_M
use RMatResonanceParam_M
use ReadCovarianceInfo_m
+ use SammyRExternalInfo_M
use AllocateFunctions_m
use, intrinsic :: ISO_C_BINDING
C this is not a common block, this contains functions
@@ -135,21 +136,25 @@ C this is not a common block, this contains functions
type(RMatSpinGroup)::rmatSpin
type(SammyResonanceInfo)::resInfo, resNew
type(RMatResonance)::resonance, resonanceNew
+ type(SammyRExternalInfo)::rextInfo
+ type(RExternalFunction)::rext
real(kind=8) :: Dum3
integer,allocatable,dimension(:)::keeper
real(kind=8),allocatable,dimension(:)::Dum1, Dum2
integer,allocatable,dimension(:)::Idiot1, Idiot2
integer,allocatable,dimension(:,:)::IGrpAssoc
+ integer,allocatable,dimension(:,:,:)::Iflext
+ real(kind=8),allocatable,dimension(:,:,:)::Parext
type(SammySpinGroupInfo)::spinInfo
logical(C_BOOL)::reduced, inc
logical(C_BOOL)::trueEqual
+ integer::irext
integer::iflagMatch
real(kind=8)::oldCrfn
C
C# CHARACTER*6 What
DIMENSION Parbrd(*), Iflbrd(*),
* Pardet(*), Ifldet(*), Igrdet(*),
- * Parext(Krext,Ntotc,*), Iflext(Krext,Ntotc,*),
* Polar(2,*), Iflpol(2,*),
* Parmsc(*), Iflmsc(*), Iradms(*), Ijkmsc(*), Etaeee(*),
* Parpmc(4,*), Iflpmc(4,*), Isopmc(*),
@@ -163,7 +168,6 @@ C# CHARACTER*6 What
C
C DIMENSION Parbrd(Numbrd), Iflbrd(Numbrd),
c * Pardet(Numdet), Ifldet(Numdet), Igrdet(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),
C * Parpmc(Numpmc), Iflpmc(Numpmc), Isopmc(Numpmc),
@@ -207,6 +211,8 @@ C *** RESONANCE PARAMETERS
C
C *** R-EXTERNAL PARAMETERS
IF (Numext.NE.0) THEN
+ allocate(Iflext(Nrext, Ntotc, Ngroup))
+ allocate(Parext(Nrext, Ntotc, Ngroup))
C# READ (Iu62) What, Num1, Num2
C # IF (What.NE.'Iflext') STOP '[What.NE.Iflext in mold2.f]'
@@ -216,6 +222,28 @@ C# READ (Iu62) What, Num1, Num2
C# IF (What.NE.'Parext') STOP '[What.NE.Parext in mold2.f]'
C# IF (Num1.NE.Nrext) STOP '[N.NE.Nrext in mold2.f]'
READ (Iu62) (((Parext(K,M,I),K=1,Nrext),M=1,Ntotc),I=1,Ngroup)
+
+ DO N=1,Ngroup
+ DO I=1,Ntotc
+ if (Iflext(1,I,N).eq.-1) cycle
+ if (resParData%hasRexInfo(N, I)) then
+ call resParData%getRextInfoByGroup(rextInfo, N, I)
+ else
+ call resparData%addRext(N, I)
+ irext = resParData%getNumRext()
+ call resParData%getRextInfo(rextInfo, irext)
+ call rextInfo%setNrext(Nrext)
+ end if
+ call resparData%getRext(rext, rextInfo)
+ Do Kqqq = 1, Nrext
+ call rext%setSammyValue(Kqqq, Parext(Kqqq,I,N))
+ call rextInfo%setIflSammyIndex(Kqqq,
+ * Iflext(Kqqq,I,N))
+ end do
+ END DO
+ END DO
+ deallocate(iflext)
+ deallocate(Parext)
END IF
C
C *** RADIUS PARAMETERS
diff --git a/sammy/src/old/mold5.f b/sammy/src/old/mold5.f
index 5052b2ccf1e15b8d910d2e920ee2e7d5be936efb..c2830063ac3f95ec0e4a596a8972d355605561e2 100644
--- a/sammy/src/old/mold5.f
+++ b/sammy/src/old/mold5.f
@@ -3,7 +3,7 @@ C
C --------------------------------------------------------------
C
SUBROUTINE Rdcovx ( Parbrd, Iflbrd,
- * Parext, Iflext,
+ * Iflext,
* Polar , Iflpol, Parmsc, Iflmsc, Iradms,
* Parpmc, Iflpmc, Isopmc,
* Parorr, Iflorr, Ecrnch, Endets,
@@ -35,6 +35,7 @@ C this is not a common block, this contains functions
use RMatResonanceParam_M
use ReadCovarianceInfo_m
use AllocateFunctions_m
+ use SammyRExternalInfo_M
use, intrinsic :: ISO_C_BINDING
IMPLICIT DOUBLE PRECISION (a-h,o-z)
@@ -43,7 +44,6 @@ C this is not a common block, this contains functions
real(kind=8) :: dum1
C
DIMENSION Parbrd(*), Iflbrd(*),
- * Parext(Krext,Ntotc,*), Iflext(Krext,Ntotc,*),
* Polar(2,*), Iflpol(2,*), Parmsc(*), Iflmsc(*), Iradms(*),
* Parpmc(4,*), Iflpmc(4,*), Isopmc(*),
* Parorr(*), Iflorr(*), Ecrnch(*), Endets(*), Sesese(*),
@@ -56,12 +56,16 @@ C
type(SammySpinGroupInfo)::spinInfo
type(SammyResonanceInfo)::resInfo, resNew
type(RMatResonance)::resonance, resonanceNew
+ type(SammyRExternalInfo)::rextInfo
+ type(RExternalFunction)::rext
logical(C_BOOL)::reduced, inc
logical(C_BOOL)::trueEqual
integer,allocatable,dimension(:)::Iflags
integer,allocatable,dimension(:,:)::IGrpAssoc
+ integer,allocatable,dimension(:,:,:)::Iflext
integer::iflagMatch
real(kind=8)::oldCrfn
+ integer::irext
iflagMatch = radFitFlags%matchFitFlag()
C
@@ -97,17 +101,36 @@ C *** isotopic abundances etc.
C
C *** R-EXTERNAL PARAMETERS
IF (Numext.NE.0) THEN
+ allocate(Iflext(Nrext, Ntotc, Ngroup))
READ (Iu62) (((Iflext(K,M,I),K=1,Nrext),M=1,Ntotc),I=1,Ngroup)
READ (Iu62) (Single(J),J=1,Nrext*Ntotc*Ngroup)
+
J = 0
- DO I=1,Ngroup
- DO M=1,Ntotc
- DO K=1,Nrext
- J = J + 1
- Parext(K,M,I) = DBLE(Single(J))
- END DO
+ DO N=1,Ngroup
+ DO I=1,Ntotc
+ if (Iflext(1,I,N).eq.-1) then
+ J = J + Nrext
+ cycle
+ end if
+
+ if (resParData%hasRexInfo(N, I)) then
+ call resParData%getRextInfoByGroup(rextInfo, N, I)
+ else
+ call resparData%addRext(N, I)
+ irext = resParData%getNumRext()
+ call resParData%getRextInfo(rextInfo, irext)
+ call rextInfo%setNrext(Nrext)
+ end if
+ call resparData%getRext(rext, rextInfo)
+ Do Kqqq = 1, Nrext
+ J = J + 1
+ call rext%setSammyValue(Kqqq, DBLE(Single(J)))
+ call rextInfo%setIflSammyIndex(Kqqq,
+ * Iflext(Kqqq,I,N))
+ end do
END DO
END DO
+ deallocate(Iflext)
END IF
C
C
diff --git a/sammy/src/old/mold8.f b/sammy/src/old/mold8.f
index 386f089d636e56738fdfba3ecd8da7132212d5cd..b6d8b6e1564783c92111372a09013d9e7310887d 100644
--- a/sammy/src/old/mold8.f
+++ b/sammy/src/old/mold8.f
@@ -3,7 +3,7 @@ C
C --------------------------------------------------------------
C
SUBROUTINE Rparfl_Pup (Iflbrd, Delbrd,Bcf, Cf2,
- * Ifldet, Deldet, Iflext,
+ * Ifldet, Deldet,
* Parmsc, Iflmsc, Delmsc, Iradms, Iflpmc, Delpmc,
* Iflorr, Delorr, Iflrpi, Delrpi, Ifludr, Deludr,
* Iflnbk, Delnbk, Iflbgf, Delbgf, Ifldtp, Deldtp,
@@ -27,7 +27,7 @@ C
type(ResonanceCovariance)::physCov, uCov
logical(C_BOOL)::haveUParam
DIMENSION Iflbrd(*), Delbrd(*),Bcf(*), Cf2(*),
- * IFldet(*), Deldet(*), Iflext(Nrext,Ntotc,*),
+ * IFldet(*), Deldet(*),
* Iflmsc(*), Delmsc(*), Iradms(*), Iflpmc(4,*), Delpmc(4,*),
* Iflorr(*), Delorr(*), Iflrpi(*), Delrpi(*),
* Ifludr(*), Deludr(*), Iflnbk(*), Delnbk(*),
@@ -39,7 +39,6 @@ C
C DIMENSION Iflbrd(Numbrd), Bcf(Ncf), Cf2(Ncf),
C * Ifleff(Numrad), Deleff(Numrad), Ifltru(Numrad), Deltru(Numrad),
C * IFldet(Numdet), Deldet(Numdet),
-C * Iflext(Nrext,Ntotc,Ngroup),
C * Iflmsc(Nummsc), Delmsc(Nummsc), Iradms(Ngroup),
C * Iflpmc(4,Numpmc), Delpmc(4,Numpmc),
C * Iflorr(Numorr), Delorr(Numorr), Iflrpi(Numrpi), Delrpi(Numrpi),
@@ -59,8 +58,7 @@ C
call covarianceSetter%initialize()
haveUParam = .true.
call covarianceSetter%setHaveUParam(haveUParam)
- call covarianceSetter%setCovarianceExplicit(
- * Iflext, Nnrext,
+ call covarianceSetter%setCovarianceExplicit(
* IflDet,
* Iflbrd, Iflmsc,
* Iflpmc,
@@ -76,7 +74,6 @@ C
* nprior, iprior, jprior, prior,
* Bcf, Cf2, fudge)
call covarianceSetter%setCovarianceDefault(Fudge,
- * Iflext, Nnrext,
* Ifldet, deldet,
* Iflbrd, delbrd,
* Iflmsc, delmsc,
@@ -92,8 +89,7 @@ C
! set from explicit user input
nnrext = nrext
if( nrext.eq.0) nnrext = 1 ! make sure we don't dimension by 0
- call covarianceSetter%setCovarianceOffExplicit(
- * Iflext, Nnrext,
+ call covarianceSetter%setCovarianceOffExplicit(
* Ifldet,
* Iflbrd, Iflmsc,
* Iflpmc,
@@ -125,7 +121,7 @@ C
! adjust the ones that are not
call OffresConv(.true.)
- call OffextConv (Iflext, .true.)
+ call OffextConv (.true.)
call OffmscConv(Iflmsc, .true.)
RETURN
diff --git a/sammy/src/old/mold9.f b/sammy/src/old/mold9.f
index f7dfdebaae2a5a63df1b7f756bc644f30a68fa38..b7b684a3f812efe005c12d0869bb4c6ceb246467 100644
--- a/sammy/src/old/mold9.f
+++ b/sammy/src/old/mold9.f
@@ -9,7 +9,6 @@ C --------------------------------------------------------------
C
SUBROUTINE Bet_Pup (Parbrd, Iflbrd, Echan ,
* Pardet, Ifldet,
- * Parext, Iflext,
* Polar , Parmsc, Iflmsc, Iradms, Parpmc, Iflpmc, Parorr,
* Iflorr, Parrpi, Iflrpi, Parudr, Ifludr, Parnbk, Iflnbk, Parbgf,
* Iflbgf, Pardtp, Ifldtp, Kkrext)
@@ -24,13 +23,14 @@ C
use SammyResonanceInfo_M
use SammySpinGroupInfo_M
use RMatResonanceParam_M
+ use SammyRExternalInfo_M
+
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
EXTERNAL pf
DIMENSION Parbrd(*), Iflbrd(*),
* Echan(Ntotc,*),
* Pardet(*), Ifldet(*),
- * Parext(Kkrext,Ntotc,*), Iflext(Kkrext,Ntotc,*),
* Polar(2,*), Parmsc(*), Iflmsc(*), Iradms(*),
* Parpmc(4,*), Iflpmc(4,*), Parorr(*), Iflorr(*),
* Parrpi(*), Iflrpi(*), Parudr(*), Ifludr(*),
@@ -39,6 +39,8 @@ C
C
type(SammyResonanceInfo)::resInfo
type(SammySpinGroupInfo)::spinInfo
+ type(SammyRExternalInfo)::rextInfo
+ type(RExternalFunction)::rext
type(RMatResonance)::resonance
DATA Zero /0.0d0/, Halfth /5.d-4/
C
@@ -114,32 +116,22 @@ C *** First -- resonance parameters
END DO
END IF
C
- IF (Nfpext.GT.0) THEN
C *** R_external parameters
- DO Kgroup=1,Ngroup
- call resparData%getSpinGroupInfo(spinInfo, Kgroup)
- Mmaxc = spinInfo%getNumChannels()
- DO J=1,Mmaxc
- IF (Iflext(1,J,Kgroup).GE.0) THEN
- DO Kqq=1,Nrext
- IF (Iflext(Kqq,J,Kgroup).GT.0) THEN
- Knpar = Knpar + 1
- ifl = Iflext(Kqq,J,Kgroup)
- keep = covData%getCovIndex(Ifl)
- IF (covData%isPupedParameter(ifl)) THEN
- K3 = K3 + 1
- IF (Kqq.NE.5) Upup =
- * Parext(Kqq,J,Kgroup)
- IF (Kqq.EQ.5) Upup =
- * dSQRT(Parext(Kqq,J,Kgroup))
- call covData%setUParamValue(keep,Upup)
- END IF
- END IF
- END DO
- END IF
- END DO
- END DO
- END IF
+ Do K = 1, resParData%getNumRext()
+ call resparData%getRextInfo(rextInfo, K)
+ call resParData%getRext(rext, rextInfo)
+ do J = 1, rextInfo%getNrext()
+ ifl = rextInfo%getIflSammyIndex(J)
+ if (Ifl.le.0) cycle
+ Knpar = Knpar + 1
+ if (.not.covData%isPupedParameter(ifl)) cycle
+ K3 = K3 + 1
+ Upup = rext%getSammyValue(J)
+ if(J.eq.5) Upup = dSqrt(Upup)
+ Keep = covData%getCovIndex(Ifl)
+ call covData%setUParamValue(keep,Upup)
+ end do
+ END DO
C
C
C *** Radius parameters
diff --git a/sammy/src/par/mpar0.f90 b/sammy/src/par/mpar0.f90
index 9d0380e9f2fc78b8c53d9c3d73ecb832e44fccf7..63610c67371c4858ee0202f463b7a866c3b40edf 100644
--- a/sammy/src/par/mpar0.f90
+++ b/sammy/src/par/mpar0.f90
@@ -100,7 +100,6 @@ module par_m
CALL Parfil ( A_Iprbrd , I_Iflbrd , A_Isiabn , &
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 , &
A_Iznonu , A_Irnonu , A_Ianonu , A_Ibnonu , A_Ietaee , &
A_Iprpmc , I_Iflpmc , A_Idepmc , I_Isopmc , &
@@ -144,9 +143,9 @@ module par_m
!
IF (Kpolar.EQ.1.AND. Nres.NE.0) CALL Fixpol (I_Iflpol )
CALL Fix (I_Iflbrd , &
- I_Ifldet , I_Iflext , I_Iflmsc , &
+ I_Ifldet , I_Iflmsc , &
I_Irdmsc , I_Iflpmc , I_Iflorr , I_Iflrpi , I_Iflnbk , &
- I_Iflbgf , I_Ifldtp , I_Iflusd , Nnrext)
+ I_Iflbgf , I_Ifldtp , I_Iflusd)
! *** Routine Fix sets Flag = (Parameter Number)
!
IF (Kpolar.EQ.1.AND. Nres.NE.0) CALL Flgpol (I_Iflpol )
diff --git a/sammy/src/par/mpar02.f90 b/sammy/src/par/mpar02.f90
index 89bd9ee294a1b3dfc7b443a4bca2e55915b271aa..af66e1e35ec65ac8d44ac4d891904853cf8c00ef 100644
--- a/sammy/src/par/mpar02.f90
+++ b/sammy/src/par/mpar02.f90
@@ -9,7 +9,7 @@ module par2_m
SUBROUTINE Parfil (Parbrd, Iflbrd, Siabnd, &
Spniso, Ixciso, &
Pardet, Ifldet, Deldet, Igrdet, &
- Parext, Iflext, Parmsc, Iflmsc, Delmsc, Iradms, Ijkmsc, &
+ Parmsc, Iflmsc, Delmsc, Iradms, Ijkmsc, &
Znonu , Rnonu , Anonu , Bnonu , &
Etaeee, Parpmc, Iflpmc, Delpmc, Isopmc, &
Parorr, Iflorr, Delorr, Ecrnch, Endets, Sesese, Eseses, Sigdts, &
@@ -48,7 +48,6 @@ module par2_m
DIMENSION Parbrd(*), Iflbrd(*), Siabnd(*), &
Spniso(*), Ixciso(*), &
Pardet(*), Ifldet(*), Deldet(*), Igrdet(*), &
- Parext(Nnrext,Ntotc,*), Iflext(Nnrext,Ntotc,*), &
Parmsc(*), Iflmsc(*), Delmsc(*), Iradms(*), Ijkmsc(*), &
Znonu (*), Rnonu (*), Anonu (*), Bnonu (*), Etaeee(*), &
Parpmc(4,*), Iflpmc(4,*), Delpmc(4,*), Isopmc(*), &
@@ -72,7 +71,6 @@ module par2_m
! * Spniso(Numiso), Ixciso(Numiso),
! * Pardet(Numdet), Ifldet(Numdet),
! * Deldet(Numdet), Igrdet(Ngroup),
-! * Parext(Nrext,Ntotc,Ngroup) , Iflext(Nrext,Ntotc,Ngroup),
! * Parmsc(Nummsc), Iflmsc(Nummsc), Delmsc(Nummsc),
! * Iradms(Ngroup), Ijkmsc(Nummsc),
! * Anonu (Nonu ), Rnonu (Nonu ), Etaeee(Mjetan),
@@ -124,11 +122,11 @@ module par2_m
!
ELSE IF (Alfnm1.EQ.Rexter) THEN
! *** alternative to card set 3
- CALL Readrx (Parext, Iflext, Nnrext)
+ CALL Readrx (Nnrext)
!
ELSE IF (Alfnm1.EQ.Extern) THEN
! *** card set 3
- CALL Readex (Parext, Iflext, Nnrext)
+ CALL Readex (Nnrext)
!
ELSE IF (Alfnm1.EQ.Radius .OR. Alfnm1.EQ.Radiii .OR. &
Alfnm1.EQ.Channe) THEN
diff --git a/sammy/src/par/mpar03.f90 b/sammy/src/par/mpar03.f90
index 7bbec3bc5b339b86f2812fd79525aaf3219ba5d6..164dfb5d671e78fa70bd638261e4547ab2109228 100644
--- a/sammy/src/par/mpar03.f90
+++ b/sammy/src/par/mpar03.f90
@@ -86,31 +86,26 @@ module par3_m
!
! --------------------------------------------------------------
!
- SUBROUTINE Readrx (Parext, Iflext, Nnrext)
+ SUBROUTINE Readrx (Nnrext)
!
! *** alternative to card set 3
! *** PURPOSE -- READ R-EXTERNAL PARAMETERS
!
use fixedi_m
use ifwrit_m
+ use SammyRExternalInfo_M
+ use RMatResonanceParam_M
+ use EndfData_common_m, only : resParData
IMPLICIT DOUBLE PRECISION (a-h,o-z)
!
-! DIMENSION Parext(Nrext,Ntotc,Ngroup), Iflext(Nrext,Ntotc,Ngroup)
- DIMENSION Parext(Nnrext,Ntotc,*), Iflext(Nnrext,Ntotc,*)
DIMENSION P(7), Js(7)
+ integer::irext
+ type(SammyRExternalInfo) ::rextInfo
+ type(RExternalFunction) :: rext
DATA Zero /0.0d0/
!
K1 = 0
K3 = 0
- DO N=1,Ngroup
- DO I=1,Ntotc
- DO Kqqq=1,7
- Parext(Kqqq,I,N) = Zero
- Iflext(Kqqq,I,N) = 0
- END DO
- Iflext(1,I,N) = -1
- END DO
- END DO
N = 0
Numext = 0
!
@@ -127,19 +122,36 @@ module par3_m
END DO
Js(1) = -1
60 CONTINUE
+ if( Js(1).ge.0) then
+ call resparData%addRext(Nnn, Nchnn)
+ irext = resParData%getNumRext()
+ call resParData%getRextInfo(rextInfo, irext)
+ call rextInfo%setNrext(7)
+
+ call resparData%getRext(rext, rextInfo)
+ do Kqqq=1,7
+ call rext%setSammyValue(Kqqq, P(Kqqq))
+ end do
+
+ IF (Kgenpd.NE.1) THEN
+ do Kqqq=1,7
+ call rextInfo%setIflSammyIndex(Kqqq, Js(Kqqq))
+ end do
+ end if
+ end if
+
IF (Js(1).LT.0) THEN
! All flags are zero (or -1) if parameters are zero
ELSE
- DO Kqqq=1,7
- Parext(Kqqq,Nchnn,Nnn) = P(Kqqq)
- IF (Kgenpd.NE.1) THEN
- Iflext(Kqqq,Nchnn,Nnn) = Js(Kqqq)
+ DO Kqqq=1,7
+ IF (Kgenpd.eq.1) THEN
+ Js(1:7) = 0
END IF
END DO
- END IF
+ END IF
DO Kqqq=1,7
- IF (Iflext(Kqqq,Nchnn,Nnn).EQ.1) K1 = K1 + 1
- IF (Iflext(Kqqq,Nchnn,Nnn).EQ.3) K3 = K3 + 1
+ IF (Js(Kqqq).EQ.1) K1 = K1 + 1
+ IF (Js(Kqqq).EQ.3) K3 = K3 + 1
END DO
GO TO 40
!
@@ -155,31 +167,26 @@ module par3_m
!
! --------------------------------------------------------------
!
- SUBROUTINE Readex (Parext, Iflext, Nnrext)
+ SUBROUTINE Readex (Nnrext)
!
! *** card set 3
! *** PURPOSE -- READ EXTERNAL R-MATRIX PARAMETERS
!
use fixedi_m
use ifwrit_m
+ use SammyRExternalInfo_M
+ use RMatResonanceParam_M
+ use EndfData_common_m, only : resParData
IMPLICIT DOUBLE PRECISION (a-h,o-z)
!
-! DIMENSION Parext(Nrext,Ntotc,Ngroup), Iflext(Nrext,Ntotc,Ngroup)
- DIMENSION Parext(Nnrext,Ntotc,*), Iflext(Nnrext,Ntotc,*)
DIMENSION P(5), JS(5)
+ integer::irext
+ type(SammyRExternalInfo) ::rextInfo
+ type(RExternalFunction) :: rext
DATA Zero /0.0d0/
!
K1 = 0
K3 = 0
- DO N=1,Ngroup
- DO I=1,Ntotc
- DO Kqqq=1,5
- Parext(Kqqq,I,N) = Zero
- Iflext(Kqqq,I,N) = 0
- END DO
- Iflext(1,I,N) = -1
- END DO
- END DO
N = 0
!
40 CONTINUE
@@ -192,19 +199,28 @@ module par3_m
IF (Nchnn.EQ.0) Nchnn = 1
IF (P(1).EQ.Zero .AND. P(2).EQ.Zero .AND. P(3).EQ.Zero .AND. &
P(4).EQ.Zero .AND. P(5).EQ.Zero) Js(1) = -1
- IF (Js(1).LT.0) THEN
-! All flags are zero (or -1) if parameters are zero
- ELSE
+
+ if (Js(1).ge.0) then
+ call resparData%addRext(Nnn, Nchnn)
+
+ irext = resParData%getNumRext()
+ call resParData%getRextInfo(rextInfo, irext)
+ call rextInfo%setNrext(5)
+ call resparData%getRext(rext, rextInfo)
DO Kqqq=1,5
- Parext(Kqqq,Nchnn,Nnn) = P(Kqqq)
- IF (Kgenpd.NE.1) THEN
- Iflext(Kqqq,Nchnn,Nnn) = Js(Kqqq)
- END IF
- END DO
- END IF
+ call rext%setSammyValue(Kqqq, P(Kqqq))
+ end do
+
+ IF (Kgenpd.NE.1) THEN
+ DO Kqqq=1,5
+ call rextInfo%setIflSammyIndex(Kqqq, Js(Kqqq))
+ end do
+ end if
+ end if
+
DO Kqqq=1,5
- IF (Iflext(Kqqq,Nchnn,Nnn).EQ.1) K1 = K1 + 1
- IF (Iflext(Kqqq,Nchnn,Nnn).EQ.3) K3 = K3 + 1
+ IF (Js(Kqqq).EQ.1) K1 = K1 + 1
+ IF (Js(Kqqq).EQ.3) K3 = K3 + 1
END DO
GO TO 40
!
diff --git a/sammy/src/par/mpar12.f90 b/sammy/src/par/mpar12.f90
index 45c92aa3299b450d1a37b72f604483881fd83340..c82feb696698e099865f01aedfc8058a5e4e5301 100755
--- a/sammy/src/par/mpar12.f90
+++ b/sammy/src/par/mpar12.f90
@@ -6,22 +6,22 @@ module FixUpParameterData_M
contains
- SUBROUTINE FixCovIndex ( Iflbrd, Ifldet, &
- Iflext, Iflmsc, Iradms, Iflpmc, Iflorr, Iflrpi, &
- Iflnbk, Iflbgf, Ifldtp, Iflusd, Nnrext)
+ SUBROUTINE FixCovIndex ( Iflbrd, Ifldet, &
+ Iflmsc, Iradms, Iflpmc, Iflorr, Iflrpi, &
+ Iflnbk, Iflbgf, Ifldtp, Iflusd)
integer::Iflbrd(*), &
- Ifldet(*), Iflext(Nnrext,Ntotc,*), &
+ Ifldet(*), &
Iflmsc(*), Iradms(*), Iflpmc(4,*), Iflorr(*), Iflrpi(*), &
Iflnbk(*), Iflbgf(*), Ifldtp(*), Iflusd(*)
- integer::nnrext,i
+ integer::i
type(SetUParameters)::params
type(SammySpinGroupInfo)::spinInfo
call params%initialize()
call params%updateFitParameters(Iflbrd, Ifldet, &
- Iflext, Iflmsc, Iradms, Iflpmc, Iflorr, Iflrpi, &
- Iflnbk, Iflbgf, Ifldtp, Iflusd, Nnrext)
+ Iflmsc, Iradms, Iflpmc, Iflorr, Iflrpi, &
+ Iflnbk, Iflbgf, Ifldtp, Iflusd)
call params%destroy()
end SUBROUTINE FixCovIndex
end module FixUpParameterData_M
@@ -32,8 +32,8 @@ end module FixUpParameterData_M
!C --------------------------------------------------------------
!C
SUBROUTINE Fix ( Iflbrd, Ifldet, &
- Iflext, Iflmsc, Iradms, Iflpmc, Iflorr, Iflrpi, &
- Iflnbk, Iflbgf, Ifldtp, Iflusd, Nnrext)
+ Iflmsc, Iradms, Iflpmc, Iflorr, Iflrpi, &
+ Iflnbk, Iflbgf, Ifldtp, Iflusd)
!C
!C *** PURPOSE -- SET ORDINAL NUMBER FOR EACH VARIED PARAMETER
!C
@@ -43,16 +43,15 @@ end module FixUpParameterData_M
IMPLICIT NONE
integer:: Iflbrd(*), &
- Ifldet(*), Iflext(Nnrext,Ntotc,*), &
+ Ifldet(*), &
Iflmsc(*), Iradms(*), Iflpmc(4,*), Iflorr(*), Iflrpi(*), &
Iflnbk(6,*), Iflbgf(*), Ifldtp(*), Iflusd(*)
- integer::nnrext
integer::k1,k3,ipar
- call FixCovIndex ( Iflbrd, Ifldet, &
- Iflext, Iflmsc, Iradms, Iflpmc, Iflorr, Iflrpi, &
- Iflnbk, Iflbgf, Ifldtp, Iflusd, Nnrext)
+ call FixCovIndex ( Iflbrd, Ifldet, &
+ Iflmsc, Iradms, Iflpmc, Iflorr, Iflrpi, &
+ Iflnbk, Iflbgf, Ifldtp, Iflusd)
K1 = covData%getNumParam()
K3 = covData%getPupedParam()
Ipar = covData%getNumTotalParam()
diff --git a/sammy/src/rec/mrec5.f b/sammy/src/rec/mrec5.f
index b56729918dfb338de0eb3a4733bee86e35328714..1b7d400dd8db7da6dcc69385acbaffa705d1929f 100644
--- a/sammy/src/rec/mrec5.f
+++ b/sammy/src/rec/mrec5.f
@@ -101,6 +101,7 @@ C *** Sig2(2,I) is capture cross section (absorption - fission)
call expData%initialize()
call grid%initialize()
index = 1
+ call grid%reserve(Ndatb*Numcro, 1)
do i = 1, Ndatb
do j = 1, Numcro
call grid%addData(index, 1, Etab2(i))
@@ -115,6 +116,7 @@ C *** Sig2(2,I) is capture cross section (absorption - fission)
end if
if (calcData%getNumberIsotopes().eq.0) then
call calcData%setUpList(resParData,
+ * radFitFlags,
* resParData%getNumIso())
end if
Ksolve = 2
diff --git a/sammy/src/rec/mrec8.f90 b/sammy/src/rec/mrec8.f90
index e738ff0fce083873e35ff61617d0ef953593e4f4..449b8673bbfc7a659012b4fccfe4acc1a3a6d4f3 100755
--- a/sammy/src/rec/mrec8.f90
+++ b/sammy/src/rec/mrec8.f90
@@ -87,6 +87,7 @@ module mrec8_m
101 CONTINUE
Npurr = L - 1
call reallocate_real_data(X, Npurr)
+ call Energb%reserve(Nemax+Npurr, 1)
DO N=1,Npurr
call Energb%addData(Nemax+N, 1, X(N))
END DO
diff --git a/sammy/src/ref/mrfs0.f b/sammy/src/ref/mrfs0.f
index 3fc76f9a69718c02647d618fb3f801b17bd58e1c..608804d7becb83efee730aa8e92f19679b46fd04 100644
--- a/sammy/src/ref/mrfs0.f
+++ b/sammy/src/ref/mrfs0.f
@@ -55,7 +55,7 @@ C
C *** collect values needed for parameter file
Korder = Idimen (1, 1, '1, 1')
CALL Cnvpar ( A_Iprbrd , I_Iflbrd ,
- * A_Iprext , I_Iflext , I_Iflpol ,
+ * I_Iflpol ,
* A_Iprmsc , I_Iflmsc , A_Idemsc , I_Irdmsc ,
* A_Iprpmc , I_Iflpmc , A_Idepmc , I_Isopmc ,
* A_Iprorr , I_Iflorr , A_Ideorr , A_Icrnch , A_Iedets ,
diff --git a/sammy/src/ref/mrfs2.f b/sammy/src/ref/mrfs2.f
index c17a33dab4c21d25597cd43f2f3548dcef7cf742..112053148dae63dc9a4d2ba2619aff8cef8be707 100644
--- a/sammy/src/ref/mrfs2.f
+++ b/sammy/src/ref/mrfs2.f
@@ -138,11 +138,7 @@ C *** six.one
call make_I_Iigrde(N)
C
C *** seven
- N = Nrext*Ngroup*Ntotc
IF (Nrext.EQ.0) Nrext = 1
- IF (N.EQ.0) N = 1
- call make_A_Iprext(N)
- call make_I_Iflext(N)
C
RETURN
END
diff --git a/sammy/src/ref/mrfs4.f b/sammy/src/ref/mrfs4.f
index 5e23a46ae26488bc08cad4176df36f7585c47851..0ec9e41bfb3c59a9a448634f3449691ac3f39a1f 100644
--- a/sammy/src/ref/mrfs4.f
+++ b/sammy/src/ref/mrfs4.f
@@ -3,7 +3,7 @@ C
C --------------------------------------------------------------
C
SUBROUTINE Cnvpar ( Parbrd, Iflbrd,
- * Parext, Iflext, Iflpol,
+ * Iflpol,
* Parmsc, Iflmsc, Delmsc, Iradms,
* Parpmc, Iflpmc, Delpmc, Isopmc,
* Parorr, Iflorr, Delorr, Ecrnch, Endets, Sigdts,
@@ -35,7 +35,6 @@ C
type(SammyIsoInfo)::isoInfo
logical(C_BOOL)::reduced, combined
DIMENSION Parbrd(*), Iflbrd(*),
- * Parext(Nrext,Ntotc,*), Iflext(Nrext,Ntotc,*),
* Iflpol(2,*),
* Parmsc(*), Iflmsc(*), Delmsc(*), Iradms(*),
* Parpmc(4,*), Iflpmc(4,*), Delpmc(4,*), Isopmc(*),
@@ -48,8 +47,6 @@ C
* ParBAG(*), Iflbag(*)
C
C DIMENSION Parbrd(Numbrd), Iflbrd(Numbrd),
-C * Parext(Nrext,Ntotc,Ngroup),
-C * Iflext(Nrext,Ntotc,Ngroup),
C * Parmsc(Nummsc), Iflmsc(Nummsc), Delmsc(Nummsc), iradms(Ngroup),
C * Parpmc(4,Numpmc), Iflpmc(4,Numpmc), Delpmc(4,Numpmc),Isopmc(Numpmc),
C * Parorr(Numorr), Iflorr(Numorr),
diff --git a/sammy/src/ref/mwrt0.f b/sammy/src/ref/mwrt0.f
index 2cb31699c757f77572d08fe3779d804581e25b86..185f45a75946c05e7a89b08ecb1ef9b855609aa7 100644
--- a/sammy/src/ref/mwrt0.f
+++ b/sammy/src/ref/mwrt0.f
@@ -50,7 +50,6 @@ C *** Write Parameter file
CALL Oldord ( A_Iprbrd , I_Iflbrd , A_Idebrd ,
* I_Ifexcl ,
* A_Iprdet , I_Ifldet , A_Idedet , I_Iigrde ,
- * A_Iprext , I_Iflext ,
* I_Iflpol ,
* A_Iprmsc , I_Iflmsc , A_Idemsc , I_Irdmsc , I_Ijkmsc ,
* A_Ietaee ,
diff --git a/sammy/src/rpt/mrpt.f b/sammy/src/rpt/mrpt.f
index 11b4de81589d0eca7a89267ecab8fb444c1d8b2d..26d927caf13129e1879a102a54f1c832d6ff42e1 100644
--- a/sammy/src/rpt/mrpt.f
+++ b/sammy/src/rpt/mrpt.f
@@ -294,6 +294,7 @@ C
T = Tup
Dt = (Tup-Tlow)/(dFLOAT(N-1))
Ii = 0
+ call grid%reserve(N, 1)
DO I=1,N
Ii = Ii + 1
Tt(Ii) = T - Dt*dFLOAT(I-1)
diff --git a/sammy/src/salmon/DerivativeList.cpp b/sammy/src/salmon/DerivativeList.cpp
index e0e04167a2e34a6bf88feec2a296f2eaaffa695b..1caac597f0a4a841b8117aebfc9f8bc1ad740fcd 100644
--- a/sammy/src/salmon/DerivativeList.cpp
+++ b/sammy/src/salmon/DerivativeList.cpp
@@ -9,7 +9,7 @@
namespace sammy {
void DerivativeList::addGrid(){
std::unique_ptr<GridData> data = nemesis::make_unique<GridData>();
- gridData.addGrid(data);
+ gridData.addGrid(data); // gridData automatically sets notSetReturnsZero
}
int DerivativeList::getLength() const{
@@ -24,30 +24,35 @@ namespace sammy {
return gridData.getGrid(iso)->getLength();
}
- void DerivativeList::updateRealCol(int col){
- if (col < (int)realColIndices.size()) return; // already done
+ void DerivativeList::updateRealCol(int col, bool force){
+ if (col < (int)realColIndices.size() && !force) return; // already done
- size_t start = realColIndices.size();
- for (int c = start; c <= col; c++){
- if (isSharedColumn(c)){
- for (size_t i = 0; i < sharedIndices.size(); i++){
- if ( c == sharedIndices[i].first){
- realColIndices.push_back(-1*(i+1));
- break;
-
- }
- }
- }
- else{
- int pos = -1;
- for ( int c = 0; c <= col; c++){
- if ( isSharedColumn(c)) continue;
- pos++;
- }
- realColIndices.push_back(pos+1);
+ size_t start = realColIndices.size();
+ if (force) {
+ start = 0;
+ realColIndices.clear();
}
- }
- }
+ for (int c = start; c <= col; c++){
+ int index = -1;
+ if (isSharedColumn(c)){
+ for (size_t i = 0; i < sharedIndices.size(); i++){
+ if ( c == sharedIndices[i].first){
+ index = -1*(i+1);
+
+ }
+ }
+ }
+ else{
+ int pos = -1;
+ for ( int i = 0; i <= c; i++){
+ if ( isSharedColumn(i)) continue;
+ pos++;
+ }
+ index = pos+1;
+ }
+ realColIndices.push_back(index);
+ }
+ }
void DerivativeList::addData(int row, int col, int iso, double val){
@@ -56,6 +61,11 @@ namespace sammy {
throw std::runtime_error(std::to_string(iso) + " Isotope out of range");
}
+ if (sharedIndices.size() == 0){
+ gridData.getGrid(iso)->addData(row,col, val);
+ return;
+ }
+
updateRealCol(col);
int ourCol = realColIndices[col];
@@ -75,20 +85,89 @@ namespace sammy {
gridData.getGrid(iso)->addData(row,ourCol, val);
}
+ namespace detail{
+ void getMaxColumnData(int & maxShared, int & maxUn, const std::vector<int> & cols){
+ maxShared = maxUn = 0;
+ auto min = std::min_element(cols.begin(), cols.end());
+ int minVal = (*min);
+ if (minVal < 0){
+ maxShared = -1 * minVal;
+ }
+ auto max = std::max_element(cols.begin(), cols.end());
+ maxUn = (*max);
+ }
+ }
+
+ void DerivativeList::reserveColumns(int row, int maxCol){
+ if(maxCol == 0) return;
+
+ if (sharedIndices.size() == 0){
+ for (int iso = 0; iso < gridData.getLength(); iso++){
+ gridData.getGrid(iso)->reserveColumn(row, maxCol);
+ }
+ return;
+ }
+
+ updateRealCol(maxCol-1);
+
+ int maxShared, maxUn;
+ detail::getMaxColumnData(maxShared, maxUn, realColIndices);
+ if (maxShared > 0){
+ sharedData.reserveColumn(row, maxShared);
+ }
+ if (maxUn > 0){
+ for (int iso = 0; iso < gridData.getLength(); iso++){
+ gridData.getGrid(iso)->reserveColumn(row, maxUn);
+ }
+ }
+ }
+
+
+ void DerivativeList::reserve(int maxRow, int maxCol){
+ if(maxCol == 0 || maxRow == 0) return;
+
+ if (sharedIndices.size() == 0){
+ for (int iso = 0; iso < gridData.getLength(); iso++){
+ gridData.getGrid(iso)->reserve(maxRow, maxCol);
+ }
+ return;
+ }
+
+
+ updateRealCol(maxCol-1);
+
+ int maxShared, maxUn;
+ detail::getMaxColumnData(maxShared, maxUn, realColIndices);
+ if (maxShared > 0){
+ sharedData.reserve(maxRow, maxShared);
+ }
+ if (maxUn > 0){
+ for (int iso = 0; iso < gridData.getLength(); iso++){
+ gridData.getGrid(iso)->reserve(maxRow, maxUn);
+ }
+ }
+ }
+
double DerivativeList::getData(int row, int col, int iso) const{
// check whether it's a valid isotope
if (iso < 0 || iso >= gridData.getLength()){
throw std::runtime_error(std::to_string(iso) + " Isotope out of range");
}
+
+ if (sharedIndices.size() == 0){
+ return gridData.getGrid(iso)->getData(row,col);
+ }
+
if (col >= (int)realColIndices.size()){
+ if( notSetReturnsZero) return 0.0;
throw std::runtime_error(std::to_string(col) + " column out of range");
}
// if it is a shared column, just get it
- int ourCol = realColIndices[col];
+ int ourCol = realColIndices[col];
if (ourCol < 0){
ourCol = -1*ourCol - 1;
- if (sharedIndices[ourCol].second == iso){
+ if (sharedIndices[ourCol].second == iso){
return sharedData.getData(row, ourCol);
}
return 0.0;
@@ -131,7 +210,7 @@ namespace sammy {
// Therefore the C++ setup get's a chance to reset the
// isotope consistent with the isotope ID in the
// resonance data
- auto it = std::find_if( sharedIndices.begin(), sharedIndices.end(), detail::comp(col));
+ auto it = std::find_if( sharedIndices.begin(), sharedIndices.end(), detail::comp(col));
it->second = iso;
return;
}
@@ -142,7 +221,9 @@ namespace sammy {
throw std::runtime_error("Can't add shared column if we already have data");
}
sharedIndices.push_back(std::make_pair(col, iso));
- updateRealCol(col);
+ bool force = false;
+ if (col < (int)realColIndices.size() ) force = true;
+ updateRealCol(col, force);
}
void DerivativeList::clear(){
@@ -155,10 +236,10 @@ namespace sammy {
}
void DerivativeList::nullify(){
- sharedData.clearGrid();
+ sharedData.nullify();
for ( int i = 0; i < gridData.getLength(); i++){
- gridData.getGrid(i)->clearGrid();
+ gridData.getGrid(i)->nullify();
}
}
@@ -185,8 +266,32 @@ namespace sammy {
return -1;
}
+ void DerivativeList::setNotSetReturnsZero(bool empty){
+ notSetReturnsZero = empty;
+ gridData.setNotSetReturnsZero(empty);
+ sharedData.setNotSetReturnsZero(empty);
+ }
+
+ void DerivativeList::setAccumulate(bool add){
+ accumulate = add;
+ gridData.setAccumulate(add);
+ sharedData.setAccumulate(add);
+ }
+
+ void DerivativeListHolder::setNotSetReturnsZero(bool empty){
+ notSetReturnsZero = empty;
+ list[0].setNotSetReturnsZero(empty);
+ list[1].setNotSetReturnsZero(empty);
+ }
+
+ void DerivativeListHolder::setAccumulate(bool add){
+ accumulate = add;
+ list[0].setAccumulate(add);
+ list[1].setAccumulate(add);
+ }
+
void DerivativeListHolder::addGrid(){
- list[currentList].addGrid();
+ list[currentList].addGrid(); // list updates notSetReturnsZero internally
}
int DerivativeListHolder::getLength(bool current) const{
@@ -202,6 +307,20 @@ namespace sammy {
return list[c].getLength(iso);
}
+ void DerivativeListHolder::reserveColumns(int row, int maxCol, bool current){
+ int c = currentList;
+ if( !current) c = parentList;
+
+ list[c].reserveColumns(row, maxCol);
+ }
+
+ void DerivativeListHolder::reserve(int maxRow, int maxCol, bool current){
+ int c = currentList;
+ if( !current) c = parentList;
+
+ list[c].reserve(maxRow, maxCol);
+ }
+
void DerivativeListHolder::addData(int row, int col, int iso, double val, bool current){
int c = currentList;
if( !current) c = parentList;
diff --git a/sammy/src/salmon/DerivativeList.h b/sammy/src/salmon/DerivativeList.h
index fbafd20c7c77924a2311524e8c13267adc356289..e1725cd6794aee54c0375463e194dccae6a2823b 100644
--- a/sammy/src/salmon/DerivativeList.h
+++ b/sammy/src/salmon/DerivativeList.h
@@ -47,7 +47,7 @@ namespace sammy{
*/
class DerivativeList{
public:
- DerivativeList(){};
+ DerivativeList():notSetReturnsZero(false),accumulate(false){};
DerivativeList(const DerivativeList & orig) = delete;
virtual ~DerivativeList(){}
@@ -148,10 +148,47 @@ namespace sammy{
* a shared column
*/
int getIsotopeForShared(int col) const;
+
+ /**
+ * Indicate whether getData should return 0 instead of throw if the
+ * corresponding addData was not called.
+ *
+ * This is sometime convenient if calculating derivatives, where
+ * derivatives are only set for paramters where the matter,
+ * but the array needs to be over all flagged parameters.
+ *
+ * @param empty if true, getData returns 0 if addData was not called
+ */
+ void setNotSetReturnsZero(bool empty);
+
+ /**
+ * Should addData accumulate instead of set
+ * @param add
+ */
+ void setAccumulate(bool add);
+
+ /**
+ * Make sure the indicated row as at least maxCol data.
+ * If not set, additional columns are set to zero
+ *
+ * @param row the row for which to set the data
+ * @param maxCol the maximum number of columns
+ */
+ void reserveColumns(int row, int maxCol);
+
+ /**
+ * Reserve maxRow and maxCol.
+ * If not set, additional rows columns are set to zero
+ *
+ * @param maxRow the maximum number of rows
+ * @param maxCol the maximum number of columns
+ * @return
+ */
+ void reserve(int maxRow, int maxCol);
private:
/* For look-up acceleration set up the linking between columns and
* isotope to either shared or "normal colum */
- void updateRealCol(int col);
+ void updateRealCol(int col, bool force = false);
/** the list of "normal" columns */
GridDataList gridData;
@@ -162,6 +199,10 @@ namespace sammy{
/** The isotope to link to for shared column */
std::vector<std::pair<int,int>> sharedIndices;
+ bool notSetReturnsZero;
+
+ bool accumulate;
+
/* For look-up acceleration set up the linking between columns and
* isotope to either shared or "normal colum */
std::vector<int> realColIndices;
@@ -184,7 +225,7 @@ namespace sammy{
*/
class DerivativeListHolder{
public:
- DerivativeListHolder():currentList(0),parentList(0){}
+ DerivativeListHolder():currentList(0),parentList(0), notSetReturnsZero(false), accumulate(false){}
DerivativeListHolder(const DerivativeListHolder & orig) = delete;
virtual ~DerivativeListHolder(){}
@@ -256,7 +297,7 @@ namespace sammy{
/**
* Set the length of the desired DerivativeList objects to 0
- * @param current true if using the current grif, false for the parent grid
+ * @param current true if using the current grid, false for the parent grid
*/
void nullify(bool current = true);
@@ -282,6 +323,43 @@ namespace sammy{
* @return isotope index for the shared column
*/
int getIsotopeForShared(int col) const;
+
+ /**
+ * Indicate whether getData should return 0 instead of throw if the
+ * corresponding addData was not called.
+ *
+ * This is sometime convenient if calculating derivatives, where
+ * derivatives are only set for paramters where the matter,
+ * but the array needs to be over all flagged parameters.
+ *
+ * @param empty if true, getData returns 0 if addData was not called
+ */
+ void setNotSetReturnsZero(bool empty);
+
+ /**
+ * Should addData accumulate instead of just set
+ * @param add
+ */
+ void setAccumulate(bool add);
+
+ /**
+ * Make sure the indicated row as at least maxCol data.
+ * If not set, additional columns are set to zero
+ *
+ * @param row the row for which to set the data
+ * @param maxCol the maximum number of columns
+ */
+ void reserveColumns(int row, int maxCol, bool current = true);
+
+ /**
+ * Reserve maxRow and maxCol.
+ * If not set, additional rows columns are set to zero
+ *
+ * @param maxRow the maximum number of rows
+ * @param maxCol the maximum number of columns
+ * @return
+ */
+ void reserve(int maxRow, int maxCol, bool current = true);
private:
/** Index of the current index in list used to accumulate the broadened data */
int currentList;
@@ -289,6 +367,10 @@ namespace sammy{
/** Index of the index to the list containing the unbroadened data */
int parentList;
+ bool notSetReturnsZero;
+
+ bool accumulate;
+
/** The two grids to ping-pong between if chaining broadening data */
DerivativeList list[2];
diff --git a/sammy/src/salmon/GridData.cpp b/sammy/src/salmon/GridData.cpp
index 1f7380cdd84d9745933a71e000002c6870b39a5f..940f6591e3bf16a17eeb95e68d841b2117ce2404 100644
--- a/sammy/src/salmon/GridData.cpp
+++ b/sammy/src/salmon/GridData.cpp
@@ -1,11 +1,14 @@
#include "GridData.h"
#include "Nemesis/utils/Future.hh"
+#include <algorithm>
namespace sammy{
GridData::GridData(const GridData & orig):data(orig.data),
dataIndex(orig.dataIndex),
rowOffset(orig.rowOffset),
- rowMax(orig.rowMax){
+ rowMax(orig.rowMax),
+ notSetReturnsZero(orig.notSetReturnsZero),
+ accumulate(orig.accumulate){
if (orig.implicitParCov != nullptr){
implicitParCov = nemesis::make_unique<endf::ResonanceCovariance>(*(orig.implicitParCov));
@@ -23,6 +26,9 @@ namespace sammy{
if (row < 0) throw std::runtime_error("row index " + std::to_string(row) + " out of range in addData");
if (col < 0) throw std::runtime_error("col index " + std::to_string(col) + " out of range in addData");
+ if (accumulate && val == 0.0) return;
+
+
if ( row >= getLength() )
{
data.resize(row+1);
@@ -31,14 +37,40 @@ namespace sammy{
data[row].resize(col+1);
}
- data[row][col] = val;
+
+ if (accumulate) data[row][col] += val;
+ else data[row][col] = val;
+ }
+
+
+ void GridData::reserve(int maxRow, int maxCol){
+ if (maxRow > (int)data.size()){
+ data.resize(maxRow);
+ }
+
+ for( auto & d : data){
+ if (maxCol > (int)d.size()){
+ d.resize(maxCol);
+ }
+ }
+ }
+
+ void GridData::reserveColumn(int row, int maxCol){
+ if (row >= (int)data.size()){
+ data.resize(row+1);
+ }
+ if( maxCol > (int)data[row].size()){
+ data[row].resize(maxCol);
+ }
}
double GridData::getData(int row, int col) const{
if ( row < 0 || row >= (int)data.size()) {
+ if (notSetReturnsZero) return 0.0;
throw std::runtime_error("Row index out of range in GridData::getData: " + std::to_string(row));
}
if (col < 0 || col >= (int)data[row].size()){
+ if (notSetReturnsZero) return 0.0;
throw std::runtime_error("Column index out of range in GridData::getData: " + std::to_string(col));
}
@@ -73,10 +105,31 @@ namespace sammy{
data.clear();
}
- GridDataList::GridDataList():auxGridIndex(1), expGridIndex(0){ // normally auxillary grid index is 1, and experimental grid 0
+ void GridData::nullify(){
+ for (auto & d: data){
+ std::fill(d.begin(), d.end(), 0.0);
+ }
+ }
+
+ GridDataList::GridDataList():auxGridIndex(1), expGridIndex(0), notSetReturnsZero(false),accumulate(false){ // normally auxillary grid index is 1, and experimental grid 0
expCov = std::unique_ptr<endf::ResonanceCovariance>( new endf::ResonanceCovariance());
}
+ void GridDataList::setNotSetReturnsZero(bool empty){
+ notSetReturnsZero = empty;
+ for (auto & g : grids){
+ g->setNotSetReturnsZero(empty);
+ }
+ }
+
+ void GridDataList::setAccumulate(bool add){
+ accumulate = add;
+
+ for (auto & g : grids){
+ g->setAccumulate(add);
+ }
+ }
+
int GridDataList::getLength() const{
return (int)grids.size();
@@ -100,6 +153,8 @@ namespace sammy{
void GridDataList::addGrid(std::unique_ptr<GridData> & grid){
grids.push_back( std::unique_ptr<GridData>());
grids[grids.size() -1 ] = std::move(grid);
+ grids[grids.size() -1 ]->setNotSetReturnsZero(notSetReturnsZero);
+ grids[grids.size() -1 ]->setAccumulate(accumulate);
}
void GridDataList::addExperimentalCov(int row, int col, double cov){
diff --git a/sammy/src/salmon/GridData.h b/sammy/src/salmon/GridData.h
index c4f39383b28b79d546cee64566cd01da11d17ea0..cc9ed05249742fb8a5bb4e7f4d2a833d4a99354b 100644
--- a/sammy/src/salmon/GridData.h
+++ b/sammy/src/salmon/GridData.h
@@ -31,7 +31,7 @@ namespace sammy{
*/
class GridData {
public:
- GridData():dataIndex(-1), rowOffset(0), rowMax(0){}
+ GridData():dataIndex(-1), rowOffset(0), rowMax(0), notSetReturnsZero(false),accumulate(false){}
GridData(const GridData & orig);
virtual ~GridData(){}
@@ -64,6 +64,30 @@ namespace sammy{
*/
double getData(int row, int col) const;
+ /**
+ * Indicate whether getData should return 0 instead of throw if the
+ * corresponding addData was not called.
+ *
+ * This is sometime convenient if calculating derivatives, where
+ * derivatives are only set for paramters where the matter,
+ * but the array needs to be over all flagged parameters.
+ *
+ * @param empty if true, getData returns 0 if addData was not called
+ */
+ void setNotSetReturnsZero(bool empty){
+ notSetReturnsZero = empty;
+ }
+
+
+ /**
+ * If true, addData accumulates data instead of set data
+ *
+ * @param add set to true to accumulate data with addData
+ */
+ void setAccumulate(bool add){
+ accumulate = add;
+ }
+
/**
* @brief getDataColumn Get the index at which the data start
* @return index at which the data start
@@ -101,6 +125,7 @@ namespace sammy{
int getRowMax() const;
void clearGrid();
+ void nullify();
/**
* Add a covariance for implicit parameters for
@@ -136,6 +161,15 @@ namespace sammy{
std::unique_ptr<GridData> & getImplicitDerivs(){
return implicitDerivs;
}
+
+ /**
+ * Reserve (and fill with zero), maxRow and maxCol data
+ *
+ * @param maxRow the number of rows desired
+ * @param maxCol the number of columns desired
+ */
+ void reserve(int maxRow, int maxCol);
+ void reserveColumn(int row, int maxCol);
protected:
std::vector< std::vector<double> > data;
@@ -145,6 +179,9 @@ namespace sammy{
int rowOffset;
int rowMax;
+ bool notSetReturnsZero;
+ bool accumulate;
+
// arrays for the implicit data covariance
// covariance for the implicit parameters
@@ -187,6 +224,26 @@ namespace sammy{
*/
void addGrid(std::unique_ptr<GridData> & grid);
+ /**
+ * Indicate whether getData should return 0 instead of throw if the
+ * corresponding addData was not called.
+ *
+ * This is sometime convenient if calculating derivatives, where
+ * derivatives are only set for paramters where the matter,
+ * but the array needs to be over all flagged parameters.
+ *
+ * @param empty if true, getData returns 0 if addData was not called
+ */
+ void setNotSetReturnsZero(bool empty);
+
+ /**
+ * If true, addData for all grids accumulates data, instead of
+ * just updating them
+ *
+ * @param add set to true to accumulate in addData
+ */
+ void setAccumulate(bool add);
+
/**
* @brief addExperimentalCov Add or set covariance data
* Currently I am thinking covariance data are for all grids, and index is starting at grid index 0, gridsize of 1. grid + [0, 1, ..] for
@@ -267,6 +324,9 @@ namespace sammy{
int auxGridIndex;
int expGridIndex;
+
+ bool notSetReturnsZero;
+ bool accumulate;
};
}
diff --git a/sammy/src/salmon/interface/cix/DerivativeListHolder.cpp2f.xml b/sammy/src/salmon/interface/cix/DerivativeListHolder.cpp2f.xml
index 74c3fe0e73b95e89305a7ceb5b25005910876442..9293c03a553d54fcc747aa31d9f8275dc80bd22b 100644
--- a/sammy/src/salmon/interface/cix/DerivativeListHolder.cpp2f.xml
+++ b/sammy/src/salmon/interface/cix/DerivativeListHolder.cpp2f.xml
@@ -19,6 +19,16 @@
<param name="iso" type="int" offset="-1"/>
<param name="current" type="bool"/>
</method>
+ <method name="reserveColumns">
+ <param name="row" type="int" offset="-1"/>
+ <param name="maxCol" type="int"/>
+ <param name="current" type="bool"/>
+ </method>
+ <method name="reserve">
+ <param name="maxRow" type="int"/>
+ <param name="maxCol" type="int"/>
+ <param name="current" type="bool"/>
+ </method>
<method name="clear"/>
<method name="nullify">
<param name="current" type="bool"/>
@@ -28,8 +38,14 @@
<param name="col" type="int"/>
</method>
<method name="addSharedColumn">
- <param name="col" type="int"/>
- <param name="iso" type="int" offset="-1"/>
+ <param name="col" type="int"/>
+ <param name="iso" type="int" offset="-1"/>
</method>
+ <method name="setNotSetReturnsZero">
+ <param name="empty" type="bool"/>
+ </method>
+ <method name="setAccumulate">
+ <param name="add" type="bool"/>
+ </method>
</class>
</generate>
diff --git a/sammy/src/salmon/interface/cix/GridData.cpp2f.xml b/sammy/src/salmon/interface/cix/GridData.cpp2f.xml
index 4c659b249c8842b40f4dc89bfecb5ec792a273bf..f479203598e719a90776eedd4a14cf64ece1ea6e 100644
--- a/sammy/src/salmon/interface/cix/GridData.cpp2f.xml
+++ b/sammy/src/salmon/interface/cix/GridData.cpp2f.xml
@@ -26,6 +26,12 @@
<param name="offset" type="int"/>
</method>
<method name="clearGrid"/>
+ <method name="nullify"/>
+
+ <method name="reserve">
+ <param name="row" type="int"/>
+ <param name="col" type="int"/>
+ </method>
<method name="addImplicitDerivs">
<param name="grid" type="GridData*"/>
@@ -33,7 +39,7 @@
<method name="getImplicitDerivs" return_type="GridData*"/>
<method name="addImplicitParCov">
<param name="cov" type="ResonanceCovariance*"/>
- </method>
+ </method>
<method name="getImplicitParCov" return_type="ResonanceCovariance*"/>
</class>
@@ -53,7 +59,7 @@
<method name="getExperimentalCov" return_type="double">
<param name="row" type="int" offset="-1"/>
<param name="col" type="int" offset="-1"/>
- </method>
+ </method>
<method name="getAuxGridIndex" return_type="int"/>
<method name="getExpGridIndex" return_type="int"/>
<method name="setAuxGridIndex">
diff --git a/sammy/src/salmon/interface/cpp/DerivativeListHolderInterface.cpp b/sammy/src/salmon/interface/cpp/DerivativeListHolderInterface.cpp
index e4edba3b7f6402589d61feed4b769412180889f2..b1b749ac5908f9252dbabcde159e467a27888b87 100644
--- a/sammy/src/salmon/interface/cpp/DerivativeListHolderInterface.cpp
+++ b/sammy/src/salmon/interface/cpp/DerivativeListHolderInterface.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: Tue Apr 06 18:09:02 EDT 2021
+* Date Generated: Fri Aug 20 14:10:56 EDT 2021
* 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
*/
@@ -24,6 +24,16 @@ double DerivativeListHolder_getData(void * DerivativeListHolder_ptr,int * row,in
return ((DerivativeListHolder*)DerivativeListHolder_ptr)->getData(*row,*col,*iso,*current);
}
+void DerivativeListHolder_reserveColumns(void * DerivativeListHolder_ptr,int * row,int * maxCol,bool * current)
+{
+ ((DerivativeListHolder*)DerivativeListHolder_ptr)->reserveColumns(*row,*maxCol,*current);
+}
+
+void DerivativeListHolder_reserve(void * DerivativeListHolder_ptr,int * maxRow,int * maxCol,bool * current)
+{
+ ((DerivativeListHolder*)DerivativeListHolder_ptr)->reserve(*maxRow,*maxCol,*current);
+}
+
void DerivativeListHolder_clear(void * DerivativeListHolder_ptr)
{
((DerivativeListHolder*)DerivativeListHolder_ptr)->clear();
@@ -49,6 +59,16 @@ void DerivativeListHolder_addSharedColumn(void * DerivativeListHolder_ptr,int *
((DerivativeListHolder*)DerivativeListHolder_ptr)->addSharedColumn(*col,*iso);
}
+void DerivativeListHolder_setNotSetReturnsZero(void * DerivativeListHolder_ptr,bool * empty)
+{
+ ((DerivativeListHolder*)DerivativeListHolder_ptr)->setNotSetReturnsZero(*empty);
+}
+
+void DerivativeListHolder_setAccumulate(void * DerivativeListHolder_ptr,bool * add)
+{
+ ((DerivativeListHolder*)DerivativeListHolder_ptr)->setAccumulate(*add);
+}
+
void* DerivativeListHolder_initialize()
{
return new DerivativeListHolder();
diff --git a/sammy/src/salmon/interface/cpp/DerivativeListHolderInterface.h b/sammy/src/salmon/interface/cpp/DerivativeListHolderInterface.h
index 4a7cdeaf869030741fd2903351f156b33e8a7eb4..e3e70dc9873d5ddb5b6a0c0f0c5f23dab10b61ea 100644
--- a/sammy/src/salmon/interface/cpp/DerivativeListHolderInterface.h
+++ b/sammy/src/salmon/interface/cpp/DerivativeListHolderInterface.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: Tue Apr 06 18:09:02 EDT 2021
+* Date Generated: Fri Aug 20 14:10:56 EDT 2021
* 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
*/
@@ -16,11 +16,15 @@ extern "C" {
int DerivativeListHolder_getLength(void * DerivativeListHolder_ptr,bool * current);
void DerivativeListHolder_addData(void * DerivativeListHolder_ptr,int * row,int * col,int * iso,double * val,bool * current);
double DerivativeListHolder_getData(void * DerivativeListHolder_ptr,int * row,int * col,int * iso,bool * current);
+void DerivativeListHolder_reserveColumns(void * DerivativeListHolder_ptr,int * row,int * maxCol,bool * current);
+void DerivativeListHolder_reserve(void * DerivativeListHolder_ptr,int * maxRow,int * maxCol,bool * current);
void DerivativeListHolder_clear(void * DerivativeListHolder_ptr);
void DerivativeListHolder_nullify(void * DerivativeListHolder_ptr,bool * current);
void DerivativeListHolder_switchGrid(void * DerivativeListHolder_ptr);
int DerivativeListHolder_getIsotopeForShared(void * DerivativeListHolder_ptr,int * col);
void DerivativeListHolder_addSharedColumn(void * DerivativeListHolder_ptr,int * col,int * iso);
+void DerivativeListHolder_setNotSetReturnsZero(void * DerivativeListHolder_ptr,bool * empty);
+void DerivativeListHolder_setAccumulate(void * DerivativeListHolder_ptr,bool * add);
void* DerivativeListHolder_initialize();
void DerivativeListHolder_destroy(void * DerivativeListHolder_ptr);
#ifdef __cplusplus
diff --git a/sammy/src/salmon/interface/cpp/GridDataInterface.cpp b/sammy/src/salmon/interface/cpp/GridDataInterface.cpp
index 155b538e09fa6313d46f348d641b932b9c88cd0a..2c18d8328de891c1b7c4dddb13f5cc72fc74a851 100644
--- a/sammy/src/salmon/interface/cpp/GridDataInterface.cpp
+++ b/sammy/src/salmon/interface/cpp/GridDataInterface.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: Thu Jan 07 15:23:53 EST 2021
+* Date Generated: Fri Aug 20 09:26:07 EDT 2021
* 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
*/
@@ -59,6 +59,16 @@ void GridData_clearGrid(void * GridData_ptr)
((GridData*)GridData_ptr)->clearGrid();
}
+void GridData_nullify(void * GridData_ptr)
+{
+ ((GridData*)GridData_ptr)->nullify();
+}
+
+void GridData_reserve(void * GridData_ptr,int * row,int * col)
+{
+ ((GridData*)GridData_ptr)->reserve(*row,*col);
+}
+
void GridData_addImplicitDerivs(void * GridData_ptr,GridData* grid)
{
std::unique_ptr<GridData> gridPtr(grid);
diff --git a/sammy/src/salmon/interface/cpp/GridDataInterface.h b/sammy/src/salmon/interface/cpp/GridDataInterface.h
index 00f0bac8e67d3dfa4c3d65e5d02179de96c3597a..a85b0ebeaf9df98df25b779308dc0b4fe6df62ee 100644
--- a/sammy/src/salmon/interface/cpp/GridDataInterface.h
+++ b/sammy/src/salmon/interface/cpp/GridDataInterface.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: Thu Jan 07 15:23:53 EST 2021
+* Date Generated: Fri Aug 20 09:26:07 EDT 2021
* 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
*/
@@ -24,6 +24,8 @@ void GridData_setRowOffset(void * GridData_ptr,int * offset);
int GridData_getRowMax(void * GridData_ptr);
void GridData_setRowMax(void * GridData_ptr,int * offset);
void GridData_clearGrid(void * GridData_ptr);
+void GridData_nullify(void * GridData_ptr);
+void GridData_reserve(void * GridData_ptr,int * row,int * col);
void GridData_addImplicitDerivs(void * GridData_ptr,GridData* grid);
void* GridData_getImplicitDerivs(void * GridData_ptr);
void GridData_addImplicitParCov(void * GridData_ptr,endf::ResonanceCovariance* cov);
diff --git a/sammy/src/salmon/interface/fortran/DerivativeListHolder_I.f90 b/sammy/src/salmon/interface/fortran/DerivativeListHolder_I.f90
index 78cd7d2a70da5ad16ac9c59c570c231140bdf5a0..550254f21eb5890744e9fd0579dd2a9e458ff5c2 100644
--- a/sammy/src/salmon/interface/fortran/DerivativeListHolder_I.f90
+++ b/sammy/src/salmon/interface/fortran/DerivativeListHolder_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: Tue Apr 06 18:09:02 EDT 2021
+!! Date Generated: Fri Aug 20 14:10:56 EDT 2021
!! 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
!!/
@@ -34,6 +34,22 @@ real(C_DOUBLE) function f_DerivativeListHolder_getData(DerivativeListHolder_ptr,
integer(C_INT) :: iso;
logical(C_BOOL) :: current;
end function
+subroutine f_DerivativeListHolder_reserveColumns(DerivativeListHolder_ptr, row,maxCol,current ) BIND(C,name="DerivativeListHolder_reserveColumns")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: DerivativeListHolder_ptr;
+ integer(C_INT) :: row;
+ integer(C_INT) :: maxCol;
+ logical(C_BOOL) :: current;
+end subroutine
+subroutine f_DerivativeListHolder_reserve(DerivativeListHolder_ptr, maxRow,maxCol,current ) BIND(C,name="DerivativeListHolder_reserve")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: DerivativeListHolder_ptr;
+ integer(C_INT) :: maxRow;
+ integer(C_INT) :: maxCol;
+ logical(C_BOOL) :: current;
+end subroutine
subroutine f_DerivativeListHolder_clear(DerivativeListHolder_ptr ) BIND(C,name="DerivativeListHolder_clear")
use,intrinsic :: ISO_C_BINDING
implicit none
@@ -63,6 +79,18 @@ subroutine f_DerivativeListHolder_addSharedColumn(DerivativeListHolder_ptr, col,
integer(C_INT) :: col;
integer(C_INT) :: iso;
end subroutine
+subroutine f_DerivativeListHolder_setNotSetReturnsZero(DerivativeListHolder_ptr, empty ) BIND(C,name="DerivativeListHolder_setNotSetReturnsZero")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: DerivativeListHolder_ptr;
+ logical(C_BOOL) :: empty;
+end subroutine
+subroutine f_DerivativeListHolder_setAccumulate(DerivativeListHolder_ptr, add ) BIND(C,name="DerivativeListHolder_setAccumulate")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: DerivativeListHolder_ptr;
+ logical(C_BOOL) :: add;
+end subroutine
type(C_PTR) function f_DerivativeListHolder_initialize( )BIND(C,name="DerivativeListHolder_initialize")
use,intrinsic :: ISO_C_BINDING
implicit none
diff --git a/sammy/src/salmon/interface/fortran/DerivativeListHolder_M.f90 b/sammy/src/salmon/interface/fortran/DerivativeListHolder_M.f90
index 25d69068fc3b3292968e991bc8568782d2ed0002..6b19cf04d176026a61099914ffb4ce155ee89006 100644
--- a/sammy/src/salmon/interface/fortran/DerivativeListHolder_M.f90
+++ b/sammy/src/salmon/interface/fortran/DerivativeListHolder_M.f90
@@ -18,12 +18,18 @@ type DerivativeListHolder
procedure, pass(this) :: addDataOld => DerivativeListHolder_addDataOld
procedure, pass(this) :: getData => DerivativeListHolder_getData
procedure, pass(this) :: getDataOld => DerivativeListHolder_getDataOld
+ procedure, pass(this) :: reserveColumns => DerivativeListHolder_reserveColumns
+ procedure, pass(this) :: reserveColumnsOld => DerivativeListHolder_reserveColumnsOld
+ procedure, pass(this) :: reserve => DerivativeListHolder_reserve
+ procedure, pass(this) :: reserveOld => DerivativeListHolder_reserveOld
procedure, pass(this) :: clear => DerivativeListHolder_clear
procedure, pass(this) :: nullify => DerivativeListHolder_nullify
procedure, pass(this) :: nullifyOld => DerivativeListHolder_nullifyOld
procedure, pass(this) :: switchGrid => DerivativeListHolder_switchGrid
procedure, pass(this) :: getIsotopeForShared => DerivativeListHolder_getIsotopeForShared
procedure, pass(this) :: addSharedColumn => DerivativeListHolder_addSharedColumn
+ procedure, pass(this) :: setNotSetReturnsZero => DerivativeListHolder_setNotSetReturnsZero
+ procedure, pass(this) :: setAccumulate => DerivativeListHolder_setAccumulate
procedure, pass(this) :: initialize => DerivativeListHolder_initialize
procedure, pass(this) :: destroy => DerivativeListHolder_destroy
end type DerivativeListHolder
@@ -88,6 +94,42 @@ function DerivativeListHolder_getDataOld(this, row, col, iso) result(result2Retu
current = .false.
result2Return=f_DerivativeListHolder_getData(this%instance_ptr, row-1,col,iso-1,current)
end function
+subroutine DerivativeListHolder_reserveColumns(this, row, maxCol)
+ implicit none
+ class(DerivativeListHolder)::this
+ integer(C_INT)::row
+ integer(C_INT)::maxCol
+ logical(C_BOOL)::current
+ current=.true.
+ call f_DerivativeListHolder_reserveColumns(this%instance_ptr, row-1,maxCol,current)
+end subroutine
+subroutine DerivativeListHolder_reserveColumnsOld(this, row, maxCol)
+ implicit none
+ class(DerivativeListHolder)::this
+ integer(C_INT)::row
+ integer(C_INT)::maxCol
+ logical(C_BOOL)::current
+ current=.false.
+ call f_DerivativeListHolder_reserveColumns(this%instance_ptr, row-1,maxCol,current)
+end subroutine
+subroutine DerivativeListHolder_reserve(this, maxRow, maxCol)
+ implicit none
+ class(DerivativeListHolder)::this
+ integer(C_INT)::maxRow
+ integer(C_INT)::maxCol
+ logical(C_BOOL)::current
+ current=.true.
+ call f_DerivativeListHolder_reserve(this%instance_ptr, maxRow,maxCol,current)
+end subroutine
+subroutine DerivativeListHolder_reserveOld(this, maxRow, maxCol)
+ implicit none
+ class(DerivativeListHolder)::this
+ integer(C_INT)::maxRow
+ integer(C_INT)::maxCol
+ logical(C_BOOL)::current
+ current=.false.
+ call f_DerivativeListHolder_reserve(this%instance_ptr, maxRow,maxCol,current)
+end subroutine
subroutine DerivativeListHolder_clear(this)
implicit none
class(DerivativeListHolder)::this
@@ -126,6 +168,18 @@ subroutine DerivativeListHolder_addSharedColumn(this, col, iso)
integer(C_INT)::iso
call f_DerivativeListHolder_addSharedColumn(this%instance_ptr, col,iso-1)
end subroutine
+subroutine DerivativeListHolder_setNotSetReturnsZero(this, empty)
+ implicit none
+ class(DerivativeListHolder)::this
+ logical(C_BOOL)::empty
+ call f_DerivativeListHolder_setNotSetReturnsZero(this%instance_ptr, empty)
+end subroutine
+subroutine DerivativeListHolder_setAccumulate(this, add)
+ implicit none
+ class(DerivativeListHolder)::this
+ logical(C_BOOL)::add
+ call f_DerivativeListHolder_setAccumulate(this%instance_ptr, add)
+end subroutine
subroutine DerivativeListHolder_initialize(this)
implicit none
class(DerivativeListHolder) :: this
diff --git a/sammy/src/salmon/interface/fortran/GridData_I.f90 b/sammy/src/salmon/interface/fortran/GridData_I.f90
index 3b6109be78df2d06809c26f7288302bbd0b36d8d..96ed8dc0c1815a059027a174877de88936025c85 100644
--- a/sammy/src/salmon/interface/fortran/GridData_I.f90
+++ b/sammy/src/salmon/interface/fortran/GridData_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: Thu Jan 07 15:23:53 EST 2021
+!! Date Generated: Fri Aug 20 09:26:07 EDT 2021
!! 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
!!/
@@ -67,6 +67,18 @@ subroutine f_GridData_clearGrid(GridData_ptr ) BIND(C,name="GridData_clearGrid")
implicit none
type(C_PTR), value :: GridData_ptr;
end subroutine
+subroutine f_GridData_nullify(GridData_ptr ) BIND(C,name="GridData_nullify")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: GridData_ptr;
+end subroutine
+subroutine f_GridData_reserve(GridData_ptr, row,col ) BIND(C,name="GridData_reserve")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: GridData_ptr;
+ integer(C_INT) :: row;
+ integer(C_INT) :: col;
+end subroutine
subroutine f_GridData_addImplicitDerivs(GridData_ptr, grid ) BIND(C,name="GridData_addImplicitDerivs")
use,intrinsic :: ISO_C_BINDING
implicit none
diff --git a/sammy/src/salmon/interface/fortran/GridData_M.f90 b/sammy/src/salmon/interface/fortran/GridData_M.f90
index 040ca2b041372df62ec764b6062f4a94d6583be1..5e0d99d5c3cf3595770c0c93dd72320eadf6f33b 100644
--- a/sammy/src/salmon/interface/fortran/GridData_M.f90
+++ b/sammy/src/salmon/interface/fortran/GridData_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: Thu Jan 07 15:23:53 EST 2021
+!! Date Generated: Fri Aug 20 09:26:07 EDT 2021
!! 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
!!/
@@ -23,6 +23,8 @@ type GridData
procedure, pass(this) :: getRowMax => GridData_getRowMax
procedure, pass(this) :: setRowMax => GridData_setRowMax
procedure, pass(this) :: clearGrid => GridData_clearGrid
+ procedure, pass(this) :: nullify => GridData_nullify
+ procedure, pass(this) :: reserve => GridData_reserve
procedure, pass(this) :: addImplicitDerivs => GridData_addImplicitDerivs
procedure, pass(this) :: getImplicitDerivs => GridData_getImplicitDerivs
procedure, pass(this) :: addImplicitParCov => GridData_addImplicitParCov
@@ -109,6 +111,18 @@ subroutine GridData_clearGrid(this)
class(GridData)::this
call f_GridData_clearGrid(this%instance_ptr)
end subroutine
+subroutine GridData_nullify(this)
+ implicit none
+ class(GridData)::this
+ call f_GridData_nullify(this%instance_ptr)
+end subroutine
+subroutine GridData_reserve(this, row, col)
+ implicit none
+ class(GridData)::this
+ integer(C_INT)::row
+ integer(C_INT)::col
+ call f_GridData_reserve(this%instance_ptr, row,col)
+end subroutine
subroutine GridData_addImplicitDerivs(this, grid)
implicit none
class(GridData)::this
diff --git a/sammy/src/salmon/tests/DerivativeListTest.cpp b/sammy/src/salmon/tests/DerivativeListTest.cpp
index 5759268e9c2ae620e1383b57824ea20859e04f46..a32f41e7d2aeae99eb6f1fb9d1a329d48a1d15fb 100644
--- a/sammy/src/salmon/tests/DerivativeListTest.cpp
+++ b/sammy/src/salmon/tests/DerivativeListTest.cpp
@@ -87,7 +87,6 @@ TEST(LinkedGridDataList, basic_data){
ASSERT_TRUE(list.isSharedColumn(i));
ASSERT_TRUE(!list.isSharedColumn(i+1));
}
- ASSERT_EQ(0, list.getLength());
// clear clears everything
list.clear();
@@ -186,6 +185,82 @@ TEST(LinkedGridDataList, copySharedInfo){
ASSERT_NO_THROW(listCopy.addData(2, 5, 2, 2));
}
+
+TEST(LinkedGridDataList, setToZeroOnEmpty){
+ sammy::DerivativeList list;
+
+ // shared columns are added and repored correctly
+ int j = 0;
+ for (int i = 0; i < 10; i+= 2){
+ list.addSharedColumn(i, j);
+ j++;
+ if (j > 1) j = 0;
+ }
+
+ // add three grids
+ list.addGrid();
+ list.addGrid();
+
+ j = 0;
+ for (int i = 8; i >= 0; i-= 2){
+ for( int r = 5; r < 10; r++){
+ list.addData(r, i, j, i+r+20);
+ list.addData(r, i+1, 0, i+r+30);
+ list.addData(r, i+1, 1, i+r+40);
+ }
+ j++;
+ if (j > 1) j = 0;
+ }
+ list.addData(5, 40, 0, 40);
+ list.addData(5, 35, 0, 35);
+ ASSERT_NEAR(list.getData(5, 40,0), 40, 1e-5);
+ ASSERT_NEAR(list.getData(5, 35,0), 35, 1e-5);
+
+
+
+ j = 0;
+ for (int i = 0; i < 10; i+= 2){
+ for( int r = 5; r < 10; r++){
+ ASSERT_NEAR(list.getData(r, i, j), i+r+20, 1e-5);
+ ASSERT_NEAR(list.getData(r, i+1, 0), i+r+30, 1e-5);
+ ASSERT_NEAR(list.getData(r, i+1, 1), i+r+40, 1e-5);
+ }
+ for( int r = 0; r < 5; r++){
+ ASSERT_THROW(list.getData(r, i, j), std::runtime_error);
+ ASSERT_THROW(list.getData(r,i+1,0), std::runtime_error);
+ ASSERT_THROW(list.getData(r,i+1,1), std::runtime_error);
+ }
+ j++;
+ if (j > 1) j = 0;
+ }
+
+ // now allow zero
+ list.setNotSetReturnsZero(true);
+ j = 0;
+ for (int i = 0; i < 10; i+= 2){
+ for( int r = 0; r < 5; r++){
+ ASSERT_EQ(list.getData(r, i, j), 0.0);
+ ASSERT_EQ(list.getData(r,i+1,0), 0.0);
+ ASSERT_EQ(list.getData(r,i+1,1), 0.0);
+ }
+ j++;
+ if (j > 1) j = 0;
+ }
+
+ // nullify and test
+ list.nullify();
+ j = 0;
+ for (int i = 0; i < 10; i+= 2){
+ for( int r = 5; r < 10; r++){
+ ASSERT_EQ(list.getData(r, i, j), 0.0);
+ ASSERT_EQ(list.getData(r,i+1,0), 0.0);
+ ASSERT_EQ(list.getData(r,i+1,1), 0.0);
+ }
+ j++;
+ if (j > 1) j = 0;
+ }
+}
+
TEST(LinkedGridDataListHolder, updateShared){
sammy::DerivativeListHolder list;
@@ -394,7 +469,7 @@ TEST(LinkedGridDataList, DerivativeListHolder){
ASSERT_TRUE(list.isSharedColumn(i));
ASSERT_TRUE(!list.isSharedColumn(i+1));
}
- ASSERT_EQ(0, list.getLength());
+ ASSERT_EQ(5, list.getLength());
ASSERT_EQ(5, list.getLength(false));
list.nullify(false);
@@ -402,8 +477,8 @@ TEST(LinkedGridDataList, DerivativeListHolder){
ASSERT_TRUE(list.isSharedColumn(i));
ASSERT_TRUE(!list.isSharedColumn(i+1));
}
- ASSERT_EQ(0, list.getLength());
- ASSERT_EQ(0, list.getLength(false));
+ ASSERT_EQ(5, list.getLength());
+ ASSERT_EQ(5, list.getLength(false));
// clear
list.clear();
@@ -415,5 +490,76 @@ TEST(LinkedGridDataList, DerivativeListHolder){
ASSERT_EQ(0, list.getLength(false));
}
+TEST(LinkedGridDataListHolder, setToZeroOnEmpty){
+ sammy::DerivativeListHolder list;
+
+ // shared columns are added and repored correctly
+ int j = 0;
+ for (int i = 0; i < 10; i+= 2){
+ list.addSharedColumn(i, j);
+ j++;
+ if (j > 1) j = 0;
+ }
+
+ // add three grids
+ list.addGrid();
+ list.addGrid();
+
+ for (int ig = 0; ig < 1; ig++){
+ j = 0;
+ for (int i = 0; i < 10; i+= 2){
+ for( int r = 5; r < 10; r++){
+ list.addData(r, i, j, i+r+20);
+ list.addData(r, i+1, 0, i+r+30);
+ list.addData(r, i+1, 1, i+r+40);
+ }
+ j++;
+ if (j > 1) j = 0;
+ }
+
+ if (ig == 0){
+ j = 0;
+ for (int i = 0; i < 10; i+= 2){
+ for( int r = 0; r < 5; r++){
+ ASSERT_THROW(list.getData(r, i, j), std::runtime_error);
+ ASSERT_THROW(list.getData(r,i+1,0), std::runtime_error);
+ ASSERT_THROW(list.getData(r,i+1,1), std::runtime_error);
+ }
+ j++;
+ if (j > 1) j = 0;
+ }
+ // now allow zero
+ list.setNotSetReturnsZero(true);
+ }
+
+ j = 0;
+ for (int i = 0; i < 10; i+= 2){
+ for( int r = 0; r < 5; r++){
+ ASSERT_EQ(list.getData(r, i, j), 0.0);
+ ASSERT_EQ(list.getData(r,i+1,0), 0.0);
+ ASSERT_EQ(list.getData(r,i+1,1), 0.0);
+ }
+ j++;
+ if (j > 1) j = 0;
+ }
+
+ // nullify and test
+ list.nullify();
+ j = 0;
+ for (int i = 0; i < 10; i+= 2){
+ for( int r = 5; r < 10; r++){
+ ASSERT_EQ(list.getData(r, i, j), 0.0);
+ ASSERT_EQ(list.getData(r,i+1,0), 0.0);
+ ASSERT_EQ(list.getData(r,i+1,1), 0.0);
+ }
+ j++;
+ if (j > 1) j = 0;
+ }
+
+ list.switchGrid();
+ }
+}
+
+
diff --git a/sammy/src/salmon/tests/GridDataTest.cpp b/sammy/src/salmon/tests/GridDataTest.cpp
index f063f7d4158c6a9feddd9d0fc5520b484bdfb1d7..c8eb9ab26ac61dece1e148d62eea813c4bb304e0 100644
--- a/sammy/src/salmon/tests/GridDataTest.cpp
+++ b/sammy/src/salmon/tests/GridDataTest.cpp
@@ -21,7 +21,7 @@ TEST(GridDataSetter,gridData){
xx = 1.0;
for ( int i = 10; i < 20; i++ ){
for ( int j = 5; j < 20; j++){
- ASSERT_NEAR(xx, grid.getData(i,j), 1e-3);
+ ASSERT_NEAR(xx, grid.getData(i,j), 1e-5);
xx += 0.1;
}
}
@@ -46,6 +46,14 @@ TEST(GridDataSetter,gridData){
}
}
+ // now nullify
+ grid.nullify();
+ for ( int i = 10; i < 20; i++ ){
+ for ( int j = 5; j < 20; j++){
+ ASSERT_NEAR(0.0, grid.getData(i,j), 1e-5);
+ }
+ }
+
// clear all data
grid.clearGrid();
for ( int i = 10; i < 20; i++ ){
@@ -55,6 +63,27 @@ TEST(GridDataSetter,gridData){
}
+ // and a reserve
+ sammy::GridData gridReserve;
+ gridReserve.reserve(20, 2);
+ for ( int i = 0; i < 20; i++ ){
+ for ( int j = 0; j < 2; j++){
+ ASSERT_NEAR(0.0, gridReserve.getData(i,j), 1e-5);
+ gridReserve.addData(i, j, 1.0);
+ }
+ }
+ gridReserve.reserve(25, 3);
+ for ( int i = 0; i < 20; i++ ){
+ for ( int j = 0; j < 2; j++){
+ ASSERT_NEAR(1.0, gridReserve.getData(i,j), 1e-5);
+ }
+ ASSERT_NEAR(0.0, gridReserve.getData(i,2), 1e-3);
+ }
+ for ( int i = 20; i < 25; i++ ){
+ for ( int j = 0; j < 3; j++){
+ ASSERT_NEAR(0.0, gridReserve.getData(i,j), 1e-5);
+ }
+ }
}
@@ -88,7 +117,7 @@ TEST(DataInfo,gridData){
xx = 1.0;
for (int i = 0; i < 5; i++){
for( int j = 0; j < 3; j++){
- ASSERT_NEAR(xx, gridCopy.getData(i, j), 1e-3);
+ ASSERT_NEAR(xx, gridCopy.getData(i, j), 1e-5);
xx += 0.1;
}
}
@@ -98,6 +127,32 @@ TEST(DataInfo,gridData){
ASSERT_THROW(grid.addData(1, -5, 4.4), std::runtime_error);
}
+TEST(notSetReturnsZero,gridData){
+ sammy::GridData grid;
+
+ ASSERT_THROW(grid.getData(5,7), std::runtime_error);
+ grid.setNotSetReturnsZero(true);
+ ASSERT_EQ(0.0, grid.getData(5,7));
+
+ grid.addData(5,7, 6.0);
+ ASSERT_NEAR(6.0, grid.getData(5,7), 1e-5);
+ grid.setNotSetReturnsZero(false);
+ ASSERT_NEAR(6.0, grid.getData(5,7), 1e-5);
+
+ ASSERT_THROW(grid.getData(5,8), std::runtime_error);
+
+ // and a copy
+ grid.setNotSetReturnsZero(true);
+ sammy::GridData gridCopy(grid);
+ ASSERT_EQ(0.0, grid.getData(5,8));
+
+ grid.setNotSetReturnsZero(false);
+ sammy::GridData gridCopy2(grid);
+ ASSERT_THROW(grid.getData(5,8), std::runtime_error);
+}
+
+
+
TEST(GridList, gridDataList){
sammy::GridDataList list;
@@ -127,7 +182,7 @@ TEST(GridList, gridDataList){
for( int j = 0; j < 2; j++){
ASSERT_NEAR(i+1, grid->getData(j,1), 1e-3);
- ASSERT_NEAR( i+5, list.getExperimentalCov(i*3, j), 1e-3);
+ ASSERT_NEAR( i+5, list.getExperimentalCov(i*3, j), 1e-5);
}
}
}
@@ -196,4 +251,31 @@ TEST(GridData, getImplicitParCov){
checkImplictParCov(gridDataCopy.getImplicitParCov());
}
+TEST(notSetReturnsZero,gridDataList){
+ sammy::GridDataList gridList;
+
+ std::unique_ptr<sammy::GridData> grid = nemesis::make_unique<sammy::GridData>();
+ grid->setNotSetReturnsZero(true);
+ gridList.addGrid(grid);
+
+ ASSERT_THROW(gridList.getGrid(0)->getData(5,7), std::runtime_error);
+
+ gridList.setNotSetReturnsZero(true);
+ ASSERT_EQ(0.0, gridList.getGrid(0)->getData(5,7));
+
+ grid = nemesis::make_unique<sammy::GridData>();
+ grid->setNotSetReturnsZero(false);
+ gridList.addGrid(grid);
+ ASSERT_EQ(0.0, gridList.getGrid(1)->getData(5,7));
+
+ gridList.setNotSetReturnsZero(false);
+ ASSERT_THROW(gridList.getGrid(0)->getData(5,7), std::runtime_error);
+ ASSERT_THROW(gridList.getGrid(1)->getData(5,7), std::runtime_error);
+
+ gridList.setNotSetReturnsZero(true);
+ ASSERT_EQ(0.0, gridList.getGrid(0)->getData(5,7));
+ ASSERT_EQ(0.0, gridList.getGrid(1)->getData(5,7));
+}
+
+
diff --git a/sammy/src/smc/msmc0.f b/sammy/src/smc/msmc0.f
index c40bb99ea8ffba5c468870747c1ae41c6c510032..8bb96e973e2179c400480aa97088dc138105f144 100644
--- a/sammy/src/smc/msmc0.f
+++ b/sammy/src/smc/msmc0.f
@@ -51,7 +51,7 @@ C *** Construct the energy scale
I2 = 1 + (Eh-El)/De
if (expData%getLength().gt.0) then
call expData%getGrid(grid, 1)
- call grid%clearGrid()
+ call grid%nullify()
else
call grid%initialize()
call expData%addGrid(grid)
@@ -72,7 +72,7 @@ C *** Read the energy scale from a file
11100 FORMAT (I6)
if (expData%getLength().gt.0) then
call expData%getGrid(grid, 1)
- call grid%clearGrid()
+ call grid%nullify()
else
call grid%initialize()
call expData%addGrid(grid)
@@ -248,7 +248,7 @@ C *** set energy scale if needed
IF (Kkkuse.EQ.1) THEN
if (expData%getLength().gt.0) then
call expData%getGrid(grid, 1)
- call grid%clearGrid()
+ call grid%nullify()
else
call grid%initialize()
call expData%addGrid(grid)
diff --git a/sammy/src/ssm/mssm18.f90 b/sammy/src/ssm/mssm18.f90
index 191454a1504ffd4184e669f31e8b46d00c7eb32b..58a9b7d8d6071f720b3120799f71dfaeff03873e 100644
--- a/sammy/src/ssm/mssm18.f90
+++ b/sammy/src/ssm/mssm18.f90
@@ -332,6 +332,7 @@ module ssm_18_m
Kk = Kk + 1
IF (dABS(auxGrid%getEnergy(K, expData)-Em).LT.De) THEN
val = derivs%getData(Kk, 0, 1)
+ call derivs%reserveColumns(Jj, Ndasig+Ndbsig+1) ! derivs + cross
call derivs%addData(Jj, 0, 1, val)
Theory(Jj) = val
IF (Ndasig.GT.0) THEN
@@ -360,6 +361,7 @@ module ssm_18_m
A = A/D
B = B/D
val = derivs%getData(Kk, 0, 1) * B + derivs%getData(Kk-1, 0, 1) * A
+ call derivs%reserveColumns(Jj, Ndasig+Ndbsig+1) ! derivs + cross
call derivs%addData(Jj, 0, 1, val)
Theory(Jj) = val
IF (Ndasig.GT.0) THEN
diff --git a/sammy/src/the/DerivativeHandler.cpp b/sammy/src/the/DerivativeHandler.cpp
index 93b07b70090ed49ae573961bba784c2200327879..cdc52c745bd2a918b3e3165f54e6dcbd8e14778f 100644
--- a/sammy/src/the/DerivativeHandler.cpp
+++ b/sammy/src/the/DerivativeHandler.cpp
@@ -1,8 +1,9 @@
#include "DerivativeHandler.h"
namespace sammy{
- void DerivativeHandler::setUpList(SammyRMatrixParameters & params, int num){
- int numIso = params.getNumIso();
+
+ void DerivativeHandler::setUpList(SammyRMatrixParameters & params, AdjustedRadiusData & radii, int num){
+ int numIso = params.getNumIso();
if (numIso < num) numIso = num;
if (num == 1) numIso = 1; // numIso is sometimes redefined - why oh why
if (numIso <= 1) {
@@ -12,29 +13,98 @@ namespace sammy{
// add indices for resonance parameters
// they are shared across isotopes
- for ( int ires = 0; ires < params.getNumResonances(); ires++){
+ for ( int ires = 0; ires < params.getNumResonances(); ires++){
sammy::SammyResonanceInfo * resInfo = params.getResonanceInfo(ires);
- if (!resInfo->getIncludeInCalc()) continue;
- if (!resInfo->hasAnyVariedParams()) continue;
+ bool includeInCalc = true;
+
+ if (!resInfo->getIncludeInCalc()) includeInCalc = false;
+ if (!resInfo->hasAnyVariedParams()) includeInCalc = false;
+
+ int igr = resInfo->getSpinGroupIndex();
+ sammy::SammySpinGroupInfo *spinInfo = params.getSpinGroupInfo(igr);
+ if (!spinInfo->getIncludeInCalc()) includeInCalc = false;
- int igr = resInfo->getSpinGroupIndex();
- sammy::SammySpinGroupInfo *spinInfo = params.getSpinGroupInfo(igr);
- if (!spinInfo->getIncludeInCalc()) continue;
+ int iso = spinInfo->getIsotopeIndex();
+
+ // this allows legacy SAMMY to work. This shouldn't have been flagged
+ if (!includeInCalc) iso = 0;
+
+ int iflGam = spinInfo->getGammaWidthIndex();
+ if (iflGam > 0){
+ addSharedColumn(iflGam, iso);
+ }
int ifl = resInfo->getEnergyFitOption();
if (ifl > 0){
- addSharedColumn(ifl, spinInfo->getIsotopeIndex());
+ addSharedColumn(ifl, iso);
}
int ichan = spinInfo->getAllChannels();
for (int ic = 0; ic < ichan; ic++){
ifl = resInfo->getChannelFitOption(ic);
+ if (ifl == iflGam) continue;
+ if (ifl > 0){
+ addSharedColumn(ifl, iso);
+ }
+ }
+ }
+
+ // r-external
+ for (int iext = 0; iext < params.getNumRext(); iext++){
+ sammy::SammyRExternalInfo * resInfo = params.getRextInfo(iext);
+ int igr = resInfo->getGrp();
+ sammy::SammySpinGroupInfo * spinInfo = params.getSpinGroupInfo(igr);
+ int iso = spinInfo->getIsotopeIndex();
+
+ for ( int i = 1; i <= 7; i++){
+ int ifl = resInfo->getIflSammyIndex(i);
if (ifl > 0){
- addSharedColumn(ifl, spinInfo->getIsotopeIndex());
+ addSharedColumn(ifl, iso);
}
}
}
+ // radius info
+ int nn = radii.getNumRadInfo();
+ for (int ir = 0; ir < nn; ir++){
+ int iflTrue, iflEff;
+ iflTrue = radii.getTrueFitFlagByIndex(ir);
+ iflEff = radii.getEffFitFlagByIndex(ir);
+ if (radii.trueEqualToEff(ir)) iflTrue = 0;
+ if (radii.hasMatchingRadius()) iflTrue = 0;
+
+ if (iflEff <= 0 && iflTrue <= 0) continue;
+
+
+ if (radii.getNumGroups(ir) == 0) continue;
+ int igr = radii.getGroupIndex(ir, 0); // take istope from first group
+ sammy::SammySpinGroupInfo * spinInfo = params.getSpinGroupInfo(igr);
+ int iso = spinInfo->getIsotopeIndex();
+
+ if (iflTrue > 0){
+ addSharedColumn(iflTrue, iso);
+ }
+ if (iflEff > 0){
+ addSharedColumn(iflEff, iso);
+ }
+ }
+
+ // matching radius, add to first isotope
+ if (nn == 0 || radii.hasMatchingRadius()){
+ int ifl = radii.matchFitFlag();
+ if (ifl > 0){
+ addSharedColumn(ifl, 0);
+ }
+ }
+
+ // abundances
+ for (int iso = 0; iso < params.getNumIso(); iso++){
+ int ifl = params.getIsoInfo(iso)->getFitOption();
+ if (ifl > 0){
+ addSharedColumn(ifl, iso);
+ }
+ }
+
while ( getGridNumber() < numIso) addGrid();
}
@@ -54,6 +124,11 @@ namespace sammy{
}
}
+ void DerivativeHandler::reserveColumnsNs(int row, int ns, int maxCol, bool current){
+ int ipos = row * nnsig + ns;
+ reserveColumns(ipos, maxCol, current);
+ }
+
double DerivativeHandler::getSharedDataVal(int row, int col, bool current) const{
int posOur = getIsotopeForShared(col);
if (posOur < 0) posOur = 0;
@@ -120,7 +195,7 @@ namespace sammy{
}
double DerivativeHandler::getDataNs(int row, int ns, int col, int iso, bool current) const{
- int ipos = row * nnsig + ns;
+ int ipos = row * nnsig + ns;
return getData(ipos, col, iso, current);
}
}
diff --git a/sammy/src/the/DerivativeHandler.h b/sammy/src/the/DerivativeHandler.h
index b1d0e711f7855f7db186ee406e4c31b2cdc42600..7ee9d4c18332f2f8f7c8ce5f967a1b2f5ddcd628 100644
--- a/sammy/src/the/DerivativeHandler.h
+++ b/sammy/src/the/DerivativeHandler.h
@@ -3,6 +3,7 @@
#include "salmon/DerivativeList.h"
#include "endf/SammyRMatrixParameters.h"
+#include "endf/AdjustedRadiusData.h"
namespace sammy{
@@ -57,8 +58,8 @@ namespace sammy{
*
* @param params the resonance parameter information
* @param num the number of isotopes
- */
- void setUpList(SammyRMatrixParameters & params, int num=0);
+ */
+ void setUpList(SammyRMatrixParameters & params, AdjustedRadiusData & radii, int num=0);
/**
* Set the data for the indicated row to zero
@@ -132,6 +133,16 @@ namespace sammy{
*/
void setNnsig(int nnsig);
+
+ /**
+ * Make sure the indicated row as at least maxCol data.
+ * If not set, additional columns are set to zero
+ *
+ * @param row the row for which to set the data
+ * @param maxCol the maximum number of columns
+ */
+ void reserveColumnsNs(int row, int ns, int maxCol, bool current = true);
+
/**
* Same as getSharedDataVal, except return the value for row=((row-1)*getNnnsig() +ns)
*
diff --git a/sammy/src/the/interface/cix/DerivativeHandler.cpp2f.xml b/sammy/src/the/interface/cix/DerivativeHandler.cpp2f.xml
index 2119ed6fb920d141a3527be6aeabaa41c3f12ecc..25f7abe003a44c139c9a65796fd96050442452b3 100644
--- a/sammy/src/the/interface/cix/DerivativeHandler.cpp2f.xml
+++ b/sammy/src/the/interface/cix/DerivativeHandler.cpp2f.xml
@@ -5,6 +5,7 @@
<class name="DerivativeHandler" parent="DerivativeListHolder">
<method name="setUpList">
<param name="params" type="SammyRMatrixParameters"/>
+ <param name="radii" type="AdjustedRadiusData"/>
<param name="num" type="int"/>
</method>
<method name="setToZero">
@@ -52,6 +53,12 @@
<param name="value" type="double"/>
<param name="current" type="bool"/>
</method>
+ <method name="reserveColumnsNs">
+ <param name="row" type="int" offset="-1"/>
+ <param name="ns" type="int" offset="-1"/>
+ <param name="maxCol" type="int"/>
+ <param name="current" type="bool"/>
+ </method>
<method name="addDataNs">
<param name="row" type="int" offset="-1"/>
<param name="ns" type="int" offset="-1"/>
diff --git a/sammy/src/the/interface/cpp/DerivativeHandlerInterface.cpp b/sammy/src/the/interface/cpp/DerivativeHandlerInterface.cpp
index 054ace3773a40e8148591ef942fddf9a0914fd97..bf20c24393bb31c8cd5a9943f1fb831b5d262e77 100644
--- a/sammy/src/the/interface/cpp/DerivativeHandlerInterface.cpp
+++ b/sammy/src/the/interface/cpp/DerivativeHandlerInterface.cpp
@@ -2,16 +2,16 @@
* 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: Mon Apr 26 18:06:30 EDT 2021
+* Date Generated: Fri Aug 20 14:16:52 EDT 2021
* 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
*/
#include <string.h>
#include "DerivativeHandlerInterface.h"
using namespace sammy;
-void DerivativeHandler_setUpList(void * DerivativeHandler_ptr,SammyRMatrixParameters * params,int * num)
+void DerivativeHandler_setUpList(void * DerivativeHandler_ptr,SammyRMatrixParameters * params,AdjustedRadiusData * radii,int * num)
{
- ((DerivativeHandler*)DerivativeHandler_ptr)->setUpList(*params,*num);
+ ((DerivativeHandler*)DerivativeHandler_ptr)->setUpList(*params,*radii,*num);
}
void DerivativeHandler_setToZero(void * DerivativeHandler_ptr,int * row,int * maxIfl,bool * current)
@@ -64,14 +64,19 @@ void DerivativeHandler_setSharedValNs(void * DerivativeHandler_ptr,int * row,int
((DerivativeHandler*)DerivativeHandler_ptr)->setSharedValNs(*row,*ns,*col,*value,*current);
}
-void DerivativeHandler_addDataNs(void * DerivativeHandler_ptr,int * row,int * ns,int * col,int * index,double * value,bool * current)
+void DerivativeHandler_reserveColumnsNs(void * DerivativeHandler_ptr,int * row,int * ns,int * maxCol,bool * current)
{
- ((DerivativeHandler*)DerivativeHandler_ptr)->addDataNs(*row,*ns,*col,*index,*value,*current);
+ ((DerivativeHandler*)DerivativeHandler_ptr)->reserveColumnsNs(*row,*ns,*maxCol,*current);
}
-double DerivativeHandler_getDataNs(void * DerivativeHandler_ptr,int * row,int * ns,int * col,int * index,bool * current)
+void DerivativeHandler_addDataNs(void * DerivativeHandler_ptr,int * row,int * ns,int * col,int * iso,double * value,bool * current)
{
- return ((DerivativeHandler*)DerivativeHandler_ptr)->getDataNs(*row,*ns,*col,*index,*current);
+ ((DerivativeHandler*)DerivativeHandler_ptr)->addDataNs(*row,*ns,*col,*iso,*value,*current);
+}
+
+double DerivativeHandler_getDataNs(void * DerivativeHandler_ptr,int * row,int * ns,int * col,int * iso,bool * current)
+{
+ return ((DerivativeHandler*)DerivativeHandler_ptr)->getDataNs(*row,*ns,*col,*iso,*current);
}
void* DerivativeHandler_initialize()
diff --git a/sammy/src/the/interface/cpp/DerivativeHandlerInterface.h b/sammy/src/the/interface/cpp/DerivativeHandlerInterface.h
index 243e1e5f7308b9f00beb8da7de95bc160973677f..808fde4fc998a72f3d20f30c055ba9ac6f1d5073 100644
--- a/sammy/src/the/interface/cpp/DerivativeHandlerInterface.h
+++ b/sammy/src/the/interface/cpp/DerivativeHandlerInterface.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: Mon Apr 26 18:06:30 EDT 2021
+* Date Generated: Fri Aug 20 14:16:51 EDT 2021
* 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
*/
@@ -13,7 +13,7 @@ using namespace sammy;
#ifdef __cplusplus
extern "C" {
#endif
-void DerivativeHandler_setUpList(void * DerivativeHandler_ptr,SammyRMatrixParameters * params,int * num);
+void DerivativeHandler_setUpList(void * DerivativeHandler_ptr,SammyRMatrixParameters * params,AdjustedRadiusData * radii,int * num);
void DerivativeHandler_setToZero(void * DerivativeHandler_ptr,int * row,int * maxIfl,bool * current);
double DerivativeHandler_getSharedDataVal(void * DerivativeHandler_ptr,int * row,int * col,bool * current);
void DerivativeHandler_setSharedDataVal(void * DerivativeHandler_ptr,int * row,int * col,double * value,bool * current);
@@ -24,8 +24,9 @@ int DerivativeHandler_getNnnsig(void * DerivativeHandler_ptr);
void DerivativeHandler_setNnsig(void * DerivativeHandler_ptr,int * nnsig);
double DerivativeHandler_getSharedValNs(void * DerivativeHandler_ptr,int * row,int * ns,int * col,bool * current);
void DerivativeHandler_setSharedValNs(void * DerivativeHandler_ptr,int * row,int * ns,int * col,double * value,bool * current);
-void DerivativeHandler_addDataNs(void * DerivativeHandler_ptr,int * row,int * ns,int * col,int * index,double * value,bool * current);
-double DerivativeHandler_getDataNs(void * DerivativeHandler_ptr,int * row,int * ns,int * col,int * index,bool * current);
+void DerivativeHandler_reserveColumnsNs(void * DerivativeHandler_ptr,int * row,int * ns,int * maxCol,bool * current);
+void DerivativeHandler_addDataNs(void * DerivativeHandler_ptr,int * row,int * ns,int * col,int * iso,double * value,bool * current);
+double DerivativeHandler_getDataNs(void * DerivativeHandler_ptr,int * row,int * ns,int * col,int * iso,bool * current);
void* DerivativeHandler_initialize();
void DerivativeHandler_destroy(void * DerivativeHandler_ptr);
#ifdef __cplusplus
diff --git a/sammy/src/the/interface/fortran/DerivativeHandler_I.f90 b/sammy/src/the/interface/fortran/DerivativeHandler_I.f90
index 88e3a44670502ab87252aec377c7b1b02c3561c4..00e30e462d882bdb54f1497f88af18803dbdecf4 100644
--- a/sammy/src/the/interface/fortran/DerivativeHandler_I.f90
+++ b/sammy/src/the/interface/fortran/DerivativeHandler_I.f90
@@ -2,18 +2,19 @@
!! 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: Mon Apr 26 18:06:30 EDT 2021
+!! Date Generated: Fri Aug 20 14:16:52 EDT 2021
!! 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
!!/
module DerivativeHandler_I
use, intrinsic :: ISO_C_BINDING
interface
-subroutine f_DerivativeHandler_setUpList(DerivativeHandler_ptr, params,num ) BIND(C,name="DerivativeHandler_setUpList")
+subroutine f_DerivativeHandler_setUpList(DerivativeHandler_ptr, params,radii,num ) BIND(C,name="DerivativeHandler_setUpList")
use,intrinsic :: ISO_C_BINDING
implicit none
type(C_PTR), value :: DerivativeHandler_ptr;
type(C_PTR), value :: params;
+ type(C_PTR), value :: radii;
integer(C_INT) :: num;
end subroutine
subroutine f_DerivativeHandler_setToZero(DerivativeHandler_ptr, row,maxIfl,current ) BIND(C,name="DerivativeHandler_setToZero")
@@ -92,6 +93,15 @@ subroutine f_DerivativeHandler_setSharedValNs(DerivativeHandler_ptr, row,ns,col,
real(C_DOUBLE) :: value;
logical(C_BOOL) :: current;
end subroutine
+subroutine f_DerivativeHandler_reserveColumnsNs(DerivativeHandler_ptr, row,ns,maxCol,current ) BIND(C,name="DerivativeHandler_reserveColumnsNs")
+ use,intrinsic :: ISO_C_BINDING
+ implicit none
+ type(C_PTR), value :: DerivativeHandler_ptr;
+ integer(C_INT) :: row;
+ integer(C_INT) :: ns;
+ integer(C_INT) :: maxCol;
+ logical(C_BOOL) :: current;
+end subroutine
subroutine f_DerivativeHandler_addDataNs(DerivativeHandler_ptr, row,ns,col,iso,value,current ) BIND(C,name="DerivativeHandler_addDataNs")
use,intrinsic :: ISO_C_BINDING
implicit none
diff --git a/sammy/src/the/interface/fortran/DerivativeHandler_M.f90 b/sammy/src/the/interface/fortran/DerivativeHandler_M.f90
index c220f1d8ff446cab0a472ed7ddd57a5d9a430c72..ac6b94b1f0de63aa555a287a067071ac905bae9e 100644
--- a/sammy/src/the/interface/fortran/DerivativeHandler_M.f90
+++ b/sammy/src/the/interface/fortran/DerivativeHandler_M.f90
@@ -11,6 +11,7 @@ use, intrinsic :: ISO_C_BINDING
use DerivativeHandler_I
use DerivativeListHolder_M
use SammyRMatrixParameters_M
+use AdjustedRadiusData_M
type , extends(DerivativeListHolder) :: DerivativeHandler
contains
procedure, pass(this) :: setUpList => DerivativeHandler_setUpList
@@ -29,6 +30,8 @@ type , extends(DerivativeListHolder) :: DerivativeHandler
procedure, pass(this) :: getSharedValNsOld => DerivativeHandler_getSharedValNsOld
procedure, pass(this) :: setSharedValNs => DerivativeHandler_setSharedValNs
procedure, pass(this) :: setSharedValNsOld => DerivativeHandler_setSharedValNsOld
+ procedure, pass(this) :: reserveColumnsNs => DerivativeHandler_reserveColumnsNs
+ procedure, pass(this) :: reserveColumnsNsOld => DerivativeHandler_reserveColumnsNsOld
procedure, pass(this) :: addDataNs => DerivativeHandler_addDataNs
procedure, pass(this) :: addDataNsOld => DerivativeHandler_addDataNsOld
procedure, pass(this) :: getDataNs => DerivativeHandler_getDataNs
@@ -40,12 +43,13 @@ type , extends(DerivativeListHolder) :: DerivativeHandler
procedure, pass(this) :: destroy => DerivativeHandler_destroy
end type DerivativeHandler
contains
-subroutine DerivativeHandler_setUpList(this, params, num)
+subroutine DerivativeHandler_setUpList(this, params, radii, num)
implicit none
class(DerivativeHandler)::this
class(SammyRMatrixParameters)::params
+ class(AdjustedRadiusData)::radii
integer(C_INT)::num
- call f_DerivativeHandler_setUpList(this%instance_ptr, params%instance_ptr,num)
+ call f_DerivativeHandler_setUpList(this%instance_ptr, params%instance_ptr, radii%instance_ptr, num)
end subroutine
subroutine DerivativeHandler_setToZero(this, row, maxIfl)
implicit none
@@ -187,6 +191,26 @@ subroutine DerivativeHandler_setSharedValNsOld(this, row, ns, col, value)
current=.false.
call f_DerivativeHandler_setSharedValNs(this%instance_ptr, row-1,ns-1,col,value,current)
end subroutine
+subroutine DerivativeHandler_reserveColumnsNs(this, row, ns, maxCol)
+ implicit none
+ class(DerivativeHandler)::this
+ integer(C_INT)::row
+ integer(C_INT)::ns
+ integer(C_INT)::maxCol
+ logical(C_BOOL)::current
+ current = .true.
+ call f_DerivativeHandler_reserveColumnsNs(this%instance_ptr, row-1,ns-1,maxCol,current)
+end subroutine
+subroutine DerivativeHandler_reserveColumnsNsOld(this, row, ns, maxCol)
+ implicit none
+ class(DerivativeHandler)::this
+ integer(C_INT)::row
+ integer(C_INT)::ns
+ integer(C_INT)::maxCol
+ logical(C_BOOL)::current
+ current = .false.
+ call f_DerivativeHandler_reserveColumnsNs(this%instance_ptr, row-1,ns-1,maxCol,current)
+end subroutine
subroutine DerivativeHandler_addDataNs(this, row, ns, col, iso, value)
implicit none
class(DerivativeHandler)::this
@@ -264,18 +288,19 @@ subroutine DerivativeHandler_addCalculatedData(this, row, nnsig, ndasig, ndbsig,
ourIso = iso
if (ourIso.lt.0) ourIso = 1
do Jsig = 1,nnsig
+ call this%reserveColumnsNs(row, Jsig, Ndasig+Ndbsig)
call this%addDataNs(row, Jsig, 0, ourIso, Sigx(Jsig))
DO Iipar=1,Ndasig
isop = -1 ! indicate the shared value is to be set
if (iso.ge.0) then
isop = this%getIsotopeForShared(Iipar)
if (isop.le.0) isop = 1 ! for one-isotope problems we don't use shared column
- end if
+ end if
if (iso.eq.isop) then
call this%setSharedValNs(row, Jsig, Iipar, Dasigx(jsig,Iipar))
end if
end do
- DO Iipar=1,Ndbsig
+ DO Iipar=1,Ndbsig
call this%addDataNs(row, Jsig, Iipar + Ndasig, ourIso, Dbsigx(Jsig,Iipar))
end do
end do
@@ -297,7 +322,7 @@ subroutine DerivativeHandler_getCalculatedData(this, row, nnsig, ndasig, ndbsig,
DO Iipar=0,Ndasig + Ndbsig
sharedIso = this%getIsotopeForShared(Iipar)
if (sharedIso.le.0) sharedIso = 1
- if (iso.gt.0) sharedIso = iso
+ if (iso.gt.0) sharedIso = iso
val = this%getDataNs(row, Jsig, Iipar, sharedIso)
if (Iipar.eq.0) then
Sigx(Jsig) = val
@@ -325,7 +350,7 @@ subroutine DerivativeHandler_getCalculatedDataOld(this, row, nnsig, ndasig, ndbs
DO Iipar=0,Ndasig + Ndbsig
sharedIso = this%getIsotopeForShared(Iipar)
if (sharedIso.le.0) sharedIso = 1
- if (iso.gt.0) sharedIso = iso
+ if (iso.gt.0) sharedIso = iso
val = this%getDataNsOld(row, Jsig, Iipar, sharedIso)
if (Iipar.eq.0) then
Sigx(Jsig) = val
diff --git a/sammy/src/xct/mxct0.f90 b/sammy/src/xct/mxct0.f90
index eca02d705f40db881e5f694506bb24446e69d428..f68ced6bf968c037d0cdfec72fa6647700292715 100644
--- a/sammy/src/xct/mxct0.f90
+++ b/sammy/src/xct/mxct0.f90
@@ -142,12 +142,8 @@ module xct_m
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - <
IF (Ksolve.NE.2 .OR. covData%getPupedParam().GT.0) THEN
Ks_Res = 0
- ng = resParData%getNumSpinGroups()
- call allocate_integer_data(I_Inpxdr, Ng)
Krext = Nrext
IF (Nrext.EQ.0) Krext = 1
- CALL Ppar ( I_Iflext, I_Inpxdr, Krext)
-! *** Sbroutine Ppar Sets Npxdr
ELSE
Ks_Res = 2
END IF
diff --git a/sammy/src/xct/mxct01.f90 b/sammy/src/xct/mxct01.f90
index f0bf01639967f675dc03e92df6e270c8f70d8a4f..07d9d7300edee34280b390900643002c6363871d 100755
--- a/sammy/src/xct/mxct01.f90
+++ b/sammy/src/xct/mxct01.f90
@@ -2,43 +2,6 @@
module xct1_m
contains
!
-! --------------------------------------------------------------
-!
- SUBROUTINE Ppar (Iflext, Npxdr, Krext)
-!
-! *** Purpose --
-! *** and Npxdr(K) = number of varied external parameters in group K
-!
- use fixedi_m
- use ifwrit_m
- use EndfData_common_m
- use SammyResonanceInfo_M
- IMPLICIT DOUBLE PRECISION (a-h,o-z)
-!
- type(SammyResonanceInfo)::resInfo
- type(SammySpinGroupInfo)::spinInfo
- DIMENSION Iflext(Krext,Ntotc,*), Npxdr(*)
-!
-! DIMENSION Iflext(.,.,Ngroup)
-!
-!
- CALL Zero_Integer (Npxdr, resParData%getNumSpinGroups())
-!
- IF (Nfpext.GT.0) THEN
- DO Igr=1,resParData%getNumSpinGroups()
- call resparData%getSpinGroupInfo(spinInfo, igr)
- N = spinInfo%getNumChannels()
- DO J=1,N
- IF (Iflext(1,J,Igr).NE.-1) Npxdr(Igr) = 1
- END DO
- END DO
- END IF
-!
- RETURN
-!
-!
- END
-!
!
! --------------------------------------------------------------
!
diff --git a/sammy/src/xct/mxct02.f90 b/sammy/src/xct/mxct02.f90
index 22aa1f17a4c1fd36164cd3acda468b329ce9baf5..96969d90f0cd51f49125c180c6af38a64bc3fbd3 100644
--- a/sammy/src/xct/mxct02.f90
+++ b/sammy/src/xct/mxct02.f90
@@ -99,7 +99,7 @@ module xct2_m
call derivs%addSharedColumn(Iipar, 1)
end do
end if
- call derivs%setUpList(resParData, Iq_Iso)
+ call derivs%setUpList(resParData, radFitFlags, Iq_Iso)
IF (Iw.EQ.1.or.Ksitmp.gt.0) THEN
call derivsSelf%nullify()
@@ -109,7 +109,7 @@ module xct2_m
call derivsSelf%addSharedColumn(Iipar, 1)
end do
end if
- call derivsSelf%setUpList(resParData, Iq_Iso)
+ call derivsSelf%setUpList(resParData, radFitFlags, Iq_Iso)
end if
CALL Zero_Integer (Isopar, Ndasig)
diff --git a/sammy/src/xct/mxct03.f90 b/sammy/src/xct/mxct03.f90
index dd2197ba03fd15868932b556250d29af0d87fdea..c712c626d0874fda7944301ae8f615f85ea42b4a 100644
--- a/sammy/src/xct/mxct03.f90
+++ b/sammy/src/xct/mxct03.f90
@@ -59,7 +59,7 @@ module xct3_m
A_Ibound , A_Iechan , I_Ifcros , &
A_Iprmsc , I_Iflmsc , I_Ijkmsc , A_Izke , &
A_Izeta , &
- I_Inpxdr , A_Icrss , A_Ideriv , &
+ A_Icrss , A_Ideriv , &
A_Icrssx , A_Idervx , A_Iprer , A_Iprei , A_Ixdrcp , &
I_Indrcp , Nnndrc, 0, Kount_Helmut)
!
@@ -149,7 +149,6 @@ module xct3_m
I_Ifcros , &
A_Iprmsc , I_Iflmsc , I_Ijkmsc , A_Izke , &
A_Izeta , &
- I_Inpxdr , &
A_Icrsnd , A_Ideriv , A_Icrxnd , A_Idervx , &
A_Iprer , A_Iprei , A_Ixdrcp , I_Indrcp , &
Nnndrc, 0, Kount_Helmut)
diff --git a/sammy/src/xct/mxct04.f90 b/sammy/src/xct/mxct04.f90
index 457aba5b320280998a93905ee63d9b6022107419..79388415cbb7b053a9ce9bcc398bdced5377c074 100644
--- a/sammy/src/xct/mxct04.f90
+++ b/sammy/src/xct/mxct04.f90
@@ -78,7 +78,7 @@ module xct4_m
A_Ibound , A_Iechan , I_Ifcros , &
A_Iprmsc , I_Iflmsc , I_Ijkmsc , A_Izke , &
A_Izeta , &
- I_Inpxdr , A_Icrss , A_Ideriv , &
+ A_Icrss , A_Ideriv , &
A_Icrssx , A_Idervx , A_Iprer , A_Iprei , A_Ixdrcp , &
I_Indrcp , Nnndrc, Ipoten, Kount_Helmut)
!
diff --git a/sammy/src/xct/mxct06.f b/sammy/src/xct/mxct06.f
index 28a3e0ab3f8e23bac9d9a022fa763ed536c4a0cc..f2f984304734fdd01321294b2cca5297f294663d 100644
--- a/sammy/src/xct/mxct06.f
+++ b/sammy/src/xct/mxct06.f
@@ -6,7 +6,7 @@ C
* Jfexcl, Bound , Echan ,
* Jfcros, Parmsc, Jflmsc , Jjkmsc , Zke ,
* Zeta ,
- * Npxdr , Crss , Deriv , Crssx , Derivx , Prer , Prei ,
+ * Crss , Deriv , Crssx , Derivx , Prer , Prei ,
* Xdrcpt, Ndrcpt, Nnndrc, Ipoten, Kount_Helmut)
C
C *** PURPOSE -- Form the cross sections Crss(Isigma,Igroup) and the
@@ -26,6 +26,7 @@ C
use EndfData_common_m
use SammySpinGroupInfo_M
use SammyResonanceInfo_M
+ use SammyRExternalInfo_M
use ifsubs_common
use par_parameter_names_common_m
use templc_common_m, only : I_Inotu
@@ -39,7 +40,7 @@ C
* Crssx, Derivx, Prer, Prei, Xdrcpt
real(8), intent(out):: Crss, Deriv
integer(4), intent(in):: Jfexcl, Jfcros, Jflmsc, Jjkmsc,
- * Npxdr, Ndrcpt,
+ * Ndrcpt,
* Nnndrc, Ipoten, Kount_Helmut
real(8):: Zero, Dgoj
@@ -48,7 +49,7 @@ C
C
DIMENSION Jfexcl(Ntotc,*),
* Bound(Ntotc,*), Echan(Ntotc,*),
- * Jfcros(*), Npxdr(*),
+ * Jfcros(*),
* Parmsc(*), Jflmsc(*), Jjkmsc(*),
* Crss(Ncrsss,*), Deriv(Ncrsss,Nnpar,*), Crssx(2,Ntotc,Ntotc,*),
* Derivx(2,Ntotc,Ntotc,Nnpar,*), Zke(Ntotc,*),
@@ -58,7 +59,6 @@ C
C DIMENSION
C * Jfexcl(Ntotc,Ngroup), Bound(Ntotc,Ngroup),
C * Echan(Ntotc,Ngroup), Jfcros(Ncrsss),
-C * Npxdr(Ngroup),
C * Crss(Ncrsss,Ngroup), Deriv(Ncrsss,Nnpar,Ngroup),
C * Crssx(2,Ntotc,Ntotc,Ngroup), Derivx(2,Ntotc,Ntotc,Nnpar,Ngroup),
C * Zke(Ntotc,Ngroup),
@@ -66,7 +66,8 @@ C * Prer(Ntriag,Ngroup), Prei(Ntriag,Ngroup)
C
type(SammySpinGroupInfo)::spinInfo
type(SammyResonanceInfo)::resInfo
- integer::M,iflabund
+ type(SammyRExternalInfo)::rextInfo
+ integer::M,iflabund, j
logical::needDeriv,ifcap
DATA Zero /0.0d0/
C
@@ -114,7 +115,20 @@ C
C
Nnnn = N
Npx = 0
- IF (Ks_Res.NE.2) Npx = Npxdr(N)
+ IF (Ks_Res.NE.2) then
+ DO I = 1, Ntotnn
+ if (resparData%hasRexInfo(N, I))then
+ call resparData%getRextInfoByGroup(rextInfo, N, I)
+ do j = 1, rextInfo%getNrext()
+ if(rextInfo%getIflSammyIndex(j).gt.0) then
+ Npx = 1
+ exit
+ end if
+ end do
+ end if
+ if (Npx.eq.1) exit
+ end do
+ end if
Nn2 = Ntotnn*(Ntotnn+1)
Nn = Nn2/2
C
@@ -126,7 +140,7 @@ C *** Set R-Matrix and other necessary arrays
Nentnn = spinInfo%getNumEntryChannels()
Nextnn = spinInfo%getNumExitChannels()
CALL Setr (Nentnn, Ntotnn, N,
- * Bound(:,N), Echan(:,N), A_Iprext , I_Iflext ,
+ * Bound(:,N), Echan(:,N),
* A_Isinsq , A_Isinph, A_Idphi, A_Icscs,
* A_Iss, A_Icc , Zke(:,N), Zeta(:,N),
* A_Ialphr, A_Ialphi, I_Inot, A_Idpdr, A_Idsdr,
@@ -211,7 +225,7 @@ C *** (via energy-denominator portion of R-matrix)
C
IF (Npx.NE.0 .AND. Ifext.EQ.0) THEN
C *** Find deriv of cross sections with respect to R-ext pars
- CALL Derext (Jfexcl(:,N), Jfcros,A_Iprext , I_Iflext ,
+ CALL Derext (Jfexcl(:,N), Jfcros,
* Deriv(:,:,N), Derivx(:,:,:,:,N), A_Itr, A_Itx,
* Dgoj, Ntotnn, Nentnn, Krext)
END IF
diff --git a/sammy/src/xct/mxct07.f90 b/sammy/src/xct/mxct07.f90
index bbc8d391de2d1b6ed76d352b0c59cdd962bcbc56..c02e1d930d64285fae37b645bbcd23886079ca99 100644
--- a/sammy/src/xct/mxct07.f90
+++ b/sammy/src/xct/mxct07.f90
@@ -5,7 +5,7 @@ module xct7_m
! --------------------------------------------------------------
!
SUBROUTINE Setr (Nent, Ntot, Igr, Bound, Echan, &
- Parext, Iflext, Sinsqr, Sin2ph, Dphi, Cscs, Sinphi, &
+ Sinsqr, Sin2ph, Dphi, Cscs, Sinphi, &
Cosphi, Zke, Zeta, Alphar, Alphai, Not, Dpdr, Dsdr, Rmat, &
Ymat, Rootp, Elinvr, Elinvi, Psmall, Krext, Lrmat, Min, Max, &
Ipoten)
@@ -26,10 +26,10 @@ module xct7_m
use EndfData_common_m
use SammyResonanceInfo_M
use RMatResonanceParam_M
+
IMPLICIT DOUBLE PRECISION (a-h,o-z)
!
DIMENSION Bound(*), Echan(*), &
- Parext(Krext,Ntotc,*), Iflext(Krext,Ntotc,*), &
Sinsqr(*), Sin2ph(*), Dphi(*), Cscs(2,*), Zke(*), &
Zeta(*), Alphar(*), Alphai(*), Not(*), Dpdr(*), &
Dsdr(*), Rmat(2,*), Ymat(2,*), Rootp(*), Elinvr(*), &
@@ -45,11 +45,14 @@ module xct7_m
type(RMatParticlePair)::pair
type(sammy_LogarithmicDerivativeCWF) :: cwf_solver ! CWF solver interface
REAL(selected_real_kind(14)) :: tmp_holder
+ logical::hasRext
+ type(SammyRExternalInfo)::rextInfo
+ type(RExternalFunction)::rext
+ real(kind=8)::Parext(7)
double precision, parameter :: Big = 1.0E30
!
! DIMENSION Bound(Ntotc),
-! * Echan(Ntotc), Parext(Nrext,Ntotc,Ngroup),
-! * Iflext(Nrext,Ntotc,Ngroup),
+! * Echan(Ntotc),
! * Zke(Ntotc), Zeta(Ntotc), Alphar(Nres), Alphai(Nres),
! * Not(Nres), Dpdr(Ntotc), Dsdr(Ntotc), Rmat(2,Ntriag),
! * Ymat(2,Ntriag), Rootp(Ntotc), Elinvr(Ntotc), Elinvi(Ntotc),
@@ -68,21 +71,30 @@ module xct7_m
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)) )
+ hasRext = resParData%hasRexInfo(Nnnn, K)
+ Parext = 0.0d0
+ IF (hasRext) then
+ call resparData%getRextInfoByGroup(rextInfo, Nnnn, K)
+ call resparData%getRext(rext, rextInfo)
+ DO J = 1, rextInfo%getNrext()
+ Parext(J) = rext%getSammyValue(J)
+ end do
+ Aloge &
+ = dLOG( (Parext(2)-Su)/(Su-Parext(1)) )
+ end if
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) &
+ IF (L.EQ.K .AND. hasRext) &
THEN
- Rmat(1,KL) = Parext(3,K,Nnnn) &
- + Parext(4,K,Nnnn)*Su &
- - Parext(5,K,Nnnn)*Aloge
+ Rmat(1,KL) = Parext(3) &
+ + Parext(4)*Su &
+ - Parext(5)*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)*Su**2 - Parext(6)* &
+ ( Parext(2) - Parext(1) ) &
+ - Parext(6)*Aloge*Su
END IF
END DO
END DO
diff --git a/sammy/src/xct/mxct12.f b/sammy/src/xct/mxct12.f
index a9b6c4c7625616cc7b29e34332157f6f6b7ef693..8a8b6c95f8dc1d9c7540538dffdfea4c6c4d8b99 100644
--- a/sammy/src/xct/mxct12.f
+++ b/sammy/src/xct/mxct12.f
@@ -2,19 +2,25 @@ C
C
C --------------------------------------------------------------
C
- SUBROUTINE Derext (If_Excl, Ifcros, Parext, Iflext, Deriv, Derivx,
+ SUBROUTINE Derext (If_Excl, Ifcros, Deriv, Derivx,
* Tr, Tx, Dgoj, Ntot, Nent, Krext)
C
use fixedi_m
use ifwrit_m
use varyr_common_m
+ use SammyRExternalInfo_M
+ use RMatResonanceParam_M
+ use EndfData_common_m, only : resParData
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
- DIMENSION If_Excl(*), Ifcros(*), Parext(Krext,Ntotc,*),
- * Iflext(Krext,Ntotc,*), Deriv(Ncrsss,*),
+ DIMENSION If_Excl(*), Ifcros(*),
+ * Deriv(Ncrsss,*),
* Derivx(2,Ntotc,Ntotc,*), Tr(Ncrsss,*), Tx(2,Ntriag,*)
-C DIMENSION If_Excl(*), Ifcros(Ncrsss), Parext(Nrext,Ntotc,Ngroup),
-C * Iflext(Nrext,Ntotc,Ngroup), Deriv(Ncrsss,Ndasig+ndbsig),
+ type(SammyRExternalInfo)::rextInfo
+ real(kind=8)::Parext(7)
+ type(RExternalFunction)::rext
+C DIMENSION If_Excl(*), Ifcros(Ncrsss),
+C * Deriv(Ncrsss,Ndasig+ndbsig),
C * Derivx(2,Ntotc,Ntotc,nap), Tr(Ncrsss,Nn), Tx(2,Ntriag,Ntriag)
C
DATA Two /2.0d0/
@@ -24,41 +30,47 @@ C
Ij = 0
DO I=1,Ntot
Ij = Ij + I
- IF (Iflext(1,I,Nnnn).NE.-1) THEN
+ Parext = 0.0d0
+ IF (resparData%hasRexInfo(Nnnn, I)) THEN
+ call resparData%getRextInfoByGroup(rextInfo, Nnnn, I)
+ call resParData%getRext(rext, rextInfo)
+ DO J = 1, rextInfo%getNrext()
+ Parext(J) = rext%getSammyValue(J)
+ end do
C *** note that Tr = 1/2 times partial (sigma) wrt (re R),
C *** ergo need to multiply by 2 here
A = Two*Dgoj
- IF (Iflext(1,I,Nnnn).NE.0) THEN
+ IF (rextInfo%getIflSammyIndex(1).NE.0) THEN
Jstart = Jstart + 1
DO M=1,Ncrsss
IF (Ifcros(M).NE.0 .AND. (M.LE.2 .OR.
* If_Excl(M-2+Nent).EQ.Kaptur) ) THEN
IF (Nrext.EQ.5) Deriv(M,Jstart) =
- * -Tr(M,Ij)*A*(Parext(5,I,Nnnn))/
- * (Su-Parext(1,I,Nnnn))
+ * -Tr(M,Ij)*A*(Parext(5))/
+ * (Su-Parext(1))
IF (Nrext.EQ.7) Deriv(M,Jstart) = - Tr(M,Ij)*A*
- * (Parext(5,I,Nnnn)+
- * Parext(6,I,Nnnn)*Parext(1,I,Nnnn))
- * / (Su-Parext(1,I,Nnnn))
+ * (Parext(5)+
+ * Parext(6)*Parext(1))
+ * / (Su-Parext(1))
END IF
END DO
END IF
- IF (Iflext(2,I,Nnnn).NE.0) THEN
+ IF (rextInfo%getIflSammyIndex(2).NE.0) THEN
Jstart = Jstart + 1
DO M=1,Ncrsss
IF (Ifcros(M).NE.0 .AND. (M.LE.2 .OR.
* If_Excl(M-2+Nent).EQ.Kaptur) ) THEN
IF (Nrext.EQ.5) Deriv(M,Jstart) =
- * - Tr(M,Ij)*A*(Parext(5,I,Nnnn))/
- * (Parext(2,I,Nnnn)-Su)
+ * - Tr(M,Ij)*A*(Parext(5))/
+ * (Parext(2)-Su)
IF (Nrext.EQ.7) Deriv(M,Jstart) = - Tr(M,Ij)*A*
- * (Parext(5,I,Nnnn)+
- * Parext(6,I,Nnnn)*Parext(2,I,Nnnn))
- * / (Parext(2,I,Nnnn)-Su)
+ * (Parext(5)+
+ * Parext(6)*Parext(2))
+ * / (Parext(2)-Su)
END IF
END DO
END IF
- IF (Iflext(3,I,Nnnn).NE.0) THEN
+ IF (rextInfo%getIflSammyIndex(3).NE.0) THEN
Jstart = Jstart + 1
DO M=1,Ncrsss
IF (Ifcros(M).NE.0 .AND. (M.LE.2 .OR.
@@ -67,7 +79,7 @@ C *** ergo need to multiply by 2 here
END IF
END DO
END IF
- IF (Iflext(4,I,Nnnn).NE.0) THEN
+ IF (rextInfo%getIflSammyIndex(4).NE.0) THEN
Jstart = Jstart + 1
DO M=1,Ncrsss
IF (Ifcros(M).NE.0 .AND. (M.LE.2 .OR.
@@ -76,34 +88,34 @@ C *** ergo need to multiply by 2 here
END IF
END DO
END IF
- IF (Iflext(5,I,Nnnn).NE.0) THEN
+ IF (rextInfo%getIflSammyIndex(5).NE.0) THEN
Jstart = Jstart + 1
DO M=1,Ncrsss
IF (Ifcros(M).NE.0 .AND. (M.LE.2 .OR.
* If_Excl(M-2+Nent).EQ.Kaptur) ) THEN
Deriv(M,Jstart) = -2.0D0*Tr(M,Ij)*
- * A*dSQRT(Parext(5,I,Nnnn))*
- * dLOG( (Parext(2,I,Nnnn)-Su)/
- * (Su-Parext(1,I,Nnnn)) )
+ * A*dSQRT(Parext(5))*
+ * dLOG( (Parext(2)-Su)/
+ * (Su-Parext(1)) )
C *** Remember that the u-parameter is the
C *** square root of Parext(5)
END IF
END DO
END IF
- IF (Nrext.GT.5) THEN
- IF (Iflext(6,I,Nnnn).NE.0) THEN
+ IF (rextInfo%getNrext().GT.5) THEN
+ IF (rextInfo%getIflSammyIndex(6).NE.0) THEN
Jstart = Jstart + 1
DO M=1,Ncrsss
IF (Ifcros(M).NE.0 .AND. (M.LE.2 .OR.
* If_Excl(M-2+Nent).EQ.Kaptur) ) THEN
Deriv(M,Jstart) = - Tr(M,Ij)*A*
- * ( (Parext(2,I,Nnnn)-Parext(1,I,Nnnn)) +
- * Su*dLOG( (Parext(2,I,Nnnn)-Su)/
- * (Su-Parext(1,I,Nnnn)) ) )
+ * ( (Parext(2)-Parext(1)) +
+ * Su*dLOG( (Parext(2)-Su)/
+ * (Su-Parext(1)) ) )
END IF
END DO
END IF
- IF (Iflext(7,I,Nnnn).NE.0) THEN
+ IF (rextInfo%getIflSammyIndex(7).NE.0) THEN
Jstart = Jstart + 1
DO M=1,Ncrsss
IF (Ifcros(M).NE.0 .AND. (M.LE.2 .OR.
@@ -126,6 +138,7 @@ C
Ij = Ij + Ichan
Jstart = Jstartx
DO Nchan=1,Ntot
+ Parext = 0.0d0
IF (If_Stay (Nchan, Ifdif, Nent, If_Excl(Nchan), Kaptur)
* .EQ.0) THEN
DO Nchanx=1,Nent
@@ -134,47 +147,53 @@ C
ELSE
Kl = (Nchanx*(Nchanx-1))/2 + Nchan
END IF
- IF (Iflext(1,Ichan,Nnnn).NE.-1) THEN
- IF (Iflext(1,Ichan,Nnnn).NE.0) THEN
+ IF (resparData%hasRexInfo(Nnnn, Ichan)) THEN
+ call resparData%getRextInfoByGroup(rextInfo,
+ * Nnnn, Ichan)
+ call resParData%getRext(rext, rextInfo)
+ DO J = 1, rextInfo%getNrext()
+ Parext(J) = rext%getSammyValue(J)
+ end do
+ IF (rextInfo%getIflSammyIndex(1).NE.0) THEN
Jstart = Jstart + 1
IF (Nrext.EQ.5) THEN
- A = -Parext(5,Ichan,Nnnn)/
- * (Su-Parext(1,Ichan,Nnnn))
+ A = -Parext(5)/
+ * (Su-Parext(1))
ELSE
- A = - (Parext(5,Ichan,Nnnn) +
- * Parext(6,Ichan,Nnnn)*
- * Parext(1,Ichan,Nnnn))
- * /(Su-Parext(1,Ichan,Nnnn))
+ A = - (Parext(5) +
+ * Parext(6)*
+ * Parext(1))
+ * /(Su-Parext(1))
END IF
Derivx(1,Nchanx,Nchan,Jstart) = Tx(1,Ij,KL)*A
* + Derivx(1,Nchanx,Nchan,Jstart)
Derivx(2,Nchanx,Nchan,Jstart) = Tx(2,Ij,KL)*A
* + Derivx(2,Nchanx,Nchan,Jstart)
END IF
- IF (Iflext(2,Ichan,Nnnn).NE.0) THEN
+ IF (rextInfo%getIflSammyIndex(2).NE.0) THEN
Jstart = Jstart + 1
IF (Nrext.EQ.5) THEN
- A = - Parext(5,Ichan,Nnnn)/
- * (Parext(2,Ichan,Nnnn)-Su)
+ A = - Parext(5)/
+ * (Parext(2)-Su)
ELSE
- A = - (Parext(5,Ichan,Nnnn)+
- * Parext(6,Ichan,Nnnn)*
- * Parext(2,Ichan,Nnnn))
- * / (Parext(2,Ichan,Nnnn)-Su)
+ A = - (Parext(5)+
+ * Parext(6)*
+ * Parext(2))
+ * / (Parext(2)-Su)
END IF
Derivx(1,Nchanx,Nchan,Jstart) = Tx(1,Ij,KL)*A
* + Derivx(1,Nchanx,Nchan,Jstart)
Derivx(2,Nchanx,Nchan,Jstart) = Tx(2,Ij,KL)*A
* + Derivx(2,Nchanx,Nchan,Jstart)
END IF
- IF (Iflext(3,Ichan,Nnnn).NE.0) THEN
+ IF (rextInfo%getIflSammyIndex(3).NE.0) THEN
Jstart = Jstart + 1
Derivx(1,Nchanx,Nchan,Jstart) = Tx(1,Ij,KL) +
* Derivx(1,Nchanx,Nchan,Jstart)
Derivx(2,Nchanx,Nchan,Jstart) = Tx(2,Ij,KL) +
* Derivx(2,Nchanx,Nchan,Jstart)
END IF
- IF (Iflext(4,Ichan,Nnnn).NE.0) THEN
+ IF (rextInfo%getIflSammyIndex(4).NE.0) THEN
Jstart = Jstart + 1
Derivx(1,Nchanx,Nchan,Jstart) =
* Tx(1,Ij,KL)*Su +
@@ -183,23 +202,23 @@ C
* Tx(2,Ij,KL)*Su +
* Derivx(2,Nchanx,Nchan,Jstart)
END IF
- IF (Iflext(5,Ichan,Nnnn).NE.0) THEN
+ IF (rextInfo%getIflSammyIndex(5).NE.0) THEN
Jstart = Jstart + 1
- A = - Two*DSQRT(Parext(5,Ichan,Nnnn))*
- * dLOG((Parext(2,Ichan,Nnnn)-Su)/
- * (Su-Parext(1,Ichan,Nnnn)))
+ A = - Two*DSQRT(Parext(5))*
+ * dLOG((Parext(2)-Su)/
+ * (Su-Parext(1)))
Derivx(1,Nchanx,Nchan,Jstart) = Tx(1,Ij,KL)*A
* + Derivx(1,Nchanx,Nchan,Jstart)
Derivx(2,Nchanx,Nchan,Jstart) = Tx(2,Ij,KL)*A
* + Derivx(2,Nchanx,Nchan,Jstart)
END IF
- IF (Nrext.GT.5) THEN
- IF (Iflext(6,Ichan,Nnnn).NE.0) THEN
+ IF (rextInfo%getNrext().GT.5) THEN
+ IF (rextInfo%getIflSammyIndex(6).NE.0) THEN
Jstart = Jstart + 1
- A = - ((Parext(2,Ichan,Nnnn)-
- * Parext(1,Ichan,Nnnn)) -
- * Su*dLOG((Parext(2,Ichan,Nnnn)-Su)/
- * (Su-Parext(1,Ichan,Nnnn))) )
+ A = - ((Parext(2)-
+ * Parext(1)) -
+ * Su*dLOG((Parext(2)-Su)/
+ * (Su-Parext(1))) )
Derivx(1,Nchanx,Nchan,Jstart) =
* Tx(1,Ij,KL)*A
* + Derivx(1,Nchanx,Nchan,Jstart)
@@ -207,7 +226,7 @@ C
* Tx(2,Ij,KL)*A
* + Derivx(2,Nchanx,Nchan,Jstart)
END IF
- IF (Iflext(7,Ichan,Nnnn).NE.0) THEN
+ IF (rextInfo%getIflSammyIndex(7).NE.0) THEN
Jstart = Jstart + 1
A = Su**2
Derivx(1,Nchanx,Nchan,Jstart) =