diff --git a/sammy/src/acs/macs0.f90 b/sammy/src/acs/macs0.f90
index 600a6521ec4f6db97d62bbab7fc9f1307061027a..4349219efe68500e0eb2908dd375d9e985ca230b 100644
--- a/sammy/src/acs/macs0.f90
+++ b/sammy/src/acs/macs0.f90
@@ -56,7 +56,7 @@ module acs_m
use AllocateFunctions_m
use acs1_m
use acs5_m
- use SammyFlowControl_M, only : fitOption, Where_To_Next
+ use SammyFlowControl_M, only : fitOption, Where_To_Next, urr_calc
IMPLICIT DOUBLE PRECISION (a-h,o-z)
real(kind=8),allocatable,dimension(:)::A_Idm
!
@@ -116,6 +116,7 @@ module acs_m
STOP
END IF
!
+!
!
IF (Kendf.EQ.0 .AND. (Iterat.EQ.Itmax .OR. Iterat.EQ.0)) THEN
! *** Prepare the plot files
diff --git a/sammy/src/acs/macs1.f90 b/sammy/src/acs/macs1.f90
index b5b83549133b69c325fadbdc194f3cc5b5d6d09e..7d06587aa025a92de1c224d2c7793e74893d9215 100644
--- a/sammy/src/acs/macs1.f90
+++ b/sammy/src/acs/macs1.f90
@@ -89,6 +89,7 @@ module acs1_m
use acs3_m
use acs4_m
use acs6_m
+ use fit1
IMPLICIT DOUBLE PRECISION (a-h,o-z)
!
DIMENSION Anrm(3,*), Knrm(3,*), Kktype(*), Kkkntx(*), &
@@ -103,8 +104,19 @@ module acs1_m
CALL Zero_Array (Theory(1,1,Iterp1), Kntmax*Kdtset)
CALL Zero_Array (Theorl, Kntmax*Numelv*Kdtset)
CALL Zero_Array (Dtheor, Kntmax*Nvpall*Kdtset)
-!
-! *** Generate cross sections
+
+ ! ------------------------------------------------------------------------------
+ ! JMB: temporary fix to reset the URR parameter values w/out using SAMMY fitting
+ ! Note: Parnew from fit/mfit1.f
+ ! ------------------------------------------------------------------------------
+ CALL Parnew ( A_Kkanrm , A_Kkdnrm , I_Kkknrm , I_Kiinrm , &
+ A_Istrel , A_Kkgglg , A_Istren , A_Idstre , A_Idistn , &
+ A_Iddist , A_Kkkkgg , A_Kkdlgg , A_Kkkkgf , A_Kkdlgf , &
+ I_Kkkjnl , I_Kkkjxl , I_Iflstr , I_Ifldst , I_Iflggg , &
+ I_Iflgff , I_Iflnrm , A_Kkktab , A_Kktabf , A_Kktabn , &
+ A_Ianold , I_Iflold , A_Idnold )
+!
+! *** Generate cross sections -- loop over num. datasets
DO Iset=1,Kdtset
Ktype = Kktype(Iset)
!
diff --git a/sammy/src/acs/macs2.f90 b/sammy/src/acs/macs2.f90
index 61497e54ba9dd654f9b6fd9852ea90a71f0b7497..64b5346dfdc2e06d40d13cf4b35dd8585112852e 100644
--- a/sammy/src/acs/macs2.f90
+++ b/sammy/src/acs/macs2.f90
@@ -199,9 +199,9 @@ module acs2_m
WRITE (6,10300) (Engurr(K),K=1,Numurr)
10300 FORMAT (1P5G14.6)
WRITE (21,10400)
-10400 FORMAT ('STOP in Find_Urr in acs/macs2.f')
+10400 FORMAT ('STOP in Find_Urr in acs/macs2_m.f')
WRITE (21,10100)
WRITE (6,10100)
- STOP '[STOP in Find_Urr in acs/macs2.f]'
+ STOP '[STOP in Find_Urr in acs/macs2_m.f]'
END
end module acs2_m
diff --git a/sammy/src/acs/macs3.f90 b/sammy/src/acs/macs3.f90
index 66519a1c4b43d730a192077e1ae5209014ee1269..0c3554c9f90309aab352db4b92617fb8c489c2d8 100644
--- a/sammy/src/acs/macs3.f90
+++ b/sammy/src/acs/macs3.f90
@@ -457,6 +457,6 @@ module acs3_m
10500 FORMAT ('Bi=', 1P5G14.6)
10600 FORMAT ('Af=', 1P5G14.6)
10700 FORMAT ('Bf=', 1P5G14.6)
- STOP '[STOP in Dint in acs/macs3.f]'
+ STOP '[STOP in Dint in acs/macs3_m.f]'
END
end module acs3_m
diff --git a/sammy/src/acs/macs4.f90 b/sammy/src/acs/macs4.f90
index 161d12f2165d4d675203d01b69fd1aef6bbc9be7..a696dd5d85e50321f88c62bd0ad1e93adc6c0956 100644
--- a/sammy/src/acs/macs4.f90
+++ b/sammy/src/acs/macs4.f90
@@ -212,6 +212,9 @@ module acs4_m
use z00001_common_m
use constn_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
+
+ integer :: orbAngMom
+
DIMENSION Aelast(7,*), Ainela(7,*)
DIMENSION Melast(2,*), Minela(2,*)
DIMENSION Iflstr(*), Ifldst(*), Dth(*), Iflgff(*), &
@@ -219,34 +222,34 @@ module acs4_m
!
! *** Begin with Streng, Distnt, Gg
Ipar = 0
- DO Kumelv=1,Numelv
+ DO orbAngMom=1,Numelv
!
! *** derivs wrt "streng"
- IF (Iflstr(Kumelv).NE.0) THEN
- Ipar = Iflstr(Kumelv)
+ IF (Iflstr(orbAngMom).NE.0) THEN
+ Ipar = Iflstr(orbAngMom)
DO N=1,Jelast
- IF (Melast(1,N).EQ.Kumelv) Dth(Ipar) = &
+ IF (Melast(1,N).EQ.orbAngMom) Dth(Ipar) = &
Dth(Ipar) + Sclj*Aelast(4,N)*Aelast(6,N)
END DO
IF (Inelas.GT.0) THEN
DO I=1,Inelas
- IF (Minela(1,I).EQ.Kumelv) Dth(Ipar) = Dth(Ipar) &
+ IF (Minela(1,I).EQ.orbAngMom) Dth(Ipar) = Dth(Ipar) &
+ Sclj*Ainela(4,I)*Ainela(6,I)
END DO
END IF
END IF
!
! *** derivs wrt "distnt"
- IF (Ifldst(Kumelv).NE.0) THEN
+ IF (Ifldst(orbAngMom).NE.0) THEN
! ### Derivative calc was missing here; NML added Jan 27, 1999
- Ipar = Ifldst(Kumelv)
+ Ipar = Ifldst(orbAngMom)
DO N=1,Jelast
- IF (Melast(1,N).EQ.Kumelv) Dth(Ipar) = &
+ IF (Melast(1,N).EQ.orbAngMom) Dth(Ipar) = &
Dth(Ipar) + Sclj*Aelast(5,N)*Aelast(6,N)
END DO
IF (Inelas.GT.0) THEN
DO I=1,Inelas
- IF (Minela(1,I).EQ.Kumelv) Dth(Ipar) = Dth(Ipar) &
+ IF (Minela(1,I).EQ.orbAngMom) Dth(Ipar) = Dth(Ipar) &
+ Sclj*Ainela(5,I)*Ainela(6,I)
END DO
END IF
@@ -254,16 +257,16 @@ module acs4_m
!
!
! *** derivs wrt "Gg" = gamma width
- IF (Iflggg(Kumelv).GT.0) THEN
- Ipar = Iflggg(Kumelv)
- Lmp = iABS(Kumelv-Kparit)
+ IF (Iflggg(orbAngMom).GT.0) THEN
+ Ipar = Iflggg(orbAngMom)
+ Lmp = iABS(orbAngMom-Kparit)
Lmp2 = Lmp/2
- IF (Kumelv.LE.2) THEN
+ IF (orbAngMom.LE.2) THEN
IF (Lmp2*2.EQ.Lmp) THEN
Dth(Ipar) = Dth(Ipar) + Sclj*Qsum
IF (Jelast.GT.0) THEN
DO N=1,Jelast
- IF (Melast(1,N).EQ.Kumelv) Dth(Ipar) = &
+ IF (Melast(1,N).EQ.orbAngMom) Dth(Ipar) = &
Dth(Ipar) - Sclj*Aelast(6,N)
END DO
END IF
@@ -273,7 +276,7 @@ module acs4_m
IF (Lmp2*2.EQ.Lmp) THEN
IF (Jelast.GT.0) THEN
DO N=1,Jelast
- IF (Melast(1,N).EQ.Kumelv) Dth(Ipar) = &
+ IF (Melast(1,N).EQ.orbAngMom) Dth(Ipar) = &
Dth(Ipar) - Sclj*Aelast(6,N)
END DO
END IF
@@ -292,18 +295,18 @@ module acs4_m
END IF
!
! *** Fission
- DO Kumelv=Kparit,Numelv,2
- Jlo = Jnl(Kumelv)
- Jhi = Jxl(Kumelv)
+ DO orbAngMom=Kparit,Numelv,2
+ Jlo = Jnl(orbAngMom)
+ Jhi = Jxl(orbAngMom)
IF (Jlo.LE.Kumjjv .AND. Jhi.GE.Kumjjv .AND. &
- Iflgff(Kumelv).NE.0) THEN
- Ipar = Iflgff(Kumelv)
- Dth(Ipar) = Dth(Ipar) + Sclj*Der_Fis/Gf(Kumelv)
+ Iflgff(orbAngMom).NE.0) THEN
+ Ipar = Iflgff(orbAngMom)
+ Dth(Ipar) = Dth(Ipar) + Sclj*Der_Fis/Gf(orbAngMom)
END IF
END DO
!
RETURN
- END
+ end subroutine Deriva
!
!
! ______________________________________________________________________
@@ -359,14 +362,25 @@ module acs4_m
Chisq, Theory, Dtheor, Delpar, Yyy, Www, Iset)
use fixedi_m
use ifwrit_m
+ use EndfData_common_m
+
IMPLICIT DOUBLE PRECISION (a-h,o-z)
+
CHARACTER*4 Type(5)
+ integer :: dataInd, theoInd
+ type(GridData) :: grid
!
DIMENSION Anrm(*), Knrm(*), Ex(*), Ee(*), Sx(*), Wx(*), Chisq(*), &
Theory(*), Dtheor(Nvpall,*), Delpar(*), Yyy(*), Www(*)
!
DATA Type /'TOTA', 'INEL', 'FISS', 'CAPT', 'ELAS'/
DATA Zero /0.0d0/, One /1.0d0/
+
+ ! data grids were set up in fff module (Fritz Frohner's Fitacs)
+ ! TODO: maybe change when moving to general 0 K xs calc
+ call expData%getGrid(grid,Iset)
+ dataInd = grid%getDataColumn()
+ theoInd = dataInd+1
!
Chisqu = Zero
DO Ienerg=1,Khmax
@@ -419,6 +433,18 @@ module acs4_m
END DO
END DO
END IF
+
+ ! --- fill C++ memory to be used in fitAPI -------------------
+ ! TODO: Bring FitAcs into the 0k_reconstruction framework
+ call grid%addData(Ienerg,1,Energy)
+ call grid%addData(Ienerg,dataInd,Sx(Ienerg))
+ call grid%addData(Ienerg,theoInd,Theory(Ienerg))
+
+ do Ipar=1,Nvpall
+ ! TODO: consider whether DerivativeList is more appropriate
+ call grid%addData(Ienerg,theoInd+Ipar,Dtheor(Ipar,Ienerg))
+ end do
+ ! -----------------------------------------------------------------
!
END IF
END DO
diff --git a/sammy/src/acs/macs5.f90 b/sammy/src/acs/macs5.f90
index 1f3393b8334a4050cc721bdf87019e7158306cc0..4b11e1af4617595c11e53de4617b59b00801d012 100644
--- a/sammy/src/acs/macs5.f90
+++ b/sammy/src/acs/macs5.f90
@@ -162,7 +162,7 @@ module acs5_m
!
IF (Kdtset.GT.40) WRITE (6,10000) Kdtset
10000 FORMAT ('Kdtset=',I10, 'but have only 40')
- IF (Kdtset.GT.40) STOP '[STOP in Plott2 in acs/macs5.f]'
+ IF (Kdtset.GT.40) STOP '[STOP in Plott2 in acs/macs5_m.f]'
!
New = 0
Kkkkev = Keveng
@@ -175,7 +175,7 @@ module acs5_m
ELSE
WRITE (6,10200) Keveng
10200 FORMAT ('Keveng=',I10)
- STOP '[STOP in Plott2 in acs/macs5.f # 2]'
+ STOP '[STOP in Plott2 in acs/macs5_m.f # 2]'
END IF
Nsntyp = 0
DO Iset=1,Kdtset
@@ -191,7 +191,7 @@ module acs5_m
WRITE (6,10100) I, E(I,Iset), Dum(I), Ee, Ooo
WRITE (21,10100) I, E(I,Iset), Dum(I), Ee, Ooo, De
10100 FORMAT (' E, Dum, Ee=', I5, 1P5G14.6)
- STOP '[STOP in Plott2 in acs/macs5.f # 2]'
+ STOP '[STOP in Plott2 in acs/macs5_m.f # 2]'
END IF
END DO
!
@@ -293,7 +293,7 @@ module acs5_m
!
200 WRITE (6,99996) Summry
99996 FORMAT (' ENDF file name is wrong: ##', A70, '##')
- STOP '[STOP in Make_File_3_Urr in acs/macs5.f]'
+ STOP '[STOP in Make_File_3_Urr in acs/macs5_m.f]'
END
end module acs5_m
diff --git a/sammy/src/acs/macs6.f90 b/sammy/src/acs/macs6.f90
index 639f4c037f91422fffbfd40922d26999d9351ff3..93373b86d7d161c14cc29345a228ecd587d7fa7d 100644
--- a/sammy/src/acs/macs6.f90
+++ b/sammy/src/acs/macs6.f90
@@ -49,7 +49,7 @@ module acs6_m
Const(2) = Two
!
RETURN
- END
+ end subroutine Define_Constants
!
!
! ______________________________________________________________________
@@ -90,7 +90,7 @@ module acs6_m
! *** Since Get_Density is used only as a ratio, normalization constant
! *** may be omitted
RETURN
- END
+ end function Get_Density
!
!
! ______________________________________________________________________
@@ -113,5 +113,6 @@ module acs6_m
10000 FORMAT (' Kk > 3 in function Kwhich ', 5I5)
Kwhich = Kk
RETURN
- END
+ end function Kwhich
+
end module acs6_m
diff --git a/sammy/src/acs/macs7.f90 b/sammy/src/acs/macs7.f90
index 245888a6af284504e2bda0825c69403879f67eda..46fb468c87613dbadce407de504f91d3fca7d1b5 100644
--- a/sammy/src/acs/macs7.f90
+++ b/sammy/src/acs/macs7.f90
@@ -291,7 +291,7 @@ module acs7_m
! ==========================================
!
RETURN
- END
+ end subroutine Dres
!
!
! ______________________________________________________________________
@@ -365,5 +365,6 @@ module acs7_m
END IF
Getfff = One/dSQRT(P)
RETURN
- END
+ end function Getfff
+
end module acs7_m
\ No newline at end of file
diff --git a/sammy/src/blk/SammyFlowControl_M.f90 b/sammy/src/blk/SammyFlowControl_M.f90
index b97ff10bf1ff75beadd7f429da2aa5335fc3c267..d97d9fc7d1db75bb609a207d0aa324fb046322ff 100644
--- a/sammy/src/blk/SammyFlowControl_M.f90
+++ b/sammy/src/blk/SammyFlowControl_M.f90
@@ -5,4 +5,7 @@ module SammyFlowControl_M
integer, save :: K_Stop_Segment
integer::fitOption ! 1: npv, 2: ipq, 3: mpw, 4: ywy, 5: wyw
+
+ ! do not complete SAMMY operation, only calc theory and deriv's
+ logical::urr_calc = .false.
end module SammyFlowControl_M
diff --git a/sammy/src/dat/mdat0.f90 b/sammy/src/dat/mdat0.f90
index 9597460aadabca7d6d0a9b5d9c960f5877d3118e..b796e12f02a72d718d3dcca14c6c5ea86e06d1b1 100644
--- a/sammy/src/dat/mdat0.f90
+++ b/sammy/src/dat/mdat0.f90
@@ -129,7 +129,7 @@ module Samdat_0_M
! If a second grid (if it exists) is the auxilary grid
!
call expData%destroy()
- call expData%initialize()
+ call expData%initialize() ! we do this to make sure it's empty
call grid%initialize()
diff --git a/sammy/src/end/mout5.f b/sammy/src/end/mout5.f
index 823a652bc463fc4f1734078d4ae05822b7c132dd..c502d27875ad0e395535c59a9a5cf120e3a6ff5b 100644
--- a/sammy/src/end/mout5.f
+++ b/sammy/src/end/mout5.f
@@ -14,8 +14,8 @@ C
use ifwrit_m
use fixedr_m
use constn_common_m
- use acs6_m
use EndfData_common_m, only : radFitFlags
+ use acs6_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
DIMENSION Anrm(3,*), Dnrm(3,*), Kktype(*), Edirin(*), Sdirin(*),
diff --git a/sammy/src/fff/mfff0.f90 b/sammy/src/fff/mfff0.f90
index c4b7183f967e452591849f276ac821e69901bc03..f9809757a726deb042778e8430ec84dd39f300ce 100644
--- a/sammy/src/fff/mfff0.f90
+++ b/sammy/src/fff/mfff0.f90
@@ -197,6 +197,7 @@ module fff_m
CALL Adjust_Fff (A_Kkkkex , A_Kkspin , A_Kkkpty )
!
! *** Read the cross section data
+ ! also set up C++ mem. GridDataList
CALL Acsinp (I_Kkktyp , I_Kkkknt , A_Kkkkex , A_Keeset , &
A_Kssset , A_Kuuset , A_Kwwset )
CLOSE (UNIT=15)
diff --git a/sammy/src/fff/mfff9.f90 b/sammy/src/fff/mfff9.f90
index 3b8265f567a6dcf253fa7a3e24cdf40cecf752fe..6aa76adb31ef63ad224cf970d57f640e0cf1118f 100644
--- a/sammy/src/fff/mfff9.f90
+++ b/sammy/src/fff/mfff9.f90
@@ -12,7 +12,12 @@ module fff9_m
use exploc_urr_common_m
use namfil_common_m
use fff4_m
+ use EndfData_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
+
+ integer :: numDataSets, dataInd
+ type(GridData) :: expGrid
+
DIMENSION Kktype(*), Kkkntx(*), Ex(*), Eeeset(Kntmax,*), &
Sssset(Kntmax,*), Uuuset(Kntmax,*), Wwwset(Kntmax,*)
DIMENSION Ktype(5)
@@ -25,9 +30,17 @@ module fff9_m
Emaxa = Zero
Iu17 = 15
IF (Kexptd.EQ.1) Iu17 = 17
- Kdtx = Kdtset
- IF (Kpntws.NE.0) Kdtx = Kpntws
- DO I=1,Kdtx
+ numDataSets = Kdtset
+ IF (Kpntws.NE.0) numDataSets = Kpntws
+ DO I=1,numDataSets
+ ! ----------------------------------
+ ! add grids to the gridDataList
+ ! ----------------------------------
+ call expGrid%initialize()
+ dataInd = 2 ! 2 since angle-integrated and no time-shift (URR)
+ call expGrid%setDataIndex(dataInd)
+ call expData%addGrid(expGrid)
+ ! ----------------------------------
IF (Kexptd.EQ.1) THEN
IF (Fdatax(I).EQ.Fblank) GO TO 30
CALL Filopn (17, Fdatax(I), 0)
@@ -149,6 +162,7 @@ module fff9_m
! are not two data points at same energy
!
use fixedr_m
+
IMPLICIT DOUBLE PRECISION (a-h,o-z)
DIMENSION E(*), S(*), U(*), W(*), EX(*)
CHARACTER*4 Rela, Relax, Utyp
diff --git a/sammy/src/fit/mfit0.f b/sammy/src/fit/mfit0.f
index 99541f410503da1ce71f12d224653601fdc959b3..651d34aecb1f3d7c08cf12f62baee4569b5da670 100644
--- a/sammy/src/fit/mfit0.f
+++ b/sammy/src/fit/mfit0.f
@@ -16,6 +16,7 @@ C
use exploc_urr_common_m
use AllocateFunctions_m
use SammyLptPrinting_m
+ use fit1
IMPLICIT DOUBLE PRECISION (a-h,o-z)
real(kind=8),allocatable,dimension(:)::A_Icorrx
integer,allocatable,dimension(:)::I_Itabcx
diff --git a/sammy/src/fit/mfit1.f b/sammy/src/fit/mfit1.f90
similarity index 68%
rename from sammy/src/fit/mfit1.f
rename to sammy/src/fit/mfit1.f90
index 6f06a8d223b84d3c85206643bc33e16eecec1509..ec93bc8962bc6396e8e18bd789034c805c35dcf8 100644
--- a/sammy/src/fit/mfit1.f
+++ b/sammy/src/fit/mfit1.f90
@@ -1,35 +1,37 @@
-C
-C
-C ______________________________________________________________________
-C
- SUBROUTINE Parnew ( Anrm, Dnrm, Knrm, Inrm, Strenl, Gglg, Streng,
- * Dstren, Distnt, Ddistn, Gg, Dlgg, Gf, Dlgf, Jnl, Jxl, Iflstr,
- * Ifldst, Iflggg, Iflgff, Iflnrm, Tab, Tabf, Tabn, Aold, Iflold,
- * Dold)
-C
-C *** Purpose -- Generate the improved cross section parameters for URR
-C
+!
+module fit1
+ contains
+!
+! ______________________________________________________________________
+!
+ SUBROUTINE Parnew ( Anrm, Dnrm, Knrm, Inrm, Strenl, Gglg, Streng, &
+ Dstren, Distnt, Ddistn, Gg, Dlgg, Gf, Dlgf, Jnl, Jxl, Iflstr, &
+ Ifldst, Iflggg, Iflgff, Iflnrm, Tab, Tabf, Tabn, Aold, Iflold, &
+ Dold)
+!
+! *** Purpose -- Generate the improved cross section parameters for URR
+!
use fixedi_m
use samxxx_common_m
use fixedr_m
use EndfData_common_m
use ResonanceCovariance_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
-C
- DIMENSION Anrm(3,*), Dnrm(3,*), Knrm(3,*), Inrm(*),
- * Strenl(Numelv,*), Gglg(Numelv,*), Streng(Numelv,*),
- * Dstren(Numelv,*), Distnt(Numelv,*), Ddistn(Numelv,*),
- * Gg(Numelv,*), Dlgg(Numelv,*), Gf(Numelv,Numjjv,*),
- * Dlgf(Numelv,Numjjv,*), Jnl(*), Jxl(*), Iflstr(Numelv,*),
- * Ifldst(Numelv,*), Iflggg(Numelv,*), IFlgff(Numelv,Numjjv,*),
- * Iflnrm(3,*), Tab(Numelv,4,Numurr,*),
- * Tabf(Numelv,Numjjv,Numurr,*), Tabn(3,Kdtset,*),
- * Aold(3,*), Iflold(3,*), Dold(3,*)
+!
+ DIMENSION Anrm(3,*), Dnrm(3,*), Knrm(3,*), Inrm(*), &
+ Strenl(Numelv,*), Gglg(Numelv,*), Streng(Numelv,*), &
+ Dstren(Numelv,*), Distnt(Numelv,*), Ddistn(Numelv,*), &
+ Gg(Numelv,*), Dlgg(Numelv,*), Gf(Numelv,Numjjv,*), &
+ Dlgf(Numelv,Numjjv,*), Jnl(*), Jxl(*), Iflstr(Numelv,*), &
+ Ifldst(Numelv,*), Iflggg(Numelv,*), IFlgff(Numelv,Numjjv,*), &
+ Iflnrm(3,*), Tab(Numelv,4,Numurr,*), &
+ Tabf(Numelv,Numjjv,Numurr,*), Tabn(3,Kdtset,*), &
+ Aold(3,*), Iflold(3,*), Dold(3,*)
type(ResonanceCovariance)::uCov
-C
+!
DATA Zero /0.0d0/
-C
-C
+!
+!
call covData%getUCovariance(uCov)
Ngtvf = 0
Ipar = 0
@@ -39,8 +41,7 @@ C
IF (Dstren(L,Kumurr).NE.Zero) THEN
Ipar = Ipar + 1
Mm = Mm + Ipar
- IF (Ipar.NE.Iflstr(L,Kumurr))
- * STOP '[STOP in Parnew in fit/mfit1.f]'
+ IF (Ipar.NE.Iflstr(L,Kumurr)) STOP '[STOP in Parnew in fit/mfit1.f]'
Strenl(L,Kumurr) = covData%getUParamValue(Ipar)
val = uCov%getCovariance(Ipar, Ipar)
Streng(L,Kumurr) = dEXP(Strenl(L,Kumurr))
@@ -49,8 +50,7 @@ C
IF (Ddistn(L,Kumurr).NE.Zero) THEN
Ipar = Ipar + 1
Mm = Mm + Ipar
- IF (Ipar.NE.Ifldst(L,Kumurr))
- * STOP '[STOP in Parnew in fit/mfit1.f # 2]'
+ IF (Ipar.NE.Ifldst(L,Kumurr)) STOP '[STOP in Parnew in fit/mfit1.f # 2]'
Distnt(L,Kumurr) = covData%getUParamValue(Ipar)
val = uCov%getCovariance(Ipar, Ipar)
Ddistn(L,Kumurr) = dSQRT(val)
@@ -58,8 +58,7 @@ C
IF (L.LE.2 .AND. Dlgg(L,Kumurr).NE.Zero) THEN
Ipar = Ipar + 1
Mm = Mm + Ipar
- IF (Ipar.NE.Iflggg(L,Kumurr))
- * STOP '[STOP in Parnew in fit/mfit1.f # 3]'
+ IF (Ipar.NE.Iflggg(L,Kumurr)) STOP '[STOP in Parnew in fit/mfit1.f # 3]'
Gglg(L,Kumurr) = covData%getUParamValue(Ipar)
Gg (L,Kumurr) = dEXP(Gglg(L,Kumurr))
val = uCov%getCovariance(Ipar, Ipar)
@@ -69,7 +68,7 @@ C
Gg (L,Kumurr) = Gg (L-2,Kumurr)
END IF
END DO
-C
+!
DO L=1,Numelv
Jlo = Jnl(L)
Jhi = Jxl(L)
@@ -78,8 +77,7 @@ C
IF (Dlgf(L,J,Kumurr).NE.Zero) THEN
Ipar = Ipar + 1
Mm = Mm + Ipar
- IF (Iflgff(L,J,Kumurr).NE.Ipar)
- * STOP '[STOP in Parnew in fit/mfit1.f # 4]'
+ IF (Iflgff(L,J,Kumurr).NE.Ipar) STOP '[STOP in Parnew in fit/mfit1.f # 4]'
Gf(L,J,Kumurr) = covData%getUParamValue(Ipar)
val = uCov%getCovariance(Ipar, Ipar)
Dlgf(L,J,Kumurr) = dSQRT(val)
@@ -94,26 +92,25 @@ C
Gf(L,J,Kumurr) = - Gf(L,J,Kumurr)
END IF
ELSE
- Gf(L,J,Kumurr) =
- * covData%getUParamValue(Iflgff(L,J,Kumurr))
+ Gf(L,J,Kumurr) = covData%getUParamValue(Iflgff(L,J,Kumurr))
END IF
END IF
END DO
END DO
-C
+!
END DO
-C *** End of loop on Kumurr
+! *** End of loop on Kumurr
IF (Ngtvf.EQ.1) THEN
WRITE (6,10300)
WRITE (21,10300)
END IF
-10100 FORMAT ('###################################################',
- * /, '## CAUTION. Value of Fission width went negative.#',
- * /, '## Absolute value will be used instead. #')
-10200 FORMAT ('## Gf(', I2, ',', I2, ',', I2, ')=', 1PG14.6,
- * ' #')
+10100 FORMAT ('###################################################', &
+ /, '## CAUTION. Value of Fission width went negative.#', &
+ /, '## Absolute value will be used instead. #')
+10200 FORMAT ('## Gf(', I2, ',', I2, ',', I2, ')=', 1PG14.6, &
+ ' #')
10300 FORMAT ('###################################################')
-C
+!
IF (Kdtold.GT.0) THEN
DO I=1,Kdtold
DO J=1,3
@@ -139,9 +136,9 @@ C
END DO
END DO
END IF
-C
+!
IF (Inrm(1).EQ.0) THEN
-C *** Here add if these are new parameters
+! *** Here add if these are new parameters
DO I=1,Kdtset
DO J=1,3
IF (Iflnrm(J,I).GT.0) THEN
@@ -159,8 +156,8 @@ C *** Here add if these are new parameters
END DO
END DO
END IF
-C
-C *** STORE NEW RESULTS FOR FINAL TABLE
+!
+! *** STORE NEW RESULTS FOR FINAL TABLE
Itp2 = Iterp1 + 1
DO Kumurr=1,Numurr
DO L=1,Numelv
@@ -182,66 +179,67 @@ C *** STORE NEW RESULTS FOR FINAL TABLE
END DO
END DO
RETURN
- END
-C
-C
-C ______________________________________________________________________
-C
- SUBROUTINE Csunc (Kktype, Kkkntx, Eeeset, Sssset, Uuuset, Wwwset,
- * Theory, Dtheor, It, Konvrg)
-C
-C Csunc PRINTS FINAL CROSS SECTION UNCERTAINTIES
-C
+ end subroutine Parnew
+!
+!
+! ______________________________________________________________________
+!
+ SUBROUTINE Csunc (Kktype, Kkkntx, Eeeset, Sssset, Uuuset, Wwwset, &
+ Theory, Dtheor, It, Konvrg)
+!
+! Csunc PRINTS FINAL CROSS SECTION UNCERTAINTIES
+!
use fixedi_m
use ifwrit_m
use samxxx_common_m
use EndfData_common_m
use ResonanceCovariance_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
- DIMENSION Kkkntx(*), Eeeset(Kntmax,*), Sssset(Kntmax,*),
- * Uuuset(Kntmax,*), Wwwset(Kntmax,*), Kktype(*),
- * Theory(Kntmax,Kdtset,*), Dtheor(Nvpall,Kntmax,*)
+ DIMENSION Kkkntx(*), Eeeset(Kntmax,*), Sssset(Kntmax,*), &
+ Uuuset(Kntmax,*), Wwwset(Kntmax,*), Kktype(*), &
+ Theory(Kntmax,Kdtset,*), Dtheor(Nvpall,Kntmax,*)
type(ResonanceCovariance)::uCov
CHARACTER*8 Type(5)
- DATA Type /'total ', 'inelastc', 'fission ', 'capture ',
- * 'elastic '/
+ DATA Type /'total ', 'inelastc', 'fission ', 'capture ', &
+ 'elastic '/
DATA Zero /0.0d0/, One /1.0d0/
-C
+!
call covData%getUCovariance(uCov)
IF (Konvrg.EQ.1) THEN
WRITE (21,20000)
-20000 FORMAT (//, ' Iteration has converged. The following cross sec
- *tions were generated', //,
- * ' with the final parameter values.')
+20000 FORMAT (//, ' Iteration has converged. The following cross sections were generated', //, &
+ ' with the final parameter values.')
ELSE
WRITE (21,20100)
20100 FORMAT (//, ' Cross section at final values of parameters.')
END IF
-C
+!
Cf = One
DO Iset=1,Kdtset
WRITE (21,10000) Type(Kktype(Iset))
-10000 FORMAT (//, 7x, 'NEUTRON', 9x, 'Average ', A8,
- * ' cross section', /,
- * ' NO. ENERGY INPUT FIT', /,
- * ' (keV) (b) (b)', /)
+10000 FORMAT (//, 7x, 'NEUTRON', 9x, 'Average ', A8, &
+ ' cross section', /, &
+ ' NO. ENERGY INPUT FIT', /, &
+ ' (keV) (b) (b)', /)
DO K=1,Kkkntx(Iset)
Var = Zero
DO M=1,Nvpall
DO N=1,M
val = uCov%getCovariance(M, N)
Var = Var + Dtheor(M,K,Iset)*val*Dtheor(N,K,Iset)
- IF (M.NE.N) Var = Var +
- * Dtheor(M,K,Iset)*val*Dtheor(N,K,Iset)
+ IF (M.NE.N) Var = Var + &
+ Dtheor(M,K,Iset)*val*Dtheor(N,K,Iset)
END DO
END DO
Utc = dSQRT(Var)*Cf
- WRITE (21,10100) K, Eeeset(K,Iset), Sssset(K,Iset),
- * Uuuset(K,Iset), Theory(K,Iset,It), Utc
-10100 FORMAT (I4, -3PF11.4, 0PF12.5, ' +-', F8.5, F12.5,
- * ' +-', F8.5)
+ WRITE (21,10100) K, Eeeset(K,Iset), Sssset(K,Iset), &
+ Uuuset(K,Iset), Theory(K,Iset,It), Utc
+10100 FORMAT (I4, -3PF11.4, 0PF12.5, ' +-', F8.5, F12.5, &
+ ' +-', F8.5)
END DO
END DO
-C
+!
RETURN
- END
+ end subroutine Csunc
+
+end module
diff --git a/sammy/src/lru/mlru1.f b/sammy/src/lru/mlru1.f
index 5ab5fce7963d4ab8411fb3322f69c761c94b066e..f9a58782b7664928487e0960bbb2f7746d1a58ec 100644
--- a/sammy/src/lru/mlru1.f
+++ b/sammy/src/lru/mlru1.f
@@ -13,8 +13,8 @@ C
use fixedr_m
use namfil_common_m
use constn_common_m
- use acs6_m
use EndfData_common_m, only : radFitFlags
+ use acs6_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
DIMENSION Streng(Numelv,*), Distnt(Numelv,*), Gg(Numelv,*),
diff --git a/sammy/src/lru/mlru2.f b/sammy/src/lru/mlru2.f
index 0b7b2e4a61c8c9b009131f5d8a61a2317a29ae4c..9b5af552ff36d0a8333b2c190e68ee5705f8f855 100644
--- a/sammy/src/lru/mlru2.f
+++ b/sammy/src/lru/mlru2.f
@@ -15,9 +15,9 @@ C
use fixedr_m
use constn_common_m
use EndfData_common_m
+ use EndfData_common_m, only : radFitFlags
use acs4_m
use acs6_m
- use EndfData_common_m, only : radFitFlags
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
DIMENSION Streng(Numelv,*), Distnt(Numelv,*), Gg(Numelv,*),
diff --git a/sammy/src/par/mpar03.f90 b/sammy/src/par/mpar03.f90
index 164dfb5d671e78fa70bd638261e4547ab2109228..983d1d4ed82b6f4293116e4d930b2fb5d6ad64f8 100644
--- a/sammy/src/par/mpar03.f90
+++ b/sammy/src/par/mpar03.f90
@@ -52,13 +52,10 @@ module par3_m
do
read(iu32,'(a)', end=20) line
- if (trim(line).eq."") goto 30
+ if (trim(line).eq."") goto 20
call reader%addLine(line)
end do
20 continue
- WRITE (21,300)
-300 FORMAT (' BLANK LINE MISSING IN .Par FILE')
- 30 continue
ierr = reader%readParameterCard1(resParData)
@@ -541,14 +538,11 @@ module par3_m
read(Kfile,'(a)', end=20) line
if (trim(line).eq."") then
backspace(Kfile)
- goto 30
+ goto 20
end if
call reader%addLine(line)
end do
20 continue
- WRITE (21,300)
-300 FORMAT (' BLANK LINE MISSING IN .Par FILE')
- 30 continue
ier = reader%readParameterCard10(resParData)
if( ier.ne.0) then
diff --git a/sammy/src/sam/SammyApi.h b/sammy/src/sam/SammyApi.h
index abca0f4e729639ec71adbd1b3aeea4aa8059e120..0d2c63861204b440045643d3d285d8fad5148351 100644
--- a/sammy/src/sam/SammyApi.h
+++ b/sammy/src/sam/SammyApi.h
@@ -9,6 +9,7 @@ extern "C" {
#endif
void sammy_init(int * sizeData);
+void sammy_init_api(char * filename, int * sizeData);
void sammy_get_theory(int * iter);
diff --git a/sammy/src/sam/sammy_api_m.f90 b/sammy/src/sam/sammy_api_m.f90
index 2ad8ae870d63c0189707f5a741f71865ccb11187..3f3cbee868fc2c4ae4567cedc424310c9b95c83e 100755
--- a/sammy/src/sam/sammy_api_m.f90
+++ b/sammy/src/sam/sammy_api_m.f90
@@ -1,5 +1,6 @@
module sammy_api_m
use, intrinsic :: ISO_C_BINDING
+ use, intrinsic :: iso_fortran_env ! input_unit
use SammyFlowControl_M
use over_common_m
use oops_common_m
@@ -37,8 +38,37 @@ module sammy_api_m
integer::K_Stop
contains
+
+ subroutine sammy_init_api(infile,sizeData) BIND(C,name="sammy_init_api")
+ character(kind = C_CHAR), dimension(*), intent(in) :: infile
+ character(len=:), allocatable :: filename
+ integer :: nChar, sizeData, i
+ ! ----- calculate string length ---------
+ nChar = 0
+ do
+ if (infile(nChar+1) == C_NULL_CHAR) exit
+ nChar = nChar + 1
+ end do
+ ! ----- transfer to fortran string ------
+ allocate(character(len=nChar)::filename)
+ filename = transfer(infile(1:nChar),filename)
+
+ ! ----- read user-input -----------------
+ open(unit=input_unit,file=filename)
+ ! ----- run normal sammy initialization -
+ call sammy_init(sizeData)
+ close(unit=input_unit)
+ end subroutine sammy_init_api
+
subroutine sammy_init(sizeData) BIND(C,name="sammy_init")
- integer::sizeData
+ integer :: sizeData
+ if( sizeData.lt.0 ) then
+ urr_calc = .true. ! when we're calling this through fitAPI
+ sizeData = sizeData * (-1)
+ else
+ urr_calc = .false.
+ end if
+
call resParData%initialize()
call multScat%initialize()
call sampleDim%initialize()
@@ -55,7 +85,6 @@ contains
Nsize = Msize
Kount_Initial = - Msize
-
Kmsize = 1000
Jmsize = 1000
Lmsize = 1000
@@ -81,7 +110,13 @@ contains
! now get to first theory part
- call sammy_do_segments('samthe')
+ ! TODO: Add unresolved calc to 0K framework
+ if( urr_calc ) then
+ call sammy_do_segments('genfit')
+ else
+ call sammy_do_segments('samthe')
+ end if
+
end subroutine sammy_init
subroutine sammy_get_theory(iter) BIND(C,name="sammy_get_theory")
@@ -100,7 +135,13 @@ contains
ii = iter
- call Samthe_0
+ if( urr_calc ) then
+ call Samacs_0
+ Where_To_Next = 'samthe'
+ return
+ else
+ call Samthe_0
+ end if
! run until we find one of the relevant sammy fit subroutine
iter = 0
@@ -130,7 +171,9 @@ contains
character(len=*)::endSeg
do
- if (Where_To_Next.eq.endSeg) return
+ if (Where_To_Next.eq.endSeg) then
+ return
+ end if
call sammy_next_segment()
end do
diff --git a/sammy/src/sammy/CMakeLists.txt b/sammy/src/sammy/CMakeLists.txt
index e8dc5c4b8c5d6325ac6e318339da7f19fcbd0d11..e7a7864cb24824dc28f77fe81838b11e84eb629b 100644
--- a/sammy/src/sammy/CMakeLists.txt
+++ b/sammy/src/sammy/CMakeLists.txt
@@ -151,7 +151,7 @@ APPEND_SET(SAMMY_SOURCES
../fin/mfin5.f90
../fit/mfit0.f
- ../fit/mfit1.f
+ ../fit/mfit1.f90
../fit/mfit2.f
../fit/mfit3.f