From 387eaa7fd159afd02a398d92b6991f880826578a Mon Sep 17 00:00:00 2001
From: Wiarda <wiardada@ornl.gov>
Date: Tue, 16 Mar 2021 15:55:07 -0400
Subject: [PATCH] Remove code for unused adding of a constant cross section.
---
sammy/src/blk/Fixedr_common.f90 | 2 --
sammy/src/blk/Ifwrit_common.f90 | 2 --
sammy/src/cro/mcro1.f | 4 ----
sammy/src/cro/mnrm1.f | 19 -----------------
sammy/src/end/mout2.f | 3 ---
sammy/src/endf/CovarianceData.h | 2 +-
sammy/src/fin/mfin4.f90 | 3 ---
sammy/src/inp/minp18.f | 1 +
sammy/src/int/mint2.f90 | 37 +++++++++++++++++----------------
sammy/src/mlb/mmlb1.f | 4 ----
sammy/src/par/mpar04.f90 | 14 +------------
sammy/src/xct/mxct02.f90 | 4 ----
12 files changed, 22 insertions(+), 73 deletions(-)
diff --git a/sammy/src/blk/Fixedr_common.f90 b/sammy/src/blk/Fixedr_common.f90
index afcc39efb..f0cbcf6db 100644
--- a/sammy/src/blk/Fixedr_common.f90
+++ b/sammy/src/blk/Fixedr_common.f90
@@ -74,8 +74,6 @@ module fixedr_m
double precision, pointer :: Dosind => Ff(57)
double precision, pointer :: Sitemp => Ff(58)
double precision, pointer :: Sithck => Ff(59)
- double precision, pointer :: Concro => Ff(60)
- double precision, pointer :: Contot => Ff(61)
double precision, pointer :: Effcap => Ff(62)
! old group 9
diff --git a/sammy/src/blk/Ifwrit_common.f90 b/sammy/src/blk/Ifwrit_common.f90
index b1ad32056..73522e0ec 100644
--- a/sammy/src/blk/Ifwrit_common.f90
+++ b/sammy/src/blk/Ifwrit_common.f90
@@ -137,8 +137,6 @@ module ifwrit_m
integer,pointer :: Kresol => Lwrit(103)
integer,pointer :: Nresol => Lwrit(104)
integer,pointer :: Krpitc => Lwrit(105)
- integer,pointer :: Kconcr => Lwrit(106)
- integer,pointer :: Kcontr => Lwrit(107)
integer,pointer :: Kssdbl => Lwrit(108)
integer,pointer :: Knocor => Lwrit(109)
integer,pointer :: Kefcap => Lwrit(110)
diff --git a/sammy/src/cro/mcro1.f b/sammy/src/cro/mcro1.f
index c1648658f..611a6fcaa 100644
--- a/sammy/src/cro/mcro1.f
+++ b/sammy/src/cro/mcro1.f
@@ -139,10 +139,6 @@ C ********* if there is normalization or background, include it
* Nnnsig)
END IF
C
-C ********* if adding a constant cross section, do so now
-C IF (Concro.NE.Zero) call Addcon (Sigxxx, Dbsigx, Iflmsc,
-C * Nnnsig)
-C
C ********* Write results onto theory if there is no broadening etc
IF (Jjjdop.NE.1) THEN
Kkkkkk = Kkkkkk + 1
diff --git a/sammy/src/cro/mnrm1.f b/sammy/src/cro/mnrm1.f
index 4898a9b0f..d813517f7 100644
--- a/sammy/src/cro/mnrm1.f
+++ b/sammy/src/cro/mnrm1.f
@@ -1,25 +1,6 @@
C
C
C --------------------------------------------------------------
-C
- SUBROUTINE Addcon (Sigxxx, Dbsigx, Iflmsc, Nummmm)
-C
-C *** Purpose -- Add constant cross section
-C
- use fixedi_m
- use ifwrit_m
- use fixedr_m
- IMPLICIT DOUBLE PRECISION (a-h,o-z)
- DIMENSION Sigxxx(*), Dbsigx(Nummmm,*), Iflmsc(*)
- IF (Nummmm.NE.1) STOP '[STOP in Addcon in cro/mnrm1.f]'
- Sigxxx(1) = Sigxxx(1) + Concro
- N = - Ndasig
- IF (Iflmsc(Kconcr).GT.N) Dbsigx(1,Iflmsc(Kconcr)-N) = 1.0d0
- RETURN
- END
-C
-C
-C --------------------------------------------------------------
C
SUBROUTINE Norm (Parnbk, Iflnbk, Sig, dA, dB, Em, Nummmm)
C
diff --git a/sammy/src/end/mout2.f b/sammy/src/end/mout2.f
index 4fb030329..dac3fdbba 100644
--- a/sammy/src/end/mout2.f
+++ b/sammy/src/end/mout2.f
@@ -487,9 +487,6 @@ C
* Parmsc(N+1), (Draw(J,2),J=1,5)
10800 FORMAT (' self-indication temperature =', 1PE12.4, 5A1,
* /, ' and thickness =', 1PE12.4, 5A1)
-C
- ELSE IF (Kconcr.EQ.N) THEN
-C *** constant cross section, if I ever get around to finishing
C
ELSE IF (Kefcap.EQ.N) THEN
CALL Setflg (Iflmsc(N), 2)
diff --git a/sammy/src/endf/CovarianceData.h b/sammy/src/endf/CovarianceData.h
index 9d00ab0f9..dd88b1e74 100644
--- a/sammy/src/endf/CovarianceData.h
+++ b/sammy/src/endf/CovarianceData.h
@@ -351,7 +351,7 @@ namespace sammy{
/** The index of varied/pup'd parameters to resonance objects */
std::vector<int> paramIndex;
- /** Parameters that are varied but don't matter, so they can be ignored */
+ /** Indices of parameters that are varied but don't matter, so they can be ignored */
std::vector<int> irrelevant;
};
}
diff --git a/sammy/src/fin/mfin4.f90 b/sammy/src/fin/mfin4.f90
index 4d525c630..00c55e70a 100644
--- a/sammy/src/fin/mfin4.f90
+++ b/sammy/src/fin/mfin4.f90
@@ -598,9 +598,6 @@ module fin4
WRITE (Iunit,10700) Iflmsc(I), Iflmsc(I+1), Parmsc(I), &
Delmsc(I), Parmsc(I+1), Delmsc(I+1)
10700 FORMAT ('%14SELFI', 2I2, 1X, 4F30.15)
-!
- ELSE IF (Kconcr.EQ.I) THEN
-! *** constant cross section, if I ever get this finished !
!
ELSE IF (Kefcap.EQ.I) THEN
WRITE (Iunit,10900) Iflmsc(I), Iflmsc(I+1), Parmsc(I), &
diff --git a/sammy/src/inp/minp18.f b/sammy/src/inp/minp18.f
index a451efd45..3eb849972 100644
--- a/sammy/src/inp/minp18.f
+++ b/sammy/src/inp/minp18.f
@@ -803,6 +803,7 @@ C
IF (J.EQ.3) K3 = K3 + 1
C
ELSE IF (Charac.EQ.Concrz) THEN
+ stop 'Adding of a constant cross section is not supported'
Nummsc = Nummsc + 2
N = N + 2
IF (I.EQ.1) K1 = K1 + 1
diff --git a/sammy/src/int/mint2.f90 b/sammy/src/int/mint2.f90
index 35fc7d891..5ef582c4f 100644
--- a/sammy/src/int/mint2.f90
+++ b/sammy/src/int/mint2.f90
@@ -215,7 +215,7 @@ module mint2_m
integer::Ifw, I, Ii, Ip, Iso, Isox, Iwrite, J
integer::Max, Min, N, Nnn, Iipar, Ipos, nn
integer,allocatable,dimension(:)::positioner, params
- logical::wroteHeader, wroteIso
+ logical::wroteHeader, wroteIso ! ensure header and isotope header are only printed once
!
Data Maxcol /4/
@@ -239,24 +239,24 @@ module mint2_m
Ipos = 0
IF (Iff.EQ.0) THEN
DO Ii=1,Nfpres
- Iipar = Iipar + 1
- IF (covData%contributes(Ii)) THEN
- DO J=1,Na
+ Iipar = Iipar + 1 ! count the derivatives of all resonance parameters
+ IF (covData%contributes(Ii)) THEN ! count only the ones that contribute
+ DO J=1,Na ! loop over angles, which might be 1 (=numcro in most other places)
Ipos = Ipos + 1
- Jjder(Ipos) = J
- Jjpar(Ipos) = Ii
+ Jjder(Ipos) = J ! the angle index for this derivative
+ Jjpar(Ipos) = Ii ! the index of the resonance for which this derivative is given
END DO
END IF
END DO
- N = Nfpres + 1
- IF (N.GT.Nb) GO TO 50
+ N = Nfpres + 1 ! we count all varied resonance parameters
+ IF (N.GT.Nb) GO TO 50 ! if Nb (other varied parameters) does not exist, we are done
Ii = Nfpres + 1
ELSE
- Ii = 1
+ Ii = 1 ! no resonance parameters are varied, skip right to the other parameters
N = 1
END IF
- DO Iipar=N,Nb
- DO J=1,Na
+ DO Iipar=N,Nb ! count the remaining derivatives by index
+ DO J=1,Na ! and angle
Ipos = Ipos + 1
Jjder(Ipos) = J
Jjpar(Ipos) = Ii
@@ -271,16 +271,16 @@ module mint2_m
do I = Min, Max
ip = Jjpar(I)
Ii = Jjder(I)
- positioner(I - Min + 1) = (ip-1)*Na + ii
- params(I-Min+1) = ip
- if (Iff.Ne.0) params(I-Min+1) = params(I-Min+1) + Ndasig
+ positioner(I - Min + 1) = (ip-1)*Na + ii ! position of the desired derivative in array Vd
+ params(I-Min+1) = ip ! index to print
+ if (Iff.Ne.0) params(I-Min+1) = params(I-Min+1) + Ndasig ! which needs to be corrected if all parameters are printed
end do
- CALL Chzero (Vd, Nanb, Nc, Nd, Min, Max, Isox, Ifw, positioner)
- IF (Ifw.NE.0) THEN
+ CALL Chzero (Vd, Nanb, Nc, Nd, Min, Max, Isox, Ifw, positioner) ! check whether there are any non-zero derivatives in this block
+ IF (Ifw.NE.0) THEN ! if so, print
Iwrite = 1
- if (.not.wroteHeader) WRITE (21,99999) Partia
+ if (.not.wroteHeader) WRITE (21,99999) Partia ! make sure header is only printed once
wroteHeader = .true.
- IF (Nc.GT.1) then
+ IF (Nc.GT.1) then ! add isotope header if needed, but only once
if(.not.wroteIso) WRITE (21,10000) Iso
end if
wroteIso = .true.
@@ -309,6 +309,7 @@ module mint2_m
END IF
END IF
IF (Iwrite.EQ.0.and.Ipos.ne.0) THEN
+ ! if desired, print that there are no non-zero derivatives
if (.not.wroteHeader) WRITE (21,99999) Partia
wroteHeader = .true.
WRITE (21,20000)
diff --git a/sammy/src/mlb/mmlb1.f b/sammy/src/mlb/mmlb1.f
index 506cd69c8..46fb0ae20 100644
--- a/sammy/src/mlb/mmlb1.f
+++ b/sammy/src/mlb/mmlb1.f
@@ -150,10 +150,6 @@ C ********* If there is normalization or background ...
* Dbsigx, Su, Nnnsig)
END IF
C
-C ********* If adding a constant cross section, do so now
-C IF (Concro.NE.Zero) call Addcon (Sigxxx, Dbsigx,
-C * Iflmsc, Nnnsig)
-C
C ********* Write results onto Theory if there is no broadening etc
IF (Jjjdop.NE.1) THEN
Theory(Jdat) = Zero
diff --git a/sammy/src/par/mpar04.f90 b/sammy/src/par/mpar04.f90
index 91fa53e38..f7cbb76bd 100644
--- a/sammy/src/par/mpar04.f90
+++ b/sammy/src/par/mpar04.f90
@@ -457,19 +457,7 @@ module par4_m
ELSE IF (Xx.EQ.Concrz) THEN
! *** Line # xx *** Constant cross section added to what's calculated
! *** NOTE THAT THIS OPTION IS NOT COMPLETED, NOT USED ANYWHERE!
- Parmsc(N+1) = A
- Parmsc(N+2) = C
- Delmsc(N+1) = B
- Delmsc(N+2) = D
- Iflmsc(N+1) = I
- Iflmsc(N+2) = J
- Nammsc(N+1) = Concrz
- Nammsc(N+2) = Concry
- Kconcr = N + 1
- Kcontr = N + 2
- Concro = A
- Contot = C
- N = N + 2
+ stop 'Adding of a constant cross section is not supported'
!
END IF
GO TO 10
diff --git a/sammy/src/xct/mxct02.f90 b/sammy/src/xct/mxct02.f90
index 486c1087a..e58cc943f 100644
--- a/sammy/src/xct/mxct02.f90
+++ b/sammy/src/xct/mxct02.f90
@@ -247,10 +247,6 @@ module xct2_m
Sigxxx, Dbsigx, Su, Nnnsig)
END IF
!
-! ********* If adding a constant cross section, do so now
-! IF (Concro.NE.Zero) CALL Addcon (Sigxxx, Dbsigx,
-! * Ifl_msc, Nnnsig)
-!
! ********* write results onto theory if there is no broadening etc
IF (Jjjdop.NE.1) THEN
Kkkkkk = Kkkkkk + 1
--
GitLab