diff --git a/sammy/src/blk/Fixedr_common.f90 b/sammy/src/blk/Fixedr_common.f90 index afcc39efb54614eb9524b6a45fc29f32028e9938..f0cbcf6dbbe5b3e1bccdb2ccd8689c74cd49038d 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 b1ad3205631cdff1dd807a5481749d1e592baa2f..73522e0ec49bcd26e7ceecac044a47dbc24e2840 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 c1648658fdd822bd563eb5ab7673a8897cde791b..611a6fcaa7f6e8262fe2cd9f386ccd6d7f32afe2 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 4898a9b0f993604e13167545f05a0a00cb2badb1..d813517f7c484789cfa82731347203a46c5c5455 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 4fb030329ba0e6611a2e631564a4483281541e5d..dac3fdbba8d671f680f2ccb9113648ef04c318b1 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 9d00ab0f98925e3f2e6cc68e8f14efa911602cee..dd88b1e742d24311730ae4ac28a27af56844d3be 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 4d525c630f00d9e4bef7f02ee9b1a1b4653aa7eb..00c55e70a4bb0c43566a30dbb353551bafc08e3a 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 a451efd4540b0682f325afd48d82e5f4bb80fb71..3eb849972600a368c8d85fa410056f1fcee45469 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 35fc7d89195f1b143c30ad9d12ec83788b0f7148..5ef582c4f0776fce1becc226a9099599d52d58a6 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 506cd69c8455456f7dc17ad9a2f7d11e94fd35df..46fb0ae2069fa7238cf2d72e5227998dd1272c7d 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 91fa53e38d494bc41684b26f4517af84795c6a23..f7cbb76bd1e8c3ba68d03c4ec2cd932971a66bf9 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 486c1087ae7a9ae4d615d355eadf1f70f4f363c7..e58cc943f28dbd9ea4e42da107f86710dc3cdfdf 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