Skip to content
Snippets Groups Projects
Commit 1496ec6c authored by Holcomb, Andrew's avatar Holcomb, Andrew
Browse files

Merge branch '2-add_ampx_endf_reading_for_file3' into 'master' 

Use C++ ENDF reading routines to read File 3 point-wise data.

See merge request rnsd/sammy!4
parents 76c36016 19876ba4
No related branches found
No related tags found
No related merge requests found
Expand all Hide whitespace changes
Inline Side-by-side
Showing
with 2329 additions and 2257 deletions
sammy/src/dat/mdat0.f → sammy/src/dat/mdat0.f90
+ 160
− 152
View file @ 1496ec6c
C
C
C
module Samdat_0_M
contains
!
!
!
SUBROUTINE Samdat_0 (A)
C
!
use oops_common_m
use fixedi_m
use ifwrit_m
......@@ -13,29 +15,32 @@ C
use rpires_common_m
use rpirrr_common_m
use AllocateFunctions_m
use mdat2_m
use EndfData_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
real(kind=8),allocatable,dimension(:)::A_Iedrpi, A_Ixxrpi
real(kind=8),allocatable,dimension(:)::A_J1, A_J2
type(EndfData)::reader
real(kind=8),target::A(-Msize:Msize)
C
!
Segmen(1) = 'D'
Segmen(2) = 'A'
Segmen(3) = 'T'
Nowwww = 0
C
!
CALL Initil
WRITE (6,99999) Emin, Emax
99999 FORMAT (' *** SAMMY-DATA 28 Dec 07 ***', 1PG11.4,' to', 1PG11.4)
C
C
C *** find array sizes for reading endf/b-vi file 3 cross sections
!
!
! *** find array sizes for reading endf/b-vi file 3 cross sections
IF (Kaddcr.EQ.1) THEN
CALL Read3 (Nr, Np)
ELSE
Nr = 1
Np = 1
END IF
C
!
IF (Medrpi.GT.0) THEN
N = Medrpi
Kxxrpi = 7
......@@ -55,75 +60,77 @@ C
N = Nudtim
call allocate_real_data(A_J1, N)
call allocate_real_data(A_J2, N)
C *** Extract dimensions and positions in file for energy & data
C Data can take all that is left of the array - only used for reading
! *** Extract dimensions and positions in file for energy & data
! Data can take all that is left of the array - only used for reading
Ix = Idimen (1, 1, '1, 1')
Ii = Msize/2 - Ix/2 - 2
Krext = Nrext
IF (Nrext.EQ.0) Krext = 1
CALL Read00 (I_Intot , A_Ibcf , A_Icf2 , A_Idpiso ,
* A_Iprext , I_Iflext , 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, A(Ix), Krext, Ii, Iwhich, Mind, Mine, Maxe,
* Maxd, Nmax)
call reader%initialize()
CALL Read00 (I_Intot , A_Ibcf , A_Icf2 , A_Idpiso , &
A_Iprext , I_Iflext , 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, A(Ix), Krext, Ii, Iwhich, Mind, Mine, Maxe, &
Maxd, Nmax, reader)
I = Idimen (Ix, -1, 'J1, -1')
deallocate(A_Iedrpi)
deallocate(A_Ixxrpi)
deallocate(A_J1)
deallocate(A_J2)
C
C
C *** GUESSTIMATE ARRAY Sizes
!
!
! *** GUESSTIMATE ARRAY Sizes
CALL Estdat (Ndatt, Ndatbm, Nnndat, Nr, Np, Ne)
C
C
C ### one ###
!
!
! ### one ###
Ienerg = Idimen (Ndat, 1, 'Ndat, 1')
A_Iener0 => A(Ienerg:Ienerg+Ndat+1)
IF (Ktzero.NE.0) then
call make_A_Iener0(Ndat)
end if
C
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - <
C ### one.one ###
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - <
! ### one.one ###
Ie = Idimen (Ne, 1, 'Ne, 1')
C
C ### two ###
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - <
!
! ### two ###
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - <
Id = Idimen (Ndatb, 1, 'Ndatb, 1')
Idata = Idimen (Ndat*Numcro, 1, 'Ndat*Numcro, 1')
Ivarda = Idimen (Ndatt, 1, 'Ndatt, 1')
Iiflag = Idimen (Ndat, 1, 'Ndat, 1')
Igtild = 1
IF (Numdtp.NE.0) Igtild = Idimen (Ndat*Numdtp, 1, 'Ndat*Numdtp,1')
C *** Read data for real
CALL Readin (I_Ifldtp , A(Ienerg), A(Ie), A(Id),
* A(Idata), A(Ivarda), A_Iptild , A(Igtild),
* Ndatt, Mind, Mine, Maxe, Maxd, Iwhich, Nmax)
C
! *** Read data for real
CALL Readin (I_Ifldtp , A(Ienerg), A(Ie), A(Id), &
A(Idata), A(Ivarda), A_Iptild , A(Igtild), &
Ndatt, Mind, Mine, Maxe, Maxd, Iwhich, Nmax, reader)
call reader%destroy()
!
IF (Kartgd.NE.1) THEN
C If (these are real, not artificial, data) then
C *** Write data onto SAM44.DAT and Energy onto SAM50.DAT
CALL Wr44 (A(Ienerg), A(Idata), A(Ivarda), Nvpdtp,
* Nnndat, Ndatt)
C *** Write data onto ascii files
! If (these are real, not artificial, data) then
! *** Write data onto SAM44.DAT and Energy onto SAM50.DAT
CALL Wr44 (A(Ienerg), A(Idata), A(Ivarda), Nvpdtp, &
Nnndat, Ndatt)
! *** Write data onto ascii files
IF (Kdata.NE.0) THEN
CALL Outdat (A(Ienerg), A(Idata), A_Iptild , Ndat)
CALL Outv (A(Ivarda), A(Id), A(Iiflag))
END IF
END IF
C
!
I = Idimen (Id, -1, 'Id, -1')
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - >
C
C *** modify energies via Tzero, Elzero
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - >
!
! *** modify energies via Tzero, Elzero
IF (Ktzero.NE.0) CALL Mtzero (A(Ienerg), A_Iener0, Ndat)
IF (Ktzero.NE.0) CALL Mtzero (A(Ie), A(Ie), Ndatb)
C
!
IF (Kphase.NE.0) THEN
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - <
C ### three ###
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - <
! ### three ###
Ipm = Idimen (Ntotc, 1, 'Ntotc, 1')
Ipx = Idimen (Ntotc, 1, 'Ntotc, 1')
Ism = Idimen (Ntotc, 1, 'Ntotc, 1')
......@@ -132,39 +139,39 @@ C ### three ###
Ihsx = Idimen (Ntotc, 1, 'Ntotc, 1')
Ir0m = Idimen (Ntotc, 1, 'Ntotc, 1')
Ir0x = Idimen (Ntotc, 1, 'Ntotc, 1')
CALL Phase (A(Ienerg), I_ILspin , A_Ichspi ,
* I_Inent , I_Iishif ,
* A_Ibound , A(Ipm), A(Ipx),
* A(Ism), A(Isx), A(Ihsm), A(Ihsx), A(Ir0m), A(Ir0x))
C *** PRINT HARD SPHERE AND RESONANCE PHASE SHIFTS
CALL Phase (A(Ienerg), I_ILspin , A_Ichspi , &
I_Inent , I_Iishif , &
A_Ibound , A(Ipm), A(Ipx), &
A(Ism), A(Isx), A(Ihsm), A(Ihsx), A(Ir0m), A(Ir0x))
! *** PRINT HARD SPHERE AND RESONANCE PHASE SHIFTS
I = Idimen (Ipm, -1, 'Ipm, -1')
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - >
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - >
END IF
C
C
!
!
Kendbd = 0
IF ( (Emin.NE.Emind .OR. Emax.NE.Emaxd .OR. Kartgd.EQ.1) .AND.
* Krefit.NE.1 ) THEN
C
C ### four ###
IF ( (Emin.NE.Emind .OR. Emax.NE.Emaxd .OR. Kartgd.EQ.1) .AND. &
Krefit.NE.1 ) THEN
!
! ### four ###
N = Ndatbm
Ienerb = Idimen (N, 1, 'N, 1')
Kdatbm = Ndatbm
C *** (Kdatbm is the maximum Ndatb could ever be)
C
C
! *** (Kdatbm is the maximum Ndatb could ever be)
!
!
IF (Kkkdop.NE.1) THEN
C
!
IF (Numorr.NE.0) Kendbd = 2
C *** IF (use OR Resolution function) THEN (use grid evenly spaced
C *** in time [not energy] at upper end of Energy-scale)
C
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - <
C *** Here for original version of Doppler broadening and choice
C *** of auxiliary grid, modified somewhat to make it work !
C *** Also here for free-gas model of Doppler broadening, and for
C *** automatic generation of Energy grid
C ### five ###
! *** IF (use OR Resolution function) THEN (use grid evenly spaced
! *** in time [not energy] at upper end of Energy-scale)
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - <
! *** Here for original version of Doppler broadening and choice
! *** of auxiliary grid, modified somewhat to make it work !
! *** Also here for free-gas model of Doppler broadening, and for
! *** automatic generation of Energy grid
! ### five ###
N = Nres
IF (N.EQ.0) N = 1
Ispken = Idimen (N, 1, 'N, 1')
......@@ -185,47 +192,47 @@ C ### five ###
Mnr = 100*Mnr
IF (Nr.EQ.0) Mnr = 1
Idum = Idimen (Mnr, 1, 'Mnr, 1')
CALL Escale ( I_Ixclud ,
* A(Ienerg), A(Ie), A(Ienerb), A(Ispken),
* A(Iswidt), A(Ienerm), A(Isadd), A_Iadder , A_Iaddcr ,
* I_Inbt , I_Iint , A(Idum), Ndatbm, Nr, Np)
CALL Escale ( I_Ixclud , &
A(Ienerg), A(Ie), A(Ienerb), A(Ispken), &
A(Iswidt), A(Ienerm), A(Isadd), A_Iadder , A_Iaddcr , &
I_Inbt , I_Iint , A(Idum), Ndatbm, Nr, Np)
I = Idimen (Ispken, -1, 'Ispken, -1')
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - >
C
Cz IF ( (Emin.NE.Emind .OR. Emax.NE.Emaxd .OR. Kartgd.EQ.1) .AND.
Cz * Krefit.NE.1 ) THEN
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - <
C ### six ###
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - >
!
!z IF ( (Emin.NE.Emind .OR. Emax.NE.Emaxd .OR. Kartgd.EQ.1) .AND.
!z * Krefit.NE.1 ) THEN
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - <
! ### six ###
Iii = Kdatbm
I1 = Idimen (Iii, 1, 'Iii, 1')
I2 = Idimen (Iii, 1, 'Iii, 1')
Iw = Idimen (Iii, 1, 'Iii, 1')
I21 = Idimen (Iii, 1, 'Iii, 1')
C *** Check whether weights produced by this grid are all positive;
C *** If not, adjust the grid to make them so.
CALL Adjust_Auxil (A(Ienerb), A(I1), A(I2), A(Iw), A(I21),
* Ndatb, Kdatbm)
! *** Check whether weights produced by this grid are all positive;
! *** If not, adjust the grid to make them so.
CALL Adjust_Auxil (A(Ienerb), A(I1), A(I2), A(Iw), A(I21), &
Ndatb, Kdatbm)
I = Idimen (I1, -1, 'I1, -1')
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - >
C
C
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - >
!
!
ELSE IF (Kkkdop.EQ.1) THEN
C
C *** Here for Leal-Hwang version of Doppler broadening and
C *** choice of auxiliary grid
!
! *** Here for Leal-Hwang version of Doppler broadening and
! *** choice of auxiliary grid
CALL Llgrid (A(Ienerb), Kdatbm, Nwd, Awid)
C
C *** WRITE velocities onto LPT file
!
! *** WRITE velocities onto LPT file
IF (Kdebug.NE.0) CALL Outeee (A(Ienerb), Ndatb, Ngtvv)
C
C
!
!
END IF
C
C
C *** Find Energy-limits and rewrite Energb into earliest position
!
!
! *** Find Energy-limits and rewrite Energb into earliest position
CALL Fixdat (A(Ienerg), A(Ie), A(Ienerb))
C
C *** Here Ndatb is actual number of points in auxiliary grid
!
! *** Here Ndatb is actual number of points in auxiliary grid
Nn = Ndatb
IF (Kartgd.NE.1) THEN
I = Idimen (Ie, -1, 'I, -1')
......@@ -244,14 +251,14 @@ C *** Here Ndatb is actual number of points in auxiliary grid
END IF
Ie = Idimen (1, 1, '1, 1')
END IF
C
C
!
!
ELSE
Ndatb = Ndat
Ienerb = Ienerg
END IF
C
C
!
!
CALL Write_Commons_Few
Close (unit=13)
IF (Kidcxx.EQ.1) THEN
......@@ -264,26 +271,26 @@ C
CALL Run ('samthe')
END IF
RETURN
C
END
C
C
C ______________________________________________________________
C
!
END SUBROUTINE Samdat_0
!
!
! ______________________________________________________________
!
SUBROUTINE Estdat (Ndatt, Ndatbm, Nnndat, Nr, Np, Ne)
C
!
use oops_common_m
use fixedi_m
use ifwrit_m
use fixedr_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
C
C ### one ###
!
!
! ### one ###
K1 = Ndat + 3
IF (Ktzero.NE.0) K1 = K1 + Ndat
C
C ### two ###
!
! ### two ###
Nnndat = Ndat*Numcro
IF (Kdatv.NE.0) THEN
Ndatt = (Nnndat*(Nnndat+1))/2
......@@ -293,20 +300,20 @@ C ### two ###
N = Numdtp*Ndat
IF (N.EQ.0) N = 1
K2 = Ndatb + Ndat*Numcro + Ndatt + Ndat + N
C
C ### three ###
!
! ### three ###
K3 = 8*Ntotc
C
C
IF ( (Emin.NE.Emind .OR. Emax.NE.Emaxd .OR. Kartgd.EQ.1) .AND.
* Krefit.NE.1 ) THEN
C
C ### four, etc ### ... first, figure value for Ndatbm :
C
!
!
IF ( (Emin.NE.Emind .OR. Emax.NE.Emaxd .OR. Kartgd.EQ.1) .AND. &
Krefit.NE.1 ) THEN
!
! ### four, etc ### ... first, figure value for Ndatbm :
!
I = Idimen (1, 1, '1, 1')
II = I + K1 + K2
IF (Kkkdop.NE.1) THEN
C --- from ### five ###
! --- from ### five ###
N = Nres
IF (Nres.EQ.0) N = 1
Nnn = Iptdop + 2 + 2*Iptwid
......@@ -320,26 +327,26 @@ C --- from ### five ###
Mnr = 100*Nr
IF (Nr.EQ.0) Mnr = 1
Nnn = Nnn + Mnr
C
!
N1 = Msize/3 - II/3 - Nnn/3 - 10
C --- from ### six ###
! --- from ### six ###
N2 = Msize/6 - II/6 - 4
Ndatbm = Min0(N1,N2)
C ### one.one ###
! ### one.one ###
Ne = Ndatbm
K1x = Ndatbm
C ### four ###
! ### four ###
K4 = Ndatbm
C ### five ###
! ### five ###
K5 = Ndatbm + NNN
C ### six ###
! ### six ###
K6 = 4*Ndatbm
K4 = K4 + Max0(K5,K6)
C
C
!
!
ELSE
C *** here for Leal-Hwang Doppler broadening
C ### one.one ###
! *** here for Leal-Hwang Doppler broadening
! ### one.one ###
Ne = Ndatb
K1x = Ndatb
I = Idimen (1, 1, '1, 1')
......@@ -348,42 +355,43 @@ C ### one.one ###
ELSE
Ndatbm = Msize
END IF
C ### four ###
! ### four ###
K4 = Ndatbm
Jjjdop = 1
C
!
END IF
I = Idimen (I, -1, 'I, -1')
C
!
ELSE
Ndatbm = Ndatb
Ne = Ndatb
K1x = Ndatb
K4 = 0
END IF
C
C
C
!
!
!
K1x = K1x + Max0 (K2,K3,K4)
K = K1 + Max0 (K1x,Ndatbm)
I = Idimen (K, 1, 'K, 1')
I = Idimen (I, -1, 'I, -1')
I = Idimen (0, 0, '0, 0')
RETURN
END
C
C
C ______________________________________________________________
C
END SUBROUTINE Estdat
!
!
! ______________________________________________________________
!
SUBROUTINE Mtzero (Energy, Energ0, Nnnnnn)
C
!
use fixedr_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
DIMENSION Energy(*), Energ0(*)
DO I=1,Nnnnnn
Energ0(I) = Energy(I)
Energy(I) = Energy(I)*
* ( Elzero/(1.0d0-Tzero*dsqrt(Energy(I))/Tttzzz) )**2
Energy(I) = Energy(I)* &
( Elzero/(1.0d0-Tzero*dsqrt(Energy(I))/Tttzzz) )**2
END DO
RETURN
END
END SUBROUTINE Mtzero
end module Samdat_0_M
sammy/src/dat/mdat2.f → sammy/src/dat/mdat2.f90
+ 438
− 435
View file @ 1496ec6c
This diff is collapsed.
sammy/src/dat/mdat3.f
+ 2
− 0
View file @ 1496ec6c
......@@ -19,6 +19,7 @@ C
use ifwrit_m
use samxxx_common_m
use EndfData_common_m
use mdat2_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
DIMENSION Ifldtp(*), Energy(*), Ee(*), Dummy(*),
......@@ -106,6 +107,7 @@ C
use ifwrit_m
use samxxx_common_m
use fixedr_m
use mdat2_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
C
DIMENSION Energy(*), EE(*), Data(Numcro,*), Vardat(Numcro,*),
......
sammy/src/dat/mdatb.f deleted 100644 → 0
+ 0
− 114
View file @ 76c36016
C
C
C __________________________________________________________________________
C
SUBROUTINE Rd0_Endf_10 (E, Nmax)
use fixedi_m
use fixedr_m
use namfil_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
DIMENSION E(*)
C
CALL Filopn (13, Fdatax(1), 0)
C
C *** Find location in ENDF file
CALL Find_Matnum_In_ENDF_File (Matdat, 3, Ndfdat, Za, Awr, Nisotp,
* 13)
C
C *** Read interpolation scheme
READ (13,10100) C1, C2, L1, L2, Nr, Np
10100 FORMAT (1P2E11.4, 4I11)
Nr6 = Nr/3
IF (Nr6*3.NE.Nr) Nr6 = Nr6 + 1
Min = 1
Max = 3
IF (Nr6.GT.0) THEN
DO I=1,Nr6
READ (13,10200) (Nbt,Int,N=Min,Max)
Min = Max + 1
Max = Max + 3
END DO
END IF
10200 FORMAT (6I11)
C
C *** Read energies
Np3 = Np/3
IF (Np3*3.NE.Np) Np3 = Np3 + 1
Min = 1
Max = 3
DO I=1,Np3
READ (13,10300) (E(N),Dd,N=Min,Max)
Min = Max + 1
Max = Max + 3
END DO
Nmax = Np
10300 FORMAT (6E11.4)
C
C
REWIND (UNIT=13)
C
C
C *** Find location in ENDF file (yes, again)
CALL Find_Matnum_In_ENDF_File (Matdat, 3, Ndfdat, Za, Awr, Nisotp,
* 13)
C
C *** Read interpolation scheme (again)
READ (13,10100) C1, C2, L1, L2, Nr, Np
Min = 1
Max = 3
IF (Nr6.GT.0) THEN
DO I=1,Nr6
READ (13,10200) (Nbt,Int,N=Min,Max)
Min = Max + 1
Max = Max + 3
END DO
END IF
RETURN
END
C
C
C __________________________________________________________________________
C
SUBROUTINE Rd_Endf_10 (Energy, Ee, Data, Vardat, Mind, Mine, Maxe,
* Maxd, Nmax)
use ifwrit_m
use fixedr_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
DIMENSION Energy(*), Ee(*), Data(*), Vardat(*)
DIMENSION Aaa(3), Bbb(3)
DATA Zero /0.0d0/, Small /0.001d0/, Tenth /0.10d0/
C
Np = Nmax
Np3 = Np/3
IF (Np3*3.NE.Np) Np3 = Np3 + 1
Min = 1
Max = 3
K1 = 0
K2 = 0
Nn = 0
DO I=1,Np3
READ (13,10100) (Aaa(N),Bbb(N),N=1,3)
10100 FORMAT (6E11.4)
DO N=1,3
Nn = Nn + 1
IF (Nn.GT.Np) GO TO 10
IF (Nn.GE.Mind .AND. Nn.LE.Maxd) THEN
K1 = K1 + 1
Ee(K1) = Aaa(N)
END IF
IF (Nn.GE.Mine .AND. Nn.LE.Maxe) THEN
K2 = K2 + 1
Energy(K2) = Aaa(N)
Data(K2) = Bbb(N)
Vardat(K2) = Bbb(N)*Tenth
IF (Bbb(N).EQ.Zero) Vardat(K2) = Small
END IF
END DO
Min = Max + 1
Max = Max + 3
END DO
10 CONTINUE
IF (Ndatb.GT.K1) Ndatb = K1
CLOSE (UNIT=13)
RETURN
END
sammy/src/dat/mdatb.f90 0 → 100644
+ 109
− 0
View file @ 1496ec6c
module mdatb_m
implicit none
contains
!!
!! Read File 3 data (Material is stored on Matnum in fixedi_m,
!! reaction in Ndfdat in fixedi_m and file name in Fdatax(1) in namfil_common_m).
!!
!! Data are read into E and Nmax is updated to the number of points given in File 3.
!!
!! @param E on output the energy grid
!! @param Nmax on output the number of points in the grid
!! @param reader the object used to read the ENDF data
SUBROUTINE ReadFile3Energy (E, Nmax, reader)
use fixedi_m
use namfil_common_m
use EndfData_m
use Tab1_M
use, intrinsic :: ISO_C_BINDING
integer::nmax
type(EndfData)::reader
type(Tab1)::tab1Data
real(C_DOUBLE)::x(1),y(1)
real(kind=8):: E(*)
integer::I
call reader%setFileName(trim(Fdatax(1)))
call reader%setMat(Matdat)
call reader%getTab1ByMt(tab1Data, Ndfdat)
if (.not.C_ASSOCIATED(tab1Data%instance_ptr)) then
STOP 'Reaction not found in File 3 in endf file in ReadFile3Energy'
end if
!
! *** Read energies
Nmax = tab1Data%getPoints()
DO I=1,Nmax
call tab1Data%getValue(I, x, y)
E(I) = x(1)
END DO
END SUBROUTINE ReadFile3Energy
!!
!!
!! Read File 3 data. It is assumed that ReadFile3Energy was previously called to
!! read all File 3 data from the ENDF file and here we are just filling in the
!! the data for a desired reaction. Reaction is stored in Ndfdat in fixedi_m.
!!
!! It is assumed that ReadFile3Energy was called and data point positions
!! Mind, Mine, Maxe, Maxd have been previously determined.
!!
!! Energy points between Mind and Maxd are read into Ee.
!!
!! Energy and data between Mine and Maxe are read into Energy and Data.
!! The uncertainty on the data (stored in Vardat) is calculated as 0.01 * Data
!!
!! @param Energy energy grid for points between Mine, Maxe
!! @param EE energy grid for points between Mind, Maxd
!! @param Data data points for points between Mine, Maxe
!! @param Vardat uncertainty on the data
!! @param Mind see comments above
!! @param Mine see comments above
!! @param Maxe see comments above
!! @param Maxd see comments above
!! @param reader the object used to read the ENDF data
!!
SUBROUTINE FillFromFile3Data (Energy, Ee, Data, Vardat, Mind, Mine, Maxe, Maxd, reader)
use ifwrit_m
use fixedi_m
use EndfData_M
use, intrinsic :: ISO_C_BINDING
type(EndfData)::reader
type(Tab1)::tab1Data
integer::Mind, Mine, Maxe, Maxd
real(C_DOUBLE)::x(1),y(1)
real(kind=8):: Energy(*), Ee(*), Data(*), Vardat(*)
real(kind=8)::Zero, Small, Tenth
integer::K1, K2, Nn, I
DATA Zero /0.0d0/, Small /0.001d0/, Tenth /0.10d0/
!
call reader%getTab1ByMt(tab1Data, Ndfdat)
if (.not.C_ASSOCIATED(tab1Data%instance_ptr)) then
STOP 'Reaction not found in File 3 in endf file in FillFromFile3Data'
end if
K1 = 0
K2 = 0
Nn = 0
DO I=1,tab1Data%getPoints()
call tab1Data%getValue(I, x, y)
Nn = Nn + 1
IF (Nn.GE.Mind .AND. Nn.LE.Maxd) THEN
K1 = K1 + 1
Ee(K1) = x(1)
END IF
IF (Nn.GE.Mine .AND. Nn.LE.Maxe) THEN
K2 = K2 + 1
Energy(K2) = x(1)
Data(K2) = y(1)
Vardat(K2) = y(1)*Tenth
IF (y(1).EQ.Zero) Vardat(K2) = Small
END If
END DO
IF (Ndatb.GT.K1) Ndatb = K1
RETURN
END SUBROUTINE FillFromFile3Data
end module mdatb_m
sammy/src/endf/EndfData.cpp
+ 41
− 24
View file @ 1496ec6c
......@@ -6,79 +6,79 @@
endf::EndfData::EndfData(const EndfData & orig):fileName(orig.fileName),mat(orig.mat){
if (orig.resonanceData != NULL){
resonanceData = std::make_shared<endf::ResonanceInfo>(*orig.resonanceData);
// change to std::make_unique once it bccomes available
resonanceData = std::unique_ptr<endf::ResonanceInfo>(new endf::ResonanceInfo(*orig.resonanceData));
}
if (orig.covarianceData != NULL){
covarianceData = std::make_shared<endf::CovarianceContainer>(*orig.covarianceData);
// change to std::make_unique once it bccomes available
covarianceData = std::unique_ptr<endf::CovarianceContainer>(new endf::CovarianceContainer(*orig.covarianceData));
}
if (orig.pointwiseData != NULL){
pointwiseData = std::make_shared<endf::Tab1Container>(*orig.pointwiseData);
// change to std::make_unique once it bccomes available
pointwiseData = std::unique_ptr<endf::Tab1Container>(new endf::Tab1Container(*orig.pointwiseData));
}
if (orig.evalInfo != NULL){
evalInfo = std::make_shared<endf::EvaluationInfo>(*orig.evalInfo);
// change to std::make_unique once it bccomes available
evalInfo = std::unique_ptr<endf::EvaluationInfo>(new endf::EvaluationInfo(*orig.evalInfo));
}
}
std::shared_ptr<endf::ResonanceInfo> endf::EndfData::getResonanceDataPtr(){
std::unique_ptr<endf::ResonanceInfo> & endf::EndfData::getResonanceDataPtr(){
if (resonanceData != NULL) return resonanceData;
if ( fileName.empty()) return NULL;
if( mat == -1) return NULL;
if ( fileName.empty()) return resonanceData;
if( mat == -1) return resonanceData;
std::ifstream endfIn(fileName.c_str(), std::ios::binary);
endf::ResonanceInfo * info = endf::getResonanceInfo( "endf", endfIn, mat);
endfIn.close();
resonanceData = std::shared_ptr<endf::ResonanceInfo>(info);
resonanceData = std::unique_ptr<endf::ResonanceInfo>(info);
convertToRMat(*resonanceData);
return resonanceData;
}
std::shared_ptr<endf::CovarianceContainer> endf::EndfData::getCovarianceDataPtr(){
std::unique_ptr<endf::CovarianceContainer> & endf::EndfData::getCovarianceDataPtr(){
if (covarianceData != NULL) return covarianceData;
if ( fileName.empty()) return NULL;
if( mat == -1) return NULL;
if ( fileName.empty()) return covarianceData;
if( mat == -1) return covarianceData;
std::ifstream endfIn(fileName.c_str(), std::ios::binary);
endf::CovarianceContainer * info = endf::retrieveCovariance("endf", endfIn, mat);
endfIn.close();
covarianceData = std::shared_ptr<endf::CovarianceContainer>(info);
covarianceData = std::unique_ptr<endf::CovarianceContainer>(info);
convertToRMat(*resonanceData);
return covarianceData;
}
std::shared_ptr<endf::Tab1Container> endf::EndfData::getPointwiseDataPtr(){
std::unique_ptr<endf::Tab1Container> & endf::EndfData::getPointwiseDataPtr(){
if (pointwiseData != NULL) return pointwiseData;
if ( fileName.empty()) return NULL;
if( mat == -1) return NULL;
if ( fileName.empty()) return pointwiseData;
if( mat == -1) return pointwiseData;
std::ifstream endfIn(fileName.c_str(), std::ios::binary);
endf::Tab1Container * info = endf::get1DPointWiseData("endf", endfIn, mat);
endfIn.close();
pointwiseData = std::shared_ptr<endf::Tab1Container>(info);
pointwiseData = std::unique_ptr<endf::Tab1Container>(info);
return pointwiseData;
}
std::shared_ptr<endf::EvaluationInfo> endf::EndfData::getEvalInfoPtr(){
std::unique_ptr<endf::EvaluationInfo> & endf::EndfData::getEvalInfoPtr(){
if (evalInfo != NULL) return evalInfo;
if ( fileName.empty()) return NULL;
if( mat == -1) return NULL;
if ( fileName.empty()) return evalInfo;
if( mat == -1) return evalInfo;
std::ifstream endfIn(fileName.c_str(), std::ios::binary);
endf::EvaluationInfo * info = new endf::EvaluationInfo();
endf::retrieveEvaluationInfo("endf", endfIn, mat, *info);
endfIn.close();
evalInfo = std::shared_ptr<endf::EvaluationInfo>(info);
evalInfo = std::unique_ptr<endf::EvaluationInfo>(info);
return evalInfo;
}
......@@ -115,3 +115,20 @@ void endf::EndfData::convertToRMat(endf::ResonanceInfo & info){
}
}
}
const endf::Tab1 * endf::EndfData::getTab1ByMt(int mt){
std::unique_ptr<endf::Tab1Container> & container = getPointwiseDataPtr();
if ( container == NULL) return NULL;
endf::Tab1Wrapper wrapper;
int length = container->getSize();
for ( int i = 0; i < length; i++){
container->getInfo(i, wrapper);
if( wrapper.getMt() == mt){
container->getData(i,wrapper);
return wrapper.getTab1();
}
}
return NULL;
}
sammy/src/endf/EndfData.h
+ 14
− 13
View file @ 1496ec6c
......@@ -16,38 +16,38 @@ namespace endf{
EndfData(const EndfData & orig);
virtual ~EndfData(){}
std::shared_ptr<endf::ResonanceInfo> getResonanceDataPtr();
std::unique_ptr<endf::ResonanceInfo> & getResonanceDataPtr();
endf::ResonanceInfo * getResonanceData(){
return getResonanceDataPtr().get();
}
void setResonanceData(endf::ResonanceInfo * info){
resonanceData = std::shared_ptr<endf::ResonanceInfo>(info);
resonanceData = std::unique_ptr<endf::ResonanceInfo>(info);
}
std::shared_ptr<endf::CovarianceContainer> getCovarianceDataPtr();
std::unique_ptr<endf::CovarianceContainer> & getCovarianceDataPtr();
endf::CovarianceContainer * getCovarianceData(){
return getCovarianceDataPtr().get();
}
void setCovarianceData(endf::CovarianceContainer * info){
covarianceData = std::shared_ptr<endf::CovarianceContainer>(info);
covarianceData = std::unique_ptr<endf::CovarianceContainer>(info);
}
std::shared_ptr<endf::Tab1Container> getPointwiseDataPtr();
std::unique_ptr<endf::Tab1Container> & getPointwiseDataPtr();
endf::Tab1Container * getPointwiseData(){
return getPointwiseDataPtr().get();
}
void setPointwiseData(endf::Tab1Container * info){
pointwiseData = std::shared_ptr<endf::Tab1Container>(info);
pointwiseData = std::unique_ptr<endf::Tab1Container>(info);
}
std::shared_ptr<endf::EvaluationInfo> getEvalInfoPtr();
std::unique_ptr<endf::EvaluationInfo> & getEvalInfoPtr();
endf::EvaluationInfo * getEvalInfo(){
return getEvalInfoPtr().get();
}
void setEvalInfo(endf::EvaluationInfo * info){
evalInfo = std::shared_ptr<endf::EvaluationInfo>(info);
evalInfo = std::unique_ptr<endf::EvaluationInfo>(info);
}
......@@ -70,24 +70,25 @@ namespace endf{
void getMatFromEndf();
private:
void convertToRMat(endf::ResonanceInfo & info);
const endf::Tab1 * getTab1ByMt(int mt);
private:
std::string fileName;
int mat;
/** The resonance data but not covariance data */
std::shared_ptr<endf::ResonanceInfo> resonanceData;
std::unique_ptr<endf::ResonanceInfo> resonanceData;
/** All covariance data */
std::shared_ptr<endf::CovarianceContainer> covarianceData;
std::unique_ptr<endf::CovarianceContainer> covarianceData;
/** All file 3 data */
std::shared_ptr<endf::Tab1Container> pointwiseData;
std::unique_ptr<endf::Tab1Container> pointwiseData;
/** File 1 information */
std::shared_ptr<endf::EvaluationInfo> evalInfo;
std::unique_ptr<endf::EvaluationInfo> evalInfo;
};
}
......
sammy/src/endf/interface/cix/EndfData.cpp2f.xml
+ 4
− 0
View file @ 1496ec6c
<generate name="EndfData">
<include_relative name="../../EndfData.h"/>
<include_relative name="ScaleUtils/EndfLib/Tab1Container.h"/>
<include_relative name="ScaleUtils/EndfLib/Tab1.h"/>
<include_relative name="ScaleUtils/EndfLib/ResonanceParameters.h"/>
<include_relative name="ScaleUtils/EndfLib/CovarianceContainer.h"/>
<include_relative name="ScaleUtils/EndfLib/EvaluationInfo.h"/>
......@@ -42,5 +43,8 @@
<method name="getMatFromEndf"/>
<method name="getTab1ByMt" return_type="Tab1*" >
<param name="mt" type="int"/>
</method>
</class>
</generate>
sammy/src/endf/interface/cpp/EndfDataInterface.cpp
+ 6
− 1
View file @ 1496ec6c
......@@ -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 Dec 18 11:29:01 EST 2018
* Date Generated: Fri Feb 21 11:33:23 EST 2020
* 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
*/
......@@ -81,6 +81,11 @@ void EndfData_getMatFromEndf(void * EndfData_ptr)
((EndfData*)EndfData_ptr)->getMatFromEndf();
}
void* EndfData_getTab1ByMt(void * EndfData_ptr,int * mt)
{
return (void*)((EndfData*)EndfData_ptr)->getTab1ByMt(*mt);
}
void* EndfData_initialize()
{
return new EndfData();
......
sammy/src/endf/interface/cpp/EndfDataInterface.h
+ 3
− 1
View file @ 1496ec6c
......@@ -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 Dec 18 11:29:01 EST 2018
* Date Generated: Fri Feb 21 11:33:23 EST 2020
* 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,6 +10,7 @@
#define ENDFDATAINTERFACE_H
#include "../../EndfData.h"
#include "ScaleUtils/EndfLib/Tab1Container.h"
#include "ScaleUtils/EndfLib/Tab1.h"
#include "ScaleUtils/EndfLib/ResonanceParameters.h"
#include "ScaleUtils/EndfLib/CovarianceContainer.h"
#include "ScaleUtils/EndfLib/EvaluationInfo.h"
......@@ -30,6 +31,7 @@ void EndfData_setFileName(void * EndfData_ptr,char* name);
int EndfData_getMat(void * EndfData_ptr);
void EndfData_setMat(void * EndfData_ptr,int * mat);
void EndfData_getMatFromEndf(void * EndfData_ptr);
void* EndfData_getTab1ByMt(void * EndfData_ptr,int * mt);
void* EndfData_initialize();
void EndfData_destroy(void * EndfData_ptr);
#ifdef __cplusplus
......
sammy/src/endf/interface/fortran/EndfData_I.f90
+ 7
− 1
View file @ 1496ec6c
......@@ -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 Dec 18 11:29:01 EST 2018
!! Date Generated: Fri Feb 21 11:33:23 EST 2020
!! 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
!!/
......@@ -82,6 +82,12 @@ subroutine f_EndfData_getMatFromEndf(EndfData_ptr ) BIND(C,name="EndfData_getMat
implicit none
type(C_PTR), value :: EndfData_ptr;
end subroutine
type(C_PTR) function f_EndfData_getTab1ByMt(EndfData_ptr, mt ) BIND(C,name="EndfData_getTab1ByMt")
use,intrinsic :: ISO_C_BINDING
implicit none
type(C_PTR), value :: EndfData_ptr;
integer(C_INT) :: mt;
end function
type(C_PTR) function f_EndfData_initialize( )BIND(C,name="EndfData_initialize")
use,intrinsic :: ISO_C_BINDING
implicit none
......
sammy/src/endf/interface/fortran/EndfData_M.f90
+ 10
− 1
View file @ 1496ec6c
......@@ -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 Dec 18 11:29:01 EST 2018
!! Date Generated: Fri Feb 21 11:33:23 EST 2020
!! 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
!!/
......@@ -12,6 +12,7 @@ use EndfData_I
use CovarianceContainer_M
use EvaluationInfo_M
use ResonanceParameters_M
use Tab1_M
use Tab1Container_M
type EndfData
type(C_PTR) :: instance_ptr=C_NULL_PTR
......@@ -29,6 +30,7 @@ type EndfData
procedure, pass(this) :: getMat => EndfData_getMat
procedure, pass(this) :: setMat => EndfData_setMat
procedure, pass(this) :: getMatFromEndf => EndfData_getMatFromEndf
procedure, pass(this) :: getTab1ByMt => EndfData_getTab1ByMt
procedure, pass(this) :: initialize => EndfData_initialize
procedure, pass(this) :: destroy => EndfData_destroy
end type EndfData
......@@ -112,6 +114,13 @@ subroutine EndfData_getMatFromEndf(this)
class(EndfData)::this
call f_EndfData_getMatFromEndf(this%instance_ptr)
end subroutine
subroutine EndfData_getTab1ByMt(this, object_ptr, mt)
implicit none
class(EndfData)::this
class(Tab1) :: object_ptr
integer(C_INT)::mt
object_ptr%instance_ptr = f_EndfData_getTab1ByMt(this%instance_ptr, mt)
end subroutine
subroutine EndfData_initialize(this)
implicit none
class(EndfData) :: this
......
sammy/src/mas/mmas0.f → sammy/src/mas/mmas0.f90
+ 79
− 70
View file @ 1496ec6c
C
C
C
module Sammas_0_m
contains
!
!
!
SUBROUTINE Sammas_0 (A)
C
C *** Purpose -- master control program for running SAMMY
C ***
C *** INPUT FILES FOR SAMMY
C *** Finput = 'xxxxxx.INP' UNIT 11
C *** Fparam = 'xxxxxx.PAR' UNIT 12
C *** Fdatax = 'xxxxxx.DAT' UNIT 13
C *** plus a few hundred others
C ***
C *** OUTPUT FILES
C *** 'SAMMY.LPT' UNIT 21
C *** 'SAMMY.IO ' UNIT 25
C *** TTY UNIT 5
C *** plus a few hundred others
C ***
C *** FILES FOR COMMUNICATING TO OTHER segments
C *** 'SAM17.DAT ' UNIT 17 (FOR SAMEND TO KNOW WHERE TO GO NEXT)
C *** 'SAM16.DAT ' UNIT 16 (TTY FOR FIRST 2 PASSES THRU SAMMY)
C *** 'SAM19.DAT ' UNIT 19 (TTY FOR THIRD PASS)
C *** 'SAM18.DAT ' UNIT 18 (TTY FOR SAMODF)
C *** 'SAM22.DAT ' UNIT 22 (INP FOR FIRST PASS THRU SAMMY)
C *** 'SAM23.DAT ' UNIT 23 (INP FOR SECOND PASS)
C *** 'SAM24.DAT ' UNIT 24 (INP FOR THIRD PASS)
C *** 'SAM60.DAT ' UNIT 60 (NAME OF "OTHER" FILES..
C *** ENDF/B6-3 OR INTEGRAL DATA)
C *** 'SAMEXP.DAT' UNIT 14 (DATA FILE IF INPUT IS ODF FILE)
C
!
! *** Purpose -- master control program for running SAMMY
! ***
! *** INPUT FILES FOR SAMMY
! *** Finput = 'xxxxxx.INP' UNIT 11
! *** Fparam = 'xxxxxx.PAR' UNIT 12
! *** Fdatax = 'xxxxxx.DAT' UNIT 13
! *** plus a few hundred others
! ***
! *** OUTPUT FILES
! *** 'SAMMY.LPT' UNIT 21
! *** 'SAMMY.IO ' UNIT 25
! *** TTY UNIT 5
! *** plus a few hundred others
! ***
! *** FILES FOR COMMUNICATING TO OTHER segments
! *** 'SAM17.DAT ' UNIT 17 (FOR SAMEND TO KNOW WHERE TO GO NEXT)
! *** 'SAM16.DAT ' UNIT 16 (TTY FOR FIRST 2 PASSES THRU SAMMY)
! *** 'SAM19.DAT ' UNIT 19 (TTY FOR THIRD PASS)
! *** 'SAM18.DAT ' UNIT 18 (TTY FOR SAMODF)
! *** 'SAM22.DAT ' UNIT 22 (INP FOR FIRST PASS THRU SAMMY)
! *** 'SAM23.DAT ' UNIT 23 (INP FOR SECOND PASS)
! *** 'SAM24.DAT ' UNIT 24 (INP FOR THIRD PASS)
! *** 'SAM60.DAT ' UNIT 60 (NAME OF "OTHER" FILES..
! *** ENDF/B6-3 OR INTEGRAL DATA)
! *** 'SAMEXP.DAT' UNIT 14 (DATA FILE IF INPUT IS ODF FILE)
!
use over_common_m
use oops_common_m
use fixedi_m
......@@ -41,25 +43,28 @@ C
use namfil_common_m
use mssccc_common_m
use zzzzz_common_m
use mmas1_m
use mmas3_m
use mmas6_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
DIMENSION A(-Msize:Msize)
C
C
!
!
CALL Newopn (70, Samiox, 0)
C
C
!
!
WRITE (6,99999)
99999 FORMAT (' *** SAMMAS 3 Jan 08 ***')
Segmen(1) = 'M'
Segmen(2) = 'A'
Segmen(3) = 'S'
Nowwww = 0
C
!
CALL Timer (1)
C *** Zero all variables in B0?ZYX
! *** Zero all variables in B0?ZYX
CALL Zero_Integer (Lf, 300)
CALL Zero_Integer (Lwrit, 200)
C
!
Nsize = Msize
Knsize = Kmsize
Jnsize = Jmsize
......@@ -69,72 +74,72 @@ C
Max = - Msize
Maxt = - Msize
If_Odf = 0
C
C *** Learn names of INPut and PARameter files [#1 & #2 in "order"]
!
! *** Learn names of INPut and PARameter files [#1 & #2 in "order"]
CALL Inppar
C
C *** Go through PARameter and INPut files
!
! *** Go through PARameter and INPut files
CALL Finpx
IF (Ndfinp.EQ.1 .AND. Kompci.EQ.1) Icovar = 1
CALL Setcns (Kvendf, 0)
IF (Ndfinp.EQ.0) CALL Fpar_If_Cov
CALL Finp (Lrfx)
C
C *** IF unresolved resonance region, treat separately
!
! *** IF unresolved resonance region, treat separately
IF (Iftacs.EQ.1) THEN
CALL Wrt16x
CLOSE (UNIT=11)
CALL Run ('samfff')
RETURN
END IF
C
!
IF (Ksum.EQ.1) THEN
CALL Parcov (Lrfx)
CALL Sumstr
C *** If want only summed strength, bypass most subprograms
C
! *** If want only summed strength, bypass most subprograms
!
ELSE
C *** Learn DATa file name and energy range (#3 in "order")
C *** and WWWYYY file name if it exists (#4 in "order")
! *** Learn DATa file name and energy range (#3 in "order")
! *** and WWWYYY file name if it exists (#4 in "order")
CALL Datcov
C
C *** Also learn parameter COVariance file name if it exists (#6),
C *** and finishing making SAMNDF.PAR file
!
! *** Also learn parameter COVariance file name if it exists (#6),
! *** and finishing making SAMNDF.PAR file
CALL Parcov (Lrfx)
C
!
Meeeee = (Msize-20)/2
Ieee = Idimen (Meeeee, 1, 'Meeeee, 1')
Ieed = Idimen (Meeeee, 1, 'Meeeee, 1')
C *** Go through DATa file
IF (Kendf.EQ.0 .AND. Krecon.EQ.0 .AND. Kartgd.EQ.0 .AND.
* Kwywyw.EQ.0 .AND. Kkclqx.EQ.0) THEN
! *** Go through DATa file
IF (Kendf.EQ.0 .AND. Krecon.EQ.0 .AND. Kartgd.EQ.0 .AND. &
Kwywyw.EQ.0 .AND. Kkclqx.EQ.0) THEN
CALL Fdat (A(Ieee), A(Ieed), Meeeee)
END IF
C
C *** Generate files that look like interactive input
!
! *** Generate files that look like interactive input
CALL Writ16
IF (Ntggen.NE.0) CALL Writ19
C
C *** Read other data file names and/or energy-ranges
C *** (#7 in "order")
!
! *** Read other data file names and/or energy-ranges
! *** (#7 in "order")
IF (Kendf.EQ.0 .AND. Kwywyw.EQ.0) THEN
CALL File2x (A(Ieee), A(Ieed), Meeeee)
END IF
I = Idimen (Ieee, -1, 'Ieee, -1')
C
C *** Make new INPut files if needed (SAM22,23,24)
!
! *** Make new INPut files if needed (SAM22,23,24)
IF (Ntggen.NE.0 .OR. Kkclqx.NE.0) CALL New_Input_File
C
!
CLOSE (UNIT=11)
CLOSE (UNIT=16)
C
!
END IF
C
C *** Finish by writing time and moving to new segment
!
! *** Finish by writing time and moving to new segment
CALL Finis1
C
!
IF (Kkclqx.NE.0 .OR. Kartgd.EQ.1) THEN
cx IF (Kkclqx.NE.0) THEN
!cx IF (Kkclqx.NE.0) THEN
CALL Run ('saminp')
ELSE IF (Kartgd.NE.0) THEN
CALL Run ('samend')
......@@ -146,5 +151,9 @@ cx IF (Kkclqx.NE.0) THEN
CALL Run ('saminp')
END IF
RETURN
C END SUBROUTINE Sammas_0
END
END SUBROUTINE Sammas_0
end module Sammas_0_m
sammy/src/mas/mmas1.f → sammy/src/mas/mmas1.f90
+ 440
− 437
View file @ 1496ec6c
This diff is collapsed.
sammy/src/mas/mmas3.f → sammy/src/mas/mmas3.f90
+ 227
− 227
View file @ 1496ec6c
This diff is collapsed.
sammy/src/mas/mmas6.f → sammy/src/mas/mmas6.f90
+ 375
− 374
View file @ 1496ec6c
This diff is collapsed.
sammy/src/odf/modf0.f → sammy/src/odf/modf0.f90
+ 31
− 21
View file @ 1496ec6c
C
C
C --------------------------------------------------------------
C
module Samodf_0_m
contains
!
!
! --------------------------------------------------------------
!
SUBROUTINE Samodf_0 (A)
C
C *** Purpose -- initiate plot file (ODF file) for use with SAMMY
C
!
! *** Purpose -- initiate plot file (ODF file) for use with SAMMY
!
use over_common_m
use oops_common_m
use samxxx_common_m
......@@ -14,14 +17,17 @@ C
use aaaodf_common_m
use ffnnnn_common_m
use AllocateFunctions_m
use modf1_m
use EndfData_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
DIMENSION A(-Msize:Msize)
real(kind=8),allocatable,dimension(:)::A_Ie, A_id, A_Iu, A_Idum
C
C
EXTERNAL Idimen
type(EndfData)::reader
WRITE (6,99999)
99999 FORMAT (' *** SAMMY-ODF 5 Sep 08 ***')
C
!
Segmen(1) = 'O'
Segmen(2) = 'D'
Segmen(3) = 'F'
......@@ -30,15 +36,16 @@ C
Knsize = Kmsize
Jnsize = Jmsize
If_Odf = 1
C
C
!
!
call reader%initialize()
CALL Oldopn (18, Sam18x, 0)
CALL Chck18 (Ktzero)
C *** Reads file SAM18.DAT and counts Nregns
C
CALL Read18 (A(1), Ndat, Nmax)
C *** Reads file SAM18.DAT for real, also scans the data file
C
! *** Reads file SAM18.DAT and counts Nregns
!
CALL Read18 (A(1), Ndat, Nmax, reader)
! *** Reads file SAM18.DAT for real, also scans the data file
!
Nn = Ndat
IF (Nangle.GT.0) Nn = Ndat*Nangle
call allocate_real_data(A_Ie, Ndat)
......@@ -46,17 +53,20 @@ C
call allocate_real_data(A_Iu, Nn)
N = (Ndat+1)
call allocate_real_data(A_Idum,N)
CALL Fixodf (A_Ie, A_Id, A_Iu, A_Idum, Ktzero, Nmax)
C *** Reads data files (Unit 13) and generates ODF files (unit 72 etc)
CALL Fixodf (A_Ie, A_Id, A_Iu, A_Idum, Ktzero, Nmax, reader)
call reader%destroy()
! *** Reads data files (Unit 13) and generates ODF files (unit 72 etc)
deallocate(A_Ie)
deallocate(A_Id)
deallocate(A_Iu)
deallocate(A_Idum)
C
CLOSE (UNIT=18)
Ix = 0
CALL Timer (Ix)
CALL Run ('samend')
RETURN
END
END SUBROUTINE Samodf_0
end module Samodf_0_m
sammy/src/odf/modf1.f → sammy/src/odf/modf1.f90
+ 271
− 276
View file @ 1496ec6c
This diff is collapsed.
sammy/src/odf/modf4.f deleted 100755 → 0
+ 0
− 110
View file @ 76c36016
C
C
C __________________________________________________________________________
C
SUBROUTINE C13_Endf (Emin, Emax, Ndat, Nmax, Ksodf, Matdat)
IMPLICIT DOUBLE PRECISION (a-h,o-z)
DIMENSION Aaa(3)
C
C *** Find location in ENDF file
Ndfdat = -Ksodf
CALL Find_Matnum_In_ENDF_File (Matdat, 3, Ndfdat, Za, Awr, Nisotp,
* 13)
C
C *** Read interpolation scheme
READ (13,10100) C1, C2, L1, L2, Nr, Np
10100 FORMAT (1P2E11.4, 4I11)
Nr6 = Nr/3
IF (Nr6*3.NE.Nr) Nr6 = Nr6 + 1
Min = 1
Max = 3
IF (Nr6.GT.0) THEN
DO I=1,Nr6
READ (13,10200) (Nbt,Int,N=Min,Max)
Min = Max + 1
Max = Max + 3
END DO
END IF
10200 FORMAT (6I11)
C
C *** Read energies
Np3 = Np/3
IF (Np3*3.NE.Np) Np3 = Np3 + 1
Min = 1
Max = 3
Kountr = 0
DO I=1,Np3
READ (13,10300) (Aaa(N),Dd,N=1,3)
10300 FORMAT (6E11.4)
DO N=1,3
IF (Aaa(N).GE.Emin .AND. Aaa(N).LE.Emax) Kountr = Kountr + 1
END DO
Min = Max + 1
Max = Max + 3
END DO
Nmax = Np
Ndat = Kountr
C
C
REWIND (UNIT=13)
C
C
C *** Find location in ENDF file (yes, again)
CALL Find_Matnum_In_ENDF_File (Matdat, 3, Ndfdat, Za, Awr, Nisotp,
* 13)
C
C *** Read interpolation scheme (again)
READ (13,10100) C1, C2, L1, L2, Nr, Np
Min = 1
Max = 3
IF (Nr6.GT.0) THEN
DO I=1,Nr6
READ (13,10200) (Nbt,Int,N=Min,Max)
Min = Max + 1
Max = Max + 3
END DO
END IF
RETURN
END
C
C
C __________________________________________________________________________
C
SUBROUTINE R13_Endf (Energy, Data, Error, Emin, Emax, Oodfmu,
* Kmin, Kmax, Ndat, Nmax)
IMPLICIT DOUBLE PRECISION (a-h,o-z)
DIMENSION Energy(*), Data(*), Error(*)
DIMENSION Aaa(3), Bbb(3)
DATA Zero /0.0d0/, Small /0.001d0/, Tenth /0.10d0/
C
Np = Nmax
Np3 = Np/3
IF (Np3*3.NE.Np) Np3 = Np3 + 1
Min = 1
Max = 3
K2 = 0
Nn = 0
DO I=1,Np3
READ (13,10100) (Aaa(N),Bbb(N),N=1,3)
10100 FORMAT (6E11.4)
DO N=1,3
Nn = Nn + 1
IF (Nn.GT.Np) GO TO 10
IF (Aaa(N).GE.Emin .AND. Aaa(N).LE.Emax) THEN
K2 = K2 + 1
Energy(K2) = Aaa(N)*Oodfmu
Data(K2) = Bbb(N)
Error(K2) = Bbb(N)*Tenth
IF (Bbb(N).EQ.Zero) Error(K2) = Small
END IF
END DO
Min = Max + 1
Max = Max + 3
END DO
10 CONTINUE
CLOSE (UNIT=13)
Ndat = K2
Kmin = 1
Kmax = Ndat
RETURN
END
sammy/src/odf/modf4.f90 0 → 100755
+ 112
− 0
View file @ 1496ec6c
This diff is collapsed.
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment