From 42ef003f18f15b8c0833e0a5bf22ee6d872e336a Mon Sep 17 00:00:00 2001
From: Wiarda <wiardada@ornl.gov>
Date: Fri, 5 Nov 2021 10:23:33 -0400
Subject: [PATCH] Redo the direct capture arrays
---
sammy/src/blk/Fixedi_common.f90 | 2 -
sammy/src/blk/Templc_common.f90 | 13 -----
sammy/src/cro/mcro2a.f90 | 1 -
sammy/src/rec/mrec0.f | 2 -
sammy/src/rec/mrec3.f90 | 6 +-
sammy/src/sammy/CMakeLists.txt | 1 -
sammy/src/xct/XctCrossCalcImpl_M.f90 | 43 ++++++++++++---
sammy/src/xct/XctCrossCalc_M.f90 | 30 ++++++++++
sammy/src/xct/mxct0.f90 | 33 ++---------
sammy/src/xct/mxct02.f90 | 82 ++++++++++------------------
sammy/src/xct/mxct03.f90 | 11 +---
sammy/src/xct/mxct04.f90 | 8 +--
sammy/src/xct/mxct06.f90 | 62 ++++++---------------
13 files changed, 124 insertions(+), 170 deletions(-)
delete mode 100644 sammy/src/blk/Templc_common.f90
diff --git a/sammy/src/blk/Fixedi_common.f90 b/sammy/src/blk/Fixedi_common.f90
index 8644a6243..d0f2a50c0 100644
--- a/sammy/src/blk/Fixedi_common.f90
+++ b/sammy/src/blk/Fixedi_common.f90
@@ -259,8 +259,6 @@ module fixedi_m
integer,pointer :: Kdtold => lfdim(192)
integer,pointer :: Ndfdat => lfdim(193)
integer,pointer :: Matdat => lfdim(194)
- integer,pointer :: Nucdrc => lfdim(195)
- integer,pointer :: Numdrc => lfdim(196)
integer,pointer :: Montec => lfdim(197)
integer,pointer :: Medrpi => lfdim(198)
integer,pointer :: Lother => lfdim(199)
diff --git a/sammy/src/blk/Templc_common.f90 b/sammy/src/blk/Templc_common.f90
deleted file mode 100644
index 7f82fae23..000000000
--- a/sammy/src/blk/Templc_common.f90
+++ /dev/null
@@ -1,13 +0,0 @@
-
-module templc_common_m
-
- IMPLICIT NONE
-
- ! direct capture arrays
- real(kind=8),allocatable,dimension(:)::A_Iedrcp
- real(kind=8),allocatable,dimension(:)::A_Icdrcp
- real(kind=8),allocatable,dimension(:)::A_Ixdrcp
- integer,allocatable,dimension(:)::I_Indrcp
-
-
-end module templc_common_m
diff --git a/sammy/src/cro/mcro2a.f90 b/sammy/src/cro/mcro2a.f90
index 7d4429276..cc333c86f 100644
--- a/sammy/src/cro/mcro2a.f90
+++ b/sammy/src/cro/mcro2a.f90
@@ -148,7 +148,6 @@ contains
use SammyRMatrixParameters_M
use SammyResonanceInfo_M
use SammyRExternalInfo_M
- use templc_common_m
use xxx6
use mthe1_m
use mcro2_m
diff --git a/sammy/src/rec/mrec0.f b/sammy/src/rec/mrec0.f
index 5363ede9a..3bfa94b63 100644
--- a/sammy/src/rec/mrec0.f
+++ b/sammy/src/rec/mrec0.f
@@ -12,7 +12,6 @@ C
use exploc_common_m
use oopsch_common_m
use fixedr_m
- use templc_common_m
use cbro_common_m
use lbro_common_m
use AllocateFunctions_m
@@ -229,7 +228,6 @@ C
use ifwrit_m
use exploc_common_m
use broad_common_m
- use templc_common_m
use lbro_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
diff --git a/sammy/src/rec/mrec3.f90 b/sammy/src/rec/mrec3.f90
index cfd6732e7..c789e335c 100644
--- a/sammy/src/rec/mrec3.f90
+++ b/sammy/src/rec/mrec3.f90
@@ -19,16 +19,16 @@ contains
class(XctCrossCalc)::xct
real(kind=8):: Ssseee(*), Eee
- integer::I, Nnndrc
+ integer::I
!
Su = Eee
Squ = dSQRT(Su)
- Nnndrc = 0
!
I = 0
! *** generate cross sections pieces
xct%ener = Eee
- CALL Zcross (xct, Nnndrc, I)
+ xct%enerSq = Squ
+ CALL Zcross (xct, I)
!
! *** set the individual cross sections
CALL Indivi (xct, Ssseee, Su)
diff --git a/sammy/src/sammy/CMakeLists.txt b/sammy/src/sammy/CMakeLists.txt
index 3efca439c..ef175daaa 100644
--- a/sammy/src/sammy/CMakeLists.txt
+++ b/sammy/src/sammy/CMakeLists.txt
@@ -556,7 +556,6 @@ APPEND_SET(SAMMY_SOURCES
../blk/Rpires_common.f90
../blk/Rpirrr_common.f90
../blk/Varyr_common.f90
- ../blk/Templc_common.f90
../blk/Kzznew_common.f90
../blk/Aaarfs_common.f90
../blk/Z00001_common.f90
diff --git a/sammy/src/xct/XctCrossCalcImpl_M.f90 b/sammy/src/xct/XctCrossCalcImpl_M.f90
index b573602f4..22dd3878d 100644
--- a/sammy/src/xct/XctCrossCalcImpl_M.f90
+++ b/sammy/src/xct/XctCrossCalcImpl_M.f90
@@ -15,7 +15,7 @@ module XctCrossCalcImpl_M
use AdjustedRadiusData_M
implicit none
- type, extends(XctCrossCalc) :: XctCrossCalcImpl
+ type, extends(XctCrossCalc) :: XctCrossCalcImpl
contains
procedure, pass(this) :: calcCross => XctCrossCalcImpl_calcCross
procedure, pass(this) :: setEnergyIndependent => XctCrossCalcImpl_setEnergyIndependent ! set energy independent values using current parameter values
@@ -37,26 +37,51 @@ contains
logical(C_BOOL)::accu
call CrossSectionCalculator_calcCross(this, ener, Ipoten)
-! if (ener.eq.0.0d0) then
-
-!if(Iw.eq.1.or.Ksitmp.gt.0) THEN
-! call derivsSelf%setToZero((irow-1)*Nnnsig+iso, Ndasig+ndbsig+1)
-!end if
-!end do
-! end if
-
end subroutine
subroutine XctCrossCalcImpl_setEnergyIndependent(this, reactType, Twomhb, kwcoul, Etac)
use xct1_m
+ use xct2_m
+ use AllocateFunctions_m
+ use exploc_common_m, only : A_Iprmsc, I_Iflmsc, I_Ijkmsc
+ use par_parameter_names_common_m, only : Nammsc
+ use ifwrit_m, only : Kadddc
+ use fixedi_m, only : Nummsc
class(XctCrossCalcImpl) :: this
integer::kwcoul, reactType
real(kind=8)::Twomhb, Etac
+ integer::Iiidrc, Ijk
call XctCrossCalc_setEnergyIndependent(this, reactType, Twomhb, kwcoul, Etac)
+ ! read direct capture data if not yet done
+ IF (Kadddc.NE.0.and. .not. this%hasDirectCapture) THEN
+ this%hasDirectCapture = .true.
+ ! *** Scan direct-capture file, figure dimensions et al
+ CALL Scan_Dircap (this%Nucdrc, this%Numdrc)
+ call reallocate_real_data_2d(this%Edrcpt, this%Numdrc, 0, this%Nucdrc, 0)
+ call reallocate_real_data_2d(this%Cdrcpt, this%Numdrc, 0, this%Nucdrc, 0)
+ call allocate_real_data(this%Xdrcpt, this%Nucdrc)
+ call allocate_integer_data(this%Ndrcpt, this%Nucdrc)
+ call allocate_real_data(this%DrcpCoef, this%Nucdrc)
+ call allocate_integer_data(this%IflDrcpCoef, this%Nucdrc)
+ call Read_Direct_Capture(this)
+ END IF
+
+ ! update data (coefficient might have been adjusted)
+ if (this%hasDirectCapture) then
+ DO Iiidrc=1,this%Nucdrc
+ DO Ijk=1,Nummsc ! only consider direct capture
+ if (Nammsc(IJK).NE.'DRCAP') cycle
+ IF (I_Ijkmsc(Ijk).ne.Iiidrc) cycle
+ this%DrcpCoef(Iiidrc) = A_Iprmsc(Ijk)
+ this%IflDrcpCoef(Iiidrc) = I_Iflmsc(Ijk)
+ end do
+ end do
+ end if
+
if (this%wantDerivs) then
call Babb (this, .true.)
CALL Babbga (this, kwcoul )
diff --git a/sammy/src/xct/XctCrossCalc_M.f90 b/sammy/src/xct/XctCrossCalc_M.f90
index 8897a3acb..b720be945 100644
--- a/sammy/src/xct/XctCrossCalc_M.f90
+++ b/sammy/src/xct/XctCrossCalc_M.f90
@@ -86,6 +86,20 @@ module XctCrossCalc_M
integer,allocatable,dimension(:)::iradIndex ! map radius id
real(kind=8),allocatable,dimension(:,:)::Ccoulx
+
+
+
+ ! direct capture arrays. Todo update the direct capture to read and store data in C++ class
+ logical::hasDirectCapture
+ real(kind=8),allocatable,dimension(:,:)::Edrcpt
+ real(kind=8),allocatable,dimension(:,:)::Cdrcpt
+ real(kind=8),allocatable,dimension(:)::Xdrcpt
+ integer,allocatable,dimension(:)::Ndrcpt
+ real(kind=8),allocatable,dimension(:)::DrcpCoef ! the coefficent for a given nuclde (Coff from table 11.11 in input)
+ integer,allocatable,dimension(:)::IflDrcpCoef ! should the coefficient be varied
+ integer::numdrc ! number of nuclides in the direct capture file
+ integer::Nucdrc ! max number of energy/value pairs
+ ! end direct capture data
contains
procedure, pass(this) :: setUpDerivativeList => XctCrossCalc_setUpDerivativeList ! set up crossData, depending on number of isotopes
procedure, pass(this) :: setAddtionalParams => XctCrossCalc_setAddtionalParams
@@ -434,6 +448,13 @@ subroutine XctCrossCalc_initialize(this, pars, cov, rad, niso, needAngular, Itze
allocate(this%uniqueEchan(this%numIso))
end if
+
+ ! direct capture arrays. Todo update the direct capture to read and store data in C++ class
+ this%numdrc = 0
+ this%Nucdrc = 0
+ this%hasDirectCapture = .false.
+ ! end direct capture data
+
end subroutine
subroutine XctCrossCalc_destroy(this)
class(XctCrossCalc) :: this
@@ -505,6 +526,15 @@ subroutine XctCrossCalc_destroy(this)
if(allocated(this%Ccoulx)) deallocate(this%Ccoulx)
if (allocated(this%crossSelfWhy)) deallocate(this%crossSelfWhy)
+
+ ! direct capture arrays. Todo update the direct capture to read and store data in C++ class
+ if(allocated(this%Edrcpt)) deallocate(this%Edrcpt)
+ if(allocated(this%Cdrcpt)) deallocate(this%Cdrcpt)
+ if(allocated(this%Xdrcpt)) deallocate(this%Xdrcpt)
+ if(allocated(this%Ndrcpt)) deallocate(this%Ndrcpt)
+ if(allocated(this%DrcpCoef)) deallocate(this%DrcpCoef)
+ if(allocated(this%IflDrcpCoef)) deallocate(this%IflDrcpCoef)
+ ! end direct capture data
end subroutine
end module XctCrossCalc_M
diff --git a/sammy/src/xct/mxct0.f90 b/sammy/src/xct/mxct0.f90
index cca0ec9a4..0eeff0472 100644
--- a/sammy/src/xct/mxct0.f90
+++ b/sammy/src/xct/mxct0.f90
@@ -5,15 +5,12 @@ module xct_m
!
Subroutine Samxct_0(xct)
!
- use oops_common_m
- use fixedi_m
- use ifwrit_m
+ use fixedi_m, only : Ifdif, Iq_Val, Kiniso, Kkkiso, Kkxlmn, Lllmax, Ncrsss, Ndasig, Ndbsig, Niniso, Nnniso, Nrext, Nrfil3, &
+ Ntotc, Ntriag, numcro, Npfil3
+ use ifwrit_m, only : Ifcoul, Kadddc, Ks_Res, Ksolve, ktzero, Nd_Xct, Nnpar, Nnparx
use exploc_common_m
use array_sizes_common_m
- use oopsch_common_m
- use templc_common_m
- use cbro_common_m
- use lbro_common_m
+ use oopsch_common_m, only : Nowwww, Segmen
use EndfData_common_m
use AuxGridHelper_M
use SammyGridAccess_M
@@ -35,7 +32,7 @@ module xct_m
integer::Idimen
integer::K_Coul_N, Lllmmm, Mxany, N, Neight, Nfive1, Nfive1x, Nfive2, Nfive3, Nfive3x, Nfive4, Nfour
integer::Ifinal, Krext, Nfour1, Nfour2, Ng, Nnine, Nsix, Nthr1, Nthr2, Nthr3, ntwo1, numElAux, Nw1, NcrssxO
- integer::Nnndrc, Nfprrr
+ integer::Nfprrr
class(XctCrossCalc)::xct ! temporarily here so that energy indepdent code can move in steps
external Idimen
!
@@ -90,12 +87,6 @@ module xct_m
! *** Count how many non-zero elements are in Xlmn
Kkxlmn = xct%C_G_Kxlmn
!
- IF (Kadddc.NE.0) THEN
-! *** Scan direct-capture file, figure dimensions et al
- CALL Scan_Dircap (Nucdrc, Numdrc)
-! *** Nucdrc = number of nuclides in that file
-! *** Numdrc = max number of energy/value pairs
- END IF
!
! *** GUESSTIMATE SIZE OF ARRAY NEEDED FOR SAMMY-XCT
Ifcoul = xct%IfCoul
@@ -144,16 +135,6 @@ module xct_m
! *** four ***
!
! *** five ***
-!
- IF (Kadddc.EQ.1) THEN
- call allocate_real_data(A_Iedrcp, Nucdrc*Numdrc)
- call allocate_real_data(A_Icdrcp, Nucdrc*Numdrc)
- call allocate_real_data(A_Ixdrcp, Nucdrc)
- call allocate_integer_data(I_Indrcp, Nucdrc)
- Nnndrc = Numdrc
- ELSE
- Nnndrc = 1
- END IF
!
!
! - - - - - - - - - - - - - - - - - - - - - - <
@@ -201,9 +182,7 @@ module xct_m
!
Lllmmm = Lllmax
IF (Lllmax.EQ.0) Lllmmm = 1
- CALL Work ( xct, calcData , calcDataSelf, &
- A_Iedrcp , A_Icdrcp , &
- A_Ixdrcp , I_Indrcp , Nnndrc , Lllmmm)
+ CALL Work ( xct, calcData , calcDataSelf, Lllmmm)
! *** SBROUTINE Work generates theory and derivatives
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - >
!
diff --git a/sammy/src/xct/mxct02.f90 b/sammy/src/xct/mxct02.f90
index bb7ec8534..5d958f92b 100644
--- a/sammy/src/xct/mxct02.f90
+++ b/sammy/src/xct/mxct02.f90
@@ -4,8 +4,7 @@ module xct2_m
!
! --------------------------------------------------------------
!
- SUBROUTINE Work (calc, derivs, derivsSelf, &
- Edrcpt, Cdrcpt, Xdrcpt, Ndrcpt, Nnndrc, Lllmmm)
+ SUBROUTINE Work (calc, derivs, derivsSelf, Lllmmm)
!
! *** PURPOSE -- Generate theoretical cross sections "theory" and partial
! *** Derivatives "dasig"
@@ -17,7 +16,6 @@ module xct2_m
use oopsch_common_m
use fixedr_m
use varyr_common_m, only : Elz, Etz, Su, Squ
- use templc_common_m
use cbro_common_m
use lbro_common_m
use EndfData_common_m
@@ -35,10 +33,7 @@ module xct2_m
use XctCrossCalc_M
IMPLICIT none
- real(8), intent(out):: Edrcpt, Cdrcpt, Xdrcpt
-
- integer(4), intent(in):: Nnndrc, Lllmmm
- integer(4), intent(out):: Ndrcpt
+ integer(4), intent(in):: Lllmmm
real(8):: Zero, A, Gbx, Theoryx
integer(4):: Jdat, Idrcp, Ipoten, Iw, irow, istart, &
ng, numEl, TotalNdasig
@@ -53,8 +48,6 @@ module xct2_m
class(XctCrossCalc)::calc
logical(C_BOOL)::accu
- DIMENSION &
- Edrcpt(Nnndrc,*), Cdrcpt(Nnndrc,*), Xdrcpt(*), Ndrcpt(*)
!
! DIMENSION W...(...Ndatb)
!
@@ -108,13 +101,6 @@ module xct2_m
call derivsSelf%setNnsig(1)
call derivsSelf%reserve(numEl, Ndasig + Ndbsig + 1)
end if
-
-!
- IF (Kadddc.NE.0) THEN
-! *** Read and organize direct capture information; Cdrcpt = X/(4pi E)
- CALL Read_Direct_Capture (Edrcpt, Cdrcpt, Ndrcpt, &
- Nnndrc)
- END IF
!
irow = 0
istart = 0
@@ -175,8 +161,7 @@ module xct2_m
END IF
IF (Su.LT.Zero) Su = - Su
- IF (Kadddc.NE.0) CALL Find_Drcpt (Edrcpt, Cdrcpt, Xdrcpt, &
- Ndrcpt, Nnndrc, Idrcp, Su)
+ IF (Kadddc.NE.0) CALL Find_Drcpt (calc, Su)
!
! ********* Start regular calculation
Squ = dSQRT(Su)
@@ -207,7 +192,7 @@ module xct2_m
IF (Nd_Xct.NE.0 .AND. Ksolve.NE.2) THEN
CALL N_D_Zcross (calc)
ELSE
- CALL Zcross (calc, Nnndrc, Ipoten)
+ CALL Zcross (calc, Ipoten)
END IF
!
! ************ Store Coul if needed
@@ -316,23 +301,19 @@ module xct2_m
!
! ______________________________________________________________________
!
- SUBROUTINE Read_Direct_Capture (Edrcpt, Cdrcpt, Ndrcpt, &
- Nnndrc)
+ SUBROUTINE Read_Direct_Capture (calc)
+ use XctCrossCalc_M
use fixedi_m
use constn_common_m
- use EndfData_common_m
- use SammySpinGroupInfo_M
+ use SammySpinGroupInfo_M
IMPLICIT none
- real(8), intent(out):: Edrcpt, Cdrcpt
- integer(4), intent(in):: Nnndrc
- integer(4), intent(out):: Ndrcpt
+ class(XctCrossCalc)::calc
real(8):: Zero, E, X
integer(4):: I, Idrcpt, Ierr, isoI, Ix, J, Kpound
CHARACTER*1 Alpha(80), Blank
- DIMENSION Edrcpt(Nnndrc,*), Cdrcpt(Nnndrc,*), Ndrcpt(*)
type(SammySpinGroupInfo)::spinInfo
DATA Blank /' '/, Zero /0.0d0/
!
@@ -360,11 +341,11 @@ module xct2_m
! *** Figure which spin group this isotope belongs to
J = 0
IF (Numiso.GT.1) THEN
- DO I=1,resParData%getNumSpinGroups()
- call resParData%getSpinGroupInfo(spinInfo, I)
+ DO I=1,calc%resData%getNumSpinGroups()
+ call calc%resData%getSpinGroupInfo(spinInfo, I)
isoI = spinInfo%getIsotopeIndex()
IF (isoI.EQ.Ix) THEN
- Ndrcpt(Idrcpt) = I
+ calc%Ndrcpt(Idrcpt) = I
GO TO 20
END IF
END DO
@@ -375,7 +356,7 @@ module xct2_m
1X, 'have more in Direct Capture file.')
STOP '[STOP in mxct02.f]'
ELSE
- Ndrcpt(Idrcpt) = 1
+ calc%Ndrcpt(Idrcpt) = 1
END IF
END IF
20 CONTINUE
@@ -383,8 +364,8 @@ module xct2_m
10200 FORMAT (2F20.10)
IF (E.LE.Zero) GO TO 30
J = J + 1
- Edrcpt(J,Idrcpt) = E
- Cdrcpt(J,Idrcpt) = X*E/Fourpi
+ calc%Edrcpt(J,Idrcpt) = E
+ calc%Cdrcpt(J,Idrcpt) = X*E/Fourpi
GO TO 20
30 CONTINUE
Idrcpt = Idrcpt + 1
@@ -452,28 +433,25 @@ module xct2_m
!
! ______________________________________________________________________
!
- SUBROUTINE Find_Drcpt (Edrcpt, Cdrcpt, Xdrcpt, Ndrcpt, Nnndrc, &
- Idrcp, Su)
+ SUBROUTINE Find_Drcpt (calc, Su)
use fixedi_m
+ use XctCrossCalc_M
IMPLICIT none
- real(8), intent(in):: Edrcpt, Cdrcpt, Su
- real(8), intent(out):: Xdrcpt
- integer(4), intent(in):: Ndrcpt, Nnndrc, Idrcp
+ real(8), intent(in):: Su
real(8):: Zero, Aaa, Bbb, Del, Qqq
- integer(4):: I, Id, Idx, IJ, Nuc
+ integer(4):: I, Idx, IJ, Nuc
+ class(XctCrossCalc)::calc
- DIMENSION Edrcpt(Nnndrc,*), Cdrcpt(Nnndrc,*), Xdrcpt(*), Ndrcpt(*)
DATA Zero /0.0d0/
!
- Id = Idrcp
- Idx = Numdrc
- DO Nuc=1,Nucdrc
- DO I=Id,Numdrc
+ Idx = calc%Numdrc
+ DO Nuc=1,calc%Nucdrc
+ DO I=1,calc%Numdrc
IJ = 0
- IF (I.GT.2 .AND. Edrcpt(I,Nuc).EQ.Zero) THEN
+ IF (I.GT.2 .AND. calc%Edrcpt(I,Nuc).EQ.Zero) THEN
IJ = I - 2
- ELSE IF (Edrcpt(I,Nuc).GT.Su) THEN
+ ELSE IF (calc%Edrcpt(I,Nuc).GT.Su) THEN
IF (I.LE.Idx) Idx = I - 1
IF (I.EQ.1) THEN
IJ = 1
@@ -482,14 +460,14 @@ module xct2_m
END IF
END IF
IF (IJ.GT.0) THEN
- Del = Edrcpt(IJ+1,Nuc) - Edrcpt(IJ,Nuc)
- Aaa = ( Edrcpt(IJ+1,Nuc) - Su ) / Del
- Bbb = ( Su - Edrcpt(IJ,Nuc) ) / Del
- Qqq = Aaa*Cdrcpt(IJ,Nuc) + Bbb*Cdrcpt(IJ+1,Nuc)
+ Del = calc%Edrcpt(IJ+1,Nuc) - calc%Edrcpt(IJ,Nuc)
+ Aaa = ( calc%Edrcpt(IJ+1,Nuc) - Su ) / Del
+ Bbb = ( Su - calc%Edrcpt(IJ,Nuc) ) / Del
+ Qqq = Aaa*calc%Cdrcpt(IJ,Nuc) + Bbb*calc%Cdrcpt(IJ+1,Nuc)
IF (Qqq.GT.Zero) THEN
- Xdrcpt(Nuc) = Qqq
+ calc%Xdrcpt(Nuc) = Qqq
ELSE
- Xdrcpt(Nuc) = Zero
+ calc%Xdrcpt(Nuc) = Zero
END IF
GO TO 10
END IF
diff --git a/sammy/src/xct/mxct03.f90 b/sammy/src/xct/mxct03.f90
index 449ae7cc1..00cddd376 100644
--- a/sammy/src/xct/mxct03.f90
+++ b/sammy/src/xct/mxct03.f90
@@ -16,7 +16,6 @@ module xct3_m
!
use fixedi_m, only : Kpolar
use exploc_common_m
- use templc_common_m
use SammyResonanceInfo_M
use RMatResonanceParam_M
use xct1_m
@@ -56,10 +55,7 @@ module xct3_m
CALL Abpart (calc)
!
! *** Form the cross section Crss
- CALL Crosss ( calc, &
- A_Iprmsc , I_Iflmsc , I_Ijkmsc, &
- A_Ixdrcp , &
- I_Indrcp , Nnndrc, 0)
+ CALL Crosss ( calc, 0)
!
ng = calc%resData%getNumSpinGroups()
call reallocate_real_data_2d(unpertCross, calc%ntotc+1, 0, ng, 0)
@@ -148,10 +144,7 @@ module xct3_m
CALL Abpart (calc)
!
! *** Form the cross section Crss with new parameter value
- CALL Crosss ( calc, &
- A_Iprmsc , I_Iflmsc , I_Ijkmsc , &
- A_Ixdrcp , I_Indrcp , &
- Nnndrc, 0)
+ CALL Crosss ( calc, 0)
!
! *** Generate numerical derivatives
CALL Fix_N_D (calc, X, Iflr, Igrp, Ntotn)
diff --git a/sammy/src/xct/mxct04.f90 b/sammy/src/xct/mxct04.f90
index ff57104d6..5041b993c 100644
--- a/sammy/src/xct/mxct04.f90
+++ b/sammy/src/xct/mxct04.f90
@@ -4,7 +4,7 @@ module xct4_m
!
! --------------------------------------------------------------
!
- SUBROUTINE Zcross (calc, Nnndrc, Ipoten)
+ SUBROUTINE Zcross (calc, Ipoten)
!
! *** PURPOSE -- FORM THE CROSS SECTION Crss
! *** AND THE ( PARTIAL DERIVATIVES OF THE CROSS SECTION
@@ -15,7 +15,6 @@ module xct4_m
use fixedi_m
use ifwrit_m
use exploc_common_m
- use templc_common_m
use EndfData_common_m
use xct5_m
use mxct06_m
@@ -69,10 +68,7 @@ module xct4_m
!
! *** FORM THE CROSS SECTION Crss AND THE ( PARTIAL DERIVATIVES OF THE
! *** CROSS SECTION WITH RESPECT TO THE VARIED PARAMETERS ) = Deriv
- CALL Crosss ( calc, &
- A_Iprmsc , I_Iflmsc , I_Ijkmsc , &
- A_Ixdrcp , &
- I_Indrcp , Nnndrc, Ipoten)
+ CALL Crosss ( calc, Ipoten)
!
RETURN
END
diff --git a/sammy/src/xct/mxct06.f90 b/sammy/src/xct/mxct06.f90
index cbd650de4..ef78465b3 100644
--- a/sammy/src/xct/mxct06.f90
+++ b/sammy/src/xct/mxct06.f90
@@ -5,21 +5,15 @@ contains
!
! --------------------------------------------------------------
!
- SUBROUTINE Crosss ( calc, &
- Parmsc, Jflmsc , Jjkmsc , &
- Xdrcpt, Ndrcpt, Nnndrc, Ipoten)
+ SUBROUTINE Crosss ( calc, Ipoten)
!
! *** PURPOSE -- Form the cross sections Crss(Isigma,Igroup) and the
! *** ( partial derivatives of the cross section with respect to
! *** the varied parameters ) = Deriv(Isigma,Iipar,Igroup)
!
- use fixedi_m, only : Nucdrc, Nummsc
- use ifwrit_m, only : Kadddc
-
use SammySpinGroupInfo_M
use SammyResonanceInfo_M
use SammyRExternalInfo_M
- use par_parameter_names_common_m, only : Nammsc
use Derrho_m
use xct7_m
@@ -36,17 +30,10 @@ contains
implicit none
class(XctCrossCalc)::calc
- real(8), intent(in):: Parmsc, Xdrcpt
- integer(4), intent(in):: Jflmsc, Jjkmsc, &
- Ndrcpt, &
- Nnndrc, Ipoten
+ integer(4), intent(in):: Ipoten
integer(4):: i, Iiidrc, Ijk, Ipar, Lrmat, &
Minr, N, Ntotnn
-!
- DIMENSION &
- Parmsc(*), Jflmsc(*), Jjkmsc(*), &
- Xdrcpt(*), Ndrcpt(*)
!
type(SammySpinGroupInfo)::spinInfo
type(SammyResonanceInfo)::resInfo
@@ -184,38 +171,23 @@ contains
!
END IF
!
- IF (Kadddc.NE.0) THEN
- DO Iiidrc=1,Nucdrc
- IF (Ndrcpt(Iiidrc).EQ.N) THEN
- IF (Xdrcpt(Iiidrc).NE.0.0d0) THEN
- DO Ijk=1,Nummsc ! only consider direct capture
- if (Nammsc(IJK).NE.'DRCAP') cycle
- IF (Jjkmsc(Ijk).EQ.0) THEN
- GO TO 10
- ELSE IF (Jjkmsc(Ijk).EQ.Iiidrc) THEN
- val = Xdrcpt(Iiidrc)*Parmsc(Ijk)
- do j = 2, calc%Ntotc+1
- calc%crossInternal(j, N, 0) = calc%crossInternal(j, N, 0) + val
- end do
- IF (Jflmsc(Ijk).GT.0) THEN
- Ipar = Jflmsc(Ijk)
- val = Xdrcpt(Iiidrc)
- if (val.ne.0.0d0) then
- do j = 2, calc%Ntotc+1
- calc%crossInternal(j, N, Ipar) = calc%crossInternal(j, N, Ipar) + val
- end do
- end if
- GO TO 10
- END IF
- END IF
- END DO
- END IF
- GO TO 10
- ELSE
- END IF
+ IF (calc%hasDirectCapture) THEN
+ DO Iiidrc=1,calc%Nucdrc
+ IF (calc%Ndrcpt(Iiidrc).NE.N) cycle
+ IF (calc%Xdrcpt(Iiidrc).eq.0.0d0) cycle
+
+ val = calc%Xdrcpt(Iiidrc)*calc%DrcpCoef(Iiidrc)
+ do j = 2, calc%Ntotc+1
+ calc%crossInternal(j, N, 0) = calc%crossInternal(j, N, 0) + val
+ end do
+ Ipar = calc%IflDrcpCoef(Iiidrc)
+ if (Ipar.le.0) cycle
+ val = calc%Xdrcpt(Iiidrc)
+ do j = 2, calc%Ntotc+1
+ calc%crossInternal(j, N, Ipar) = calc%crossInternal(j, N, Ipar) + val
+ end do
END DO
END IF
- 10 CONTINUE
!
iparStart = iparStart + calc%inumSize
END DO
--
GitLab