diff --git a/sammy/src/dat/mdat0.f b/sammy/src/dat/mdat0.f90
similarity index 63%
rename from sammy/src/dat/mdat0.f
rename to sammy/src/dat/mdat0.f90
index 0559a47a32980968224099493715c77d594fd093..547f1c1e972b863ff93e10ccea863b9eecd00099 100644
--- a/sammy/src/dat/mdat0.f
+++ b/sammy/src/dat/mdat0.f90
@@ -1,8 +1,10 @@
-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
diff --git a/sammy/src/dat/mdat2.f b/sammy/src/dat/mdat2.f90
similarity index 71%
rename from sammy/src/dat/mdat2.f
rename to sammy/src/dat/mdat2.f90
index bdf7617934eadf7d8078b2d398eaa2c30fade6b7..0afc487dccf5b12f07dff5f0ee3d8859a22bb4ad 100644
--- a/sammy/src/dat/mdat2.f
+++ b/sammy/src/dat/mdat2.f90
@@ -1,65 +1,71 @@
-C
-C
-C ______________________________________________________________
-C
- SUBROUTINE Read00 (Ntot, Bcf, Cf2, Dopwid, Parext, Jflext,
- * Parorr, Ecrnch, Endets, Sesese, Eseses, Parrpi, Edxrpi, Xxxrpi,
- * Parudr, Nud_E, Nud_T, UdE, UdR, UdT, UdR_E, UdT_E, E, Krext,
- * Ii, Iwhich, Mind, Mine, Maxe, Maxd, Nmax)
-C
-C *** Purpose -- Read data file through once to learn dimensions and
-C *** positions of data in the file
-C
+module mdat2_m
+
+ contains
+!
+!
+! ______________________________________________________________
+!
+ SUBROUTINE Read00 (Ntot, Bcf, Cf2, Dopwid, Parext, Jflext, &
+ Parorr, Ecrnch, Endets, Sesese, Eseses, Parrpi, Edxrpi, Xxxrpi, &
+ Parudr, Nud_E, Nud_T, UdE, UdR, UdT, UdR_E, UdT_E, E, Krext, &
+ Ii, Iwhich, Mind, Mine, Maxe, Maxd, Nmax, reader)
+!
+! *** Purpose -- Read data file through once to learn dimensions and
+! *** positions of data in the file
+!
use fixedi_m
use ifwrit_m
use exploc_common_m
use fixedr_m
use namfil_common_m
+ use mdatb_m
+ use EndfData_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
COMMON /Odfspc/ Nsect, Nch
- DIMENSION Ntot(*), Bcf(*), Cf2(*), Dopwid(*),
- * Parext(Krext,Ntotc,*), Jflext(Krext,Ntotc,*), Parorr(*),
- * Ecrnch(*), Endets(*), Sesese(*), Eseses(*), Parrpi(*),
- * Edxrpi(*), Xxxrpi(*), Parudr(*)
- DIMENSION Nud_E(*), Nud_t(*), UdE(Nudeng,*), UdR(Nudtim,Nudeng,*),
- * UdT(Nudtim,Nudeng,*), UdR_E(*), UdT_E(*)
+ type(EndfData)::reader
+ DIMENSION Ntot(*), Bcf(*), Cf2(*), Dopwid(*), &
+ Parext(Krext,Ntotc,*), Jflext(Krext,Ntotc,*), Parorr(*), &
+ Ecrnch(*), Endets(*), Sesese(*), Eseses(*), Parrpi(*), &
+ Edxrpi(*), Xxxrpi(*), Parudr(*)
+ DIMENSION Nud_E(*), Nud_t(*), UdE(Nudeng,*), UdR(Nudtim,Nudeng,*), &
+ UdT(Nudtim,Nudeng,*), UdR_E(*), UdT_E(*)
DIMENSION E(*), Ehkeep(4)
Data Nodpoc /3/, Zero /0.0d0/
-C
-c? Emin = Emin0
-c? Emax = Emax0
+!
+!c? Emin = Emin0
+!c? Emax = Emax0
IF (Kartgd.EQ.1 .OR. Kkclqx.NE.0) THEN
-C *** Learn dimensions for making artificial energy grid
+! *** Learn dimensions for making artificial energy grid
Ndat = Ngpnts
IF (Ngpnts.LE.0) THEN
IF (Kartgd.EQ.1) Ndat = 10001
IF (Kkclqx.NE.0) Ndat = 1001
-cx IF (Kkclqx.NE.0) Ndat = 101
+!cx IF (Kkclqx.NE.0) Ndat = 101
END IF
Ndatb = Ndat
Iptdop = 21
Iptwid = 6
IF (Kartgd.EQ.1) THEN
ELSE
-C *** find energy limits for the various processes --
- CALL Limits (Ntot, Bcf, Cf2, Dopwid, Parext, Jflext, Parorr,
- * Ecrnch, Endets, Sesese, Eseses, Parrpi, Edxrpi, Xxxrpi,
- * Parudr, Nud_E, Nud_T, UdE, UdR, UdT, UdR_E, UdT_E, Krext)
+! *** find energy limits for the various processes --
+ CALL Limits (Ntot, Bcf, Cf2, Dopwid, Parext, Jflext, Parorr, &
+ Ecrnch, Endets, Sesese, Eseses, Parrpi, Edxrpi, Xxxrpi, &
+ Parudr, Nud_E, Nud_T, UdE, UdR, UdT, UdR_E, UdT_E, Krext)
END IF
RETURN
END IF
-C
-C *** The following initialization required by some compilers
+!
+! *** The following initialization required by some compilers
DO I=1,4
Ehkeep(I) = Zero
END DO
-C
+!
IF (Ksodf.EQ.1 .OR. Ksodf.EQ.2) THEN
-C *** Read from ODF file
+! *** Read from ODF file
CALL Pltio (14, Fdatax(1), 0, Nsect, N_Data_Points, Kkkk)
IF (N_Data_Points.GT.Ii) WRITE (6,10100) N_Data_Points, Ii
Nmax = N_Data_Points - Ixxchn
-C *** Remember Ixxchn is "number of (energy) channels to be ignored"
+! *** Remember Ixxchn is "number of (energy) channels to be ignored"
10100 FORMAT (' ODF file has more data points than permitted ', 2I10)
Ixxch1 = Ixxchn + 1
CALL Pltin (14, Nsect, 1, Ixxch1, Nmax, E, 1)
@@ -67,15 +73,14 @@ C *** Remember Ixxchn is "number of (energy) channels to be ignored"
WRITE (21,10200)
WRITE ( 6,10200)
STOP '[Stop in Read00 in dat/mdat2.f]'
-10200 FORMAT (' Cannot use STANDARD data format with this version o
- *of SAMMY ')
+10200 FORMAT (' Cannot use STANDARD data format with this version of SAMMY ')
END IF
IF (E(Nmax).LE.Zero) Nmax = Nmax - 1
-C
-C
+!
+!
ELSE IF (Ksodf.EQ.0) THEN
-C *** Read one number per "card", even if there are really three data
-C *** points per card
+! *** Read one number per "card", even if there are really three data
+! *** points per card
CALL Filopn (13, Fdatax(1), 0)
DO I=1,Ii
IF (Mmdata.EQ.1) THEN
@@ -96,16 +101,16 @@ C *** points per card
IF (E(I).EQ.Zero) GO TO 30
END DO
WRITE (6,10600) Ii
-10600 FORMAT (' Oops... array size is not large enough to', /,
- * ' accommodate the entire data set', I10)
+10600 FORMAT (' Oops... array size is not large enough to', /, &
+ ' accommodate the entire data set', I10)
30 CONTINUE
Nmax = I - 1
IF (E(Nmax).LE.Zero) Nmax = Nmax - 1
REWIND 13
-C
-C
+!
+!
ELSE IF (Ksodf.EQ.3) THEN
-C *** Here for ascii-type angular distribution data
+! *** Here for ascii-type angular distribution data
CALL Filopn (13, Fdatax(1), 0)
DO I=1,Ii
READ (13,10700,END=33,ERR=33) E(I), (X,J=1,Nangle)
@@ -118,34 +123,34 @@ C *** Here for ascii-type angular distribution data
Nmax = I - 1
IF (E(Nmax).LE.Zero) Nmax = Nmax - 1
REWIND 13
-C
+!
ELSE IF (Ksodf.EQ.10) THEN
- CALL Rd0_Endf_10 (E, Nmax)
-C
+ CALL ReadFile3Energy (E, Nmax, reader)
+!
ELSE
WRITE (6,10800) Ksodf
10800 FORMAT ('Ksodf =', I3, ' which is not allowed')
STOP '[Stop in Read00 in dat/mdat2.f # 2]'
END IF
-C
-C
+!
+!
IF (Nmax.GT.1) THEN
-C
-C *** find Energy-order
+!
+! *** find Energy-order
I = 10
J = 20
IF (J.GT.Nmax) J = Nmax
IF (I.GE.J) I = J - 1
IF (E(I).GT.E(J)) Iwhich = 1
-C Energies are high-to-low
+! Energies are high-to-low
IF (E(I).LT.E(J)) Iwhich = 2
-C Energies are low-to-high
+! Energies are low-to-high
IF (E(I).EQ.E(J)) Iwhich = 0
-C oops
-C
-C *** now check whether Emin & Emax are reasonably defined
+! oops
+!
+! *** now check whether Emin & Emax are reasonably defined
IF (Iwhich.EQ.1) THEN
-C *** reverse energy-ordered (high to low)
+! *** reverse energy-ordered (high to low)
Efirst = E(Nmax)
Second = E(Nmax-1)
IF (Ksodf.EQ.0 .AND. Mmdata.NE.1 .AND. Mmdata.NE.2) THEN
@@ -164,7 +169,7 @@ C *** reverse energy-ordered (high to low)
Elast = E(1)
El = (-E(2)+E(1))/8.0D0
ELSE
-C *** regular energy-ordered (low to high)
+! *** regular energy-ordered (low to high)
Efirst = E(1)
Ef = (E(2)-E(1))/8.0D0
Elast = E(Nmax)
@@ -189,9 +194,9 @@ C *** regular energy-ordered (low to high)
IF (Emin.LT.Efirst) THEN
WRITE (21,10900) Emin, Efirst
WRITE (6,10900) Emin, Efirst
-10900 FORMAT (' Emin', 1PG14.6, ' is less than the minimum',
- * 1X, 'energy in the data set', /
- * ' Emin has been changed to', 1PG14.6)
+10900 FORMAT (' Emin', 1PG14.6, ' is less than the minimum', &
+ 1X, 'energy in the data set', / &
+ ' Emin has been changed to', 1PG14.6)
WRITE (21,11000) Kprint, (E(I),I=1,Kprint)
WRITE ( 6,11000) Kprint, (E(I),I=1,Kprint)
11000 FORMAT (' First ', I1, ' energies=', /, 2X, 1P5G15.7)
@@ -204,9 +209,9 @@ C *** regular energy-ordered (low to high)
IF (Emax.GT.Elast ) THEN
WRITE (21,11200) Emax, Elast
WRITE (6,11200) Emax, Elast
-11200 FORMAT (' Emax', 1PG14.6, ' is greater than the maximum',
- * 1X, 'energy in the data set', /
- * ' Emax has been changed to', 1PG14.6)
+11200 FORMAT (' Emax', 1PG14.6, ' is greater than the maximum', &
+ 1X, 'energy in the data set', / &
+ ' Emax has been changed to', 1PG14.6)
WRITE (21,11000) Kprint, (E(I),I=1,Kprint)
WRITE ( 6,11000) Kprint, (E(I),I=1,Kprint)
WRITE (21,11100) Kprint, (E(Nmax+1-I),I=1,Kprint)
@@ -216,29 +221,28 @@ C *** regular energy-ordered (low to high)
ELSE
Iwhich = 0
END IF
-C
-C *** find Energy limits for the various processes --
- CALL Limits (Ntot, Bcf, Cf2, Dopwid, Parext, Jflext,Parorr,
- * Ecrnch, Endets, Sesese, Eseses, Parrpi, Edxrpi, Xxxrpi, Parudr,
- * Nud_E, Nud_T, UdE, UdR, UdT, UdR_E, UdT_E, Krext)
-C
-C
-C *** check whether energies are redundant
+!
+! *** find Energy limits for the various processes --
+ CALL Limits (Ntot, Bcf, Cf2, Dopwid, Parext, Jflext,Parorr, &
+ Ecrnch, Endets, Sesese, Eseses, Parrpi, Edxrpi, Xxxrpi, Parudr, &
+ Nud_E, Nud_T, UdE, UdR, UdT, UdR_E, UdT_E, Krext)
+!
+!
+! *** check whether energies are redundant
DO I=2,Nmax
- IF ( (Iwhich.EQ.2 .AND. E(I).LE.E(I-1)) .OR.
- * (Iwhich.EQ.1 .AND. E(I).GE.E(I-1)) ) THEN
+ IF ( (Iwhich.EQ.2 .AND. E(I).LE.E(I-1)) .OR. &
+ (Iwhich.EQ.1 .AND. E(I).GE.E(I-1)) ) THEN
WRITE ( 6,11300) I, E(I-1), E(I)
WRITE (21,11300) I, E(I-1), E(I)
STOP '[Stop in Read00 in dat/mdat2.f # 3]'
END IF
END DO
-11300 FORMAT (' ### For i=', I6, ' two data points are mis-ordered:',/
- * 2(1PG14.7), ' ###')
-C
-C
-C
-C *** Find positions of Emind, Emin, Emax, Emaxd within {E(I)}
-C
+11300 FORMAT (' ### For i=', I6, ' two data points are mis-ordered:', 2(1PG14.7), ' ###')
+!
+!
+!
+! *** Find positions of Emind, Emin, Emax, Emaxd within {E(I)}
+!
! get index just below for Emind and save in mind
! if Emin > Emind, get the index just below Emin and save in mine
! if emin <= Emind, mine == mind
@@ -270,129 +274,130 @@ C
END IF
! make sure the range goes one below to ensure all data a loaded
+
IF (Mine.GT.1) Mine = Mine - 1
IF (Mind.GT.1) Mind = Mind - 1
ndat = maxe - mine + 1
ndatb = maxd - mind + 3
-C
+!
IF (Mmdata.EQ.0 .AND. Ksodf.EQ.0) Ndat = Ndat*Nodpoc
IF (Mmdata.EQ.0 .AND. Ksodf.EQ.0) Ndatb = Ndatb*Nodpoc
-C *** Ndatb is a (large enough; ie conservative) estimate of how
-C *** many points total will be read in
+! *** Ndatb is a (large enough; ie conservative) estimate of how
+! *** many points total will be read in
RETURN
- END
-C
-C
-C ______________________________________________________________
-C
- SUBROUTINE Readin (Jfldtp, Energy, Ee, Dummy, Data, Vardat,
- * Ptilde, Gtilde, Ndatt, Mind, Mine, Maxe, Maxd, Iwhich, Nmax)
-C
-C *** Purpose -- Call routines which read data file for real
-C
+ END SUBROUTINE Read00
+!
+!
+! ______________________________________________________________
+!
+ SUBROUTINE Readin (Jfldtp, Energy, Ee, Dummy, Data, Vardat, &
+ Ptilde, Gtilde, Ndatt, Mind, Mine, Maxe, Maxd, Iwhich, Nmax, reader)
+!
+! *** Purpose -- Call routines which read data file for real
+!
use ifwrit_m
use fixedr_m
use namfil_common_m
+ use mdatb_m
+ use EndfData_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
- DIMENSION Jfldtp(*), Energy(*), Ee(*), Dummy(*), Data(*),
- * Vardat(*), Ptilde(*), Gtilde(*)
-C
-C
+ type(EndfData)::reader
+ DIMENSION Jfldtp(*), Energy(*), Ee(*), Dummy(*), Data(*), &
+ Vardat(*), Ptilde(*), Gtilde(*)
+!
+!
IF (Kartgd.EQ.1 .OR. Kkclqx.NE.0) THEN
CALL Makegd (Energy, Ee, Data, Vardat, Emin, Emax)
RETURN
END IF
-C
+!
IF (Ksodf.EQ.0) THEN
-C *** Ascii files
-C
+! *** Ascii files
+!
IF (Mmdata.EQ.0) THEN
-C *** Three data points per line, ie original format
- CALL Rddat0 (Energy, Ee, Data, Vardat, Mind, Mine, Maxe,
- * Maxd)
-C
+! *** Three data points per line, ie original format
+ CALL Rddat0 (Energy, Ee, Data, Vardat, Mind, Mine, Maxe, Maxd)
+!
ELSE IF (Mmdata.EQ.1 .OR. Mmdata.EQ.2) THEN
-C *** One data point per line, csisrs format or 20-sig-digits
- CALL Rddat1 (Energy, Ee, Data, Vardat, Mind, Mine, Maxe,
- * Maxd)
+! *** One data point per line, csisrs format or 20-sig-digits
+ CALL Rddat1 (Energy, Ee, Data, Vardat, Mind, Mine, Maxe, Maxd)
END IF
-C
-C *** Among other things, Rddatx converts from uncertainty to variance
-C *** and inverts the order if high-to-low
+!
+! *** Among other things, Rddatx converts from uncertainty to variance
+! *** and inverts the order if high-to-low
CALL Rddatx (Energy, Ee, Dummy, Data, Vardat, Iwhich)
-C
-C
+!
+!
ELSE IF (Ksodf.EQ.1) THEN
-C *** Stndrd reads and orders Data and Covariance from "standard ODF
-C *** data file"
- CALL Stndrd (Jfldtp, Energy, Ee, Dummy, Data, Vardat,
- * Ptilde, Gtilde, Mine, Mind)
-C
-C
+! *** Stndrd reads and orders Data and Covariance from "standard ODF
+! *** data file"
+ CALL Stndrd (Jfldtp, Energy, Ee, Dummy, Data, Vardat, &
+ Ptilde, Gtilde, Mine, Mind)
+!
+!
ELSE IF (Ksodf.EQ.2) THEN
-C *** Anglrd reads angular distribution from ODF file
- CALL Anglrd (Energy, Ee, Data, Vardat, Dummy, Ndatt, Mine,
- * Mind)
-C
-C
+! *** Anglrd reads angular distribution from ODF file
+ CALL Anglrd (Energy, Ee, Data, Vardat, Dummy, Ndatt, Mine, &
+ Mind)
+!
+!
ELSE IF (Ksodf.EQ.3) THEN
-C *** Angxrd reads angular distribution from ASCII file
- CALL Angxrd (Energy, Ee, Data, Vardat, Dummy, Iwhich, Mind,
- * Mine, Maxe, Maxd)
-C
-C
+! *** Angxrd reads angular distribution from ASCII file
+ CALL Angxrd (Energy, Ee, Data, Vardat, Dummy, Iwhich, Mind, &
+ Mine, Maxe, Maxd)
+!
+!
ELSE IF (Ksodf.EQ.10) THEN
-C *** Read (angle-integrated) data from ENDF file
- CALL Rd_Endf_10 (Energy, Ee, Data, Vardat, Mind, Mine, Maxe,
- * Maxd, Nmax)
+! *** Read (angle-integrated) data from ENDF file
+ CALL FillFromFile3Data (Energy, Ee, Data, Vardat, Mind, Mine, Maxe, &
+ Maxd, reader)
CALL Rddatx (Energy, Ee, Dummy, Data, Vardat, Iwhich)
-C
+!
ELSE
STOP '[STOP in Readin in dat/mdat2.f]'
-C
+!
END IF
-C
+!
IF (Fdtcov.NE.Dblank) CALL Qdatcv (Vardat)
IF (Kdatv .EQ.1 ) CALL Qdatv1 (Energy, Vardat, Ndat)
-C
+!
RETURN
- END
-C
-C
-C --------------------------------------------------------------
-C
- SUBROUTINE Rddat1 (Energy, Ee, Data, Vardat, Mind, Mine, Maxe,
- * Maxd)
-C
-C *** Purpose -- Read the energy, cross section (or transmission),
-C *** and determine the variance Vardata
-C *** NOTE -- what's set here is Vardat = SQRT(Variance) = Uncertainty
-C
-C *** This version assumes one data point per line, in 3G11.8 format,
-C *** with input uncertainties being absolute. ie CSISRS data.
-C *** Alternatively, 3G20.8 format, for greater precision.
-C
+ END SUBROUTINE Readin
+!
+!
+! --------------------------------------------------------------
+!
+ SUBROUTINE Rddat1 (Energy, Ee, Data, Vardat, Mind, Mine, Maxe, Maxd)
+!
+! *** Purpose -- Read the energy, cross section (or transmission),
+! *** and determine the variance Vardata
+! *** NOTE -- what's set here is Vardat = SQRT(Variance) = Uncertainty
+!
+! *** This version assumes one data point per line, in 3G11.8 format,
+! *** with input uncertainties being absolute. ie CSISRS data.
+! *** Alternatively, 3G20.8 format, for greater precision.
+!
use ifwrit_m
use fixedr_m
use namfil_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
-C
+!
DIMENSION Energy(*), Ee(*), Data(*), Vardat(*)
-C
-C
+!
+!
10000 FORMAT (3G11.4)
10002 FORMAT (3G20.8)
-C
+!
IF (Mind.GT.1) THEN
-C *** Read records before data on file
+! *** Read records before data on file
DO I=1,Mind-1
IF (Mmdata.EQ.1) READ (13,10000) X
IF (Mmdata.EQ.2) READ (13,10002) X
END DO
END IF
-C
-C *** Read from Emind to Emin (or Emax to Emaxd)
+!
+! *** Read from Emind to Emin (or Emax to Emaxd)
N = Mine - Mind
IF (N.GT.0) THEN
DO I=1,N
@@ -400,8 +405,8 @@ C *** Read from Emind to Emin (or Emax to Emaxd)
IF (Mmdata.EQ.2) READ (13,10002) Ee(I)
END DO
END IF
-C
-C *** Read data
+!
+! *** Read data
DO I=1,Ndat
IF (Mmdata.EQ.1) THEN
READ (13,10000) Energy(I), Data(I), Vardat(I)
@@ -409,14 +414,14 @@ C *** Read data
READ (13,10002) Energy(I), Data(I), Vardat(I)
END IF
END DO
-C
-C *** Copy Energy to Energb
+!
+! *** Copy Energy to Energb
DO I=1,Ndat
Ee(I+N) = Energy(I)
END DO
N = N + Ndat
-C
-C *** Read Energb above data
+!
+! *** Read Energb above data
M = Maxd - Maxe
IF (M.GT.0) THEN
DO I=1,M
@@ -425,43 +430,42 @@ C *** Read Energb above data
END DO
END IF
Ndatb = N + M
-C
+!
RETURN
- END
-C
-C
-C --------------------------------------------------------------
-C
- SUBROUTINE Rddat0 (Energy, Ee, Data, Vardat, Mind, Mine, Maxe,
- * Maxd)
-C
-C *** Purpose -- Read the energy, cross section (or transmission) data,
-C *** and determine the variance Vardat
-C *** NOTE -- what's set here is Vardat = Uncertainty
-C
-C *** This version assumes three data points per line, in 3(2E15.8,F7.5)
-C *** format, with input uncertainties being relative. ie MULTI data.
-C
+ END SUBROUTINE Rddat1
+!
+!
+! --------------------------------------------------------------
+!
+ SUBROUTINE Rddat0 (Energy, Ee, Data, Vardat, Mind, Mine, Maxe, Maxd)
+!
+! *** Purpose -- Read the energy, cross section (or transmission) data,
+! *** and determine the variance Vardat
+! *** NOTE -- what's set here is Vardat = Uncertainty
+!
+! *** This version assumes three data points per line, in 3(2E15.8,F7.5)
+! *** format, with input uncertainties being relative. ie MULTI data.
+!
use ifwrit_m
use fixedr_m
use namfil_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
-C
+!
DIMENSION Energy(*), Ee(*), Data(*), Vardat(*)
Data Nodpoc /3/
-C
-C
+!
+!
10000 FORMAT (3(2E15.8, F7.5))
10200 FORMAT (3(E15.8, 22X))
-C
+!
IF (Mind.GT.1) THEN
-C *** READ those records that occur prior to the data on the file
+! *** READ those records that occur prior to the data on the file
DO I=1,Mind-1
READ (13,10000) X
END DO
END IF
-C
-C *** Read from Emind to Emin (or Emax to Emaxd)
+!
+! *** Read from Emind to Emin (or Emax to Emaxd)
N = Mine - Mind
IF (N.GT.0) THEN
DO I=1,N
@@ -470,23 +474,22 @@ C *** Read from Emind to Emin (or Emax to Emaxd)
END DO
END IF
N = N * Nodpoc
-C
-C *** Read data
-C *** ?? This assumes data starts at first position on the line
+!
+! *** Read data
+! *** ?? This assumes data starts at first position on the line
Ncard = Ndat/Nodpoc
DO I=1,Ncard
Ii = Nodpoc*(I-1)
- READ (13,10000) (Energy(Ii+J),Data(Ii+J),Vardat(Ii+J),
- * J=1,Nodpoc)
+ READ (13,10000) (Energy(Ii+J),Data(Ii+J),Vardat(Ii+J), J=1,Nodpoc)
END DO
-C
-C *** Copy into Ee
+!
+! *** Copy into Ee
DO I=1,Ndat
Ee(I+N) = Energy(I)
END DO
N = N + Ndat
-C
-C *** Test to be sure data is within range ... first, at upper end
+!
+! *** Test to be sure data is within range ... first, at upper end
J = Ndat
DO I=1,Ndat
IF (Energy(J).LE.Emax .AND. Energy(J).GE.Emin) GO TO 90
@@ -495,7 +498,7 @@ C *** Test to be sure data is within range ... first, at upper end
STOP '[STOP in Rddat0 in dat/mdat2.f]'
90 CONTINUE
Ndat = J
-C *** Now, at lower end
+! *** Now, at lower end
K = 0
J = Min0(6,Ndat)
DO I=1,J
@@ -509,13 +512,13 @@ C *** Now, at lower end
END DO
Ndat = Ndat - K
END IF
-C
-C *** Change uncertainties from relative to absolute
+!
+! *** Change uncertainties from relative to absolute
DO I=1,Ndat
Vardat(I) = Dabs(Vardat(I)*Data(I))
END DO
-C
-C *** Read Ee above data
+!
+! *** Read Ee above data
Ii = N
M = Maxd - Maxe
IF (M.GT.0) THEN
@@ -525,9 +528,9 @@ C *** Read Ee above data
END DO
150 CONTINUE
END IF
-C
+!
Ndatb = Ii
-C *** Test whether final values are zero
+! *** Test whether final values are zero
J = Ndatb
IF (Nodpoc.GT.1) THEN
DO I=2,Nodpoc
@@ -540,39 +543,39 @@ C *** Test whether final values are zero
END IF
160 CONTINUE
Ndatb = J
-C
+!
RETURN
- END
-C
-C
-C --------------------------------------------------------------
-C
+ END SUBROUTINE Rddat0
+!
+!
+! --------------------------------------------------------------
+!
SUBROUTINE Rddatx (Energy, Ee, Dummy, Data, Vardat, Iwhich)
-C
-C *** Purpose -- remove Junk (Zero's and #'s outside [Emind,Emaxd]) on
-C *** ends of Ee
-C *** -- If data is in reversed order (high-to-low), reorder
-C *** -- double-check Energy limits; write range
-C *** -- test if uncertainty is smaller than vmin, increase if needed
-C *** -- convert from uncertainty to covariance
-C *** -- check whether Vardat should be in triangular form rather
-C *** than diagonal, and convert if needed
-C
+!
+! *** Purpose -- remove Junk (Zero's and #'s outside [Emind,Emaxd]) on
+! *** ends of Ee
+! *** -- If data is in reversed order (high-to-low), reorder
+! *** -- double-check Energy limits; write range
+! *** -- test if uncertainty is smaller than vmin, increase if needed
+! *** -- convert from uncertainty to covariance
+! *** -- check whether Vardat should be in triangular form rather
+! *** than diagonal, and convert if needed
+!
use ifwrit_m
use samxxx_common_m
use fixedr_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
DIMENSION Energy(*), Ee(*), Dummy(*), Data(*), Vardat(*)
Data Zero /0.0d0/
-C
-C *** First double-check to be sure Ee does not have weird points (like,
-C *** zeros)
+!
+! *** First double-check to be sure Ee does not have weird points (like,
+! *** zeros)
IF (Ee(1).EQ.Zero) THEN
Ee(1) = Ee(2)*0.0001d0
END IF
Emindx = Emind
IF (Emind.LT.Zero) Emindx = Zero
-C *** start at upper end
+! *** start at upper end
Ii = Ndatb + 1
Idatb = 0
DO I=1,Ndatb
@@ -582,24 +585,24 @@ C *** start at upper end
ELSE
Idatb = Idatb + 1
END IF
-C IF (Ee(Ii).LE.Emaxd .AND. Ee(Ii).GT.Emindx) GO TO 20
-C all are OK so keep them and continue
-C IF (Ee(Ii).GT.Emaxd .OR. Ee(Ii).LE.Emindx) Ndatb = Ndatb - 1
-C drop this point & check the next one
-C Oops, except we want to keep the ONE point just above Emaxd
-C Ergo, Ndatb = Ndatb - Idatb + 1 below
+! IF (Ee(Ii).LE.Emaxd .AND. Ee(Ii).GT.Emindx) GO TO 20
+! all are OK so keep them and continue
+! IF (Ee(Ii).GT.Emaxd .OR. Ee(Ii).LE.Emindx) Ndatb = Ndatb - 1
+! drop this point & check the next one
+! Oops, except we want to keep the ONE point just above Emaxd
+! Ergo, Ndatb = Ndatb - Idatb + 1 below
END DO
WRITE (6,10100) Emindx, Emaxd
WRITE (21,10100) Emindx, Emaxd
-10100 FORMAT (/, ' ################################################',
- * /, ' Error in calculation of energy limits:', /, 1p2g14.6,
- * /, ' ################################################')
+10100 FORMAT (/, ' ################################################', &
+ /, ' Error in calculation of energy limits:', /, 1p2g14.6, &
+ /, ' ################################################')
STOP '[STOP in Rddatx in dat/mdat2.f]'
20 CONTINUE
-C
+!
IF (Idatb.GT.0) Ndatb = Ndatb - Idatb + 1
-C
-C *** now at lower end
+!
+! *** now at lower end
Ii = 0
DO I=1,Ndatb
IF (Ee(I).LE.Emaxd .AND. Ee(I).GT.Emindx) THEN
@@ -607,19 +610,19 @@ C *** now at lower end
ELSE
Ii = I
END IF
-C IF (Ee(I).LE.Emaxd .AND. Ee(I).GT.Emindx) GO TO 40
-C all are OK so keep them and continue
-C IF (Ee(i).GT.Emaxd .OR. Ee(i).LE.Emindx) Ii = I
-C drop this point & check the next one
-C Except want to keep one point lower than Emindx
+! IF (Ee(I).LE.Emaxd .AND. Ee(I).GT.Emindx) GO TO 40
+! all are OK so keep them and continue
+! IF (Ee(i).GT.Emaxd .OR. Ee(i).LE.Emindx) Ii = I
+! drop this point & check the next one
+! Except want to keep one point lower than Emindx
END DO
STOP '[STOP in Rddatx in dat/mdat2.f # 2]'
40 CONTINUE
-C
+!
IF (Ii.NE.0) THEN
IF (Ii.NE.1) THEN
- IF (Iwhich.EQ.2 .AND. Ee(Ii-1).LE.Emindx .AND.
- * Ee(Ii-1).NE.0.0) Ii = Ii - 1
+ IF (Iwhich.EQ.2 .AND. Ee(Ii-1).LE.Emindx .AND. &
+ Ee(Ii-1).NE.0.0) Ii = Ii - 1
IF (Iwhich.EQ.1 .AND. Ee(Ii-1).GT.Emaxd) Ii = Ii - 1
END IF
M = 1
@@ -630,10 +633,10 @@ C
END DO
Ndatb = Ndatb - Ii + 1
END IF
-C
+!
IF (Iwhich.EQ.1) THEN
-C Re-order as needed
-C
+! Re-order as needed
+!
DO I=1,Ndat
Dummy(I) = Energy(I)
END DO
@@ -642,7 +645,7 @@ C
Ii = Ii - 1
Energy(I) = Dummy(Ii)
END DO
-C
+!
DO I=1,Ndat
Dummy(I) = Data(I)
END DO
@@ -651,7 +654,7 @@ C
Ii = Ii - 1
Data(I) = Dummy(Ii)
END DO
-C
+!
DO I=1,Ndat
Dummy(I) = Vardat(I)
END DO
@@ -660,7 +663,7 @@ C
Ii = Ii - 1
Vardat(I) = Dummy(Ii)
END DO
-C
+!
DO I=1,Ndatb
Dummy(I) = Ee(I)
END DO
@@ -669,34 +672,34 @@ C
Ii = Ii - 1
Ee(I) = Dummy(Ii)
END DO
-C
+!
END IF
-C
-C
-C *** check if Energy is within limits; write range
+!
+!
+! *** check if Energy is within limits; write range
CALL Cklimi (Energy, Data, Vardat)
-C
-C
+!
+!
IF (Kdatv.EQ.0) THEN
-C
-C
-C *** Here cov matrix is always diagonal..........................
-C
-C *** IF needed, overwrite uncertainties to 10% of data
+!
+!
+! *** Here cov matrix is always diagonal..........................
+!
+! *** IF needed, overwrite uncertainties to 10% of data
IF (Iprcnt.EQ.1) THEN
DO I=1,Ndat
Vardat(I) = Dabs(Data(I))*0.10
END DO
END IF
-C
-C *** check for Vmin ?
+!
+! *** check for Vmin ?
IF (Vmin.NE.Zero) THEN
DO I=1,Ndat
IF (Vardat(I).LE.Vmin) Vardat(I) = Vmin
END DO
END IF
-C
-C *** check whether uncertainties are positive
+!
+! *** check whether uncertainties are positive
N = 0
DO I=1,Ndat
IF (Vardat(I).LE.Zero) THEN
@@ -705,21 +708,21 @@ C *** check whether uncertainties are positive
WRITE (6,99995) I, Energy(I), Data(I), Vardat(I)
END IF
END DO
-99995 FORMAT (/' ********* Data HAS ZERO UNCERTAINTY *************',
- * /, ' Energy(', I3, ')=', 1PE15.8, ' Data=', 1PE15.8,
- * ' Absolute uncertainty=', 1PE14.5)
+99995 FORMAT (/' ********* Data HAS ZERO UNCERTAINTY *************', &
+ /, ' Energy(', I3, ')=', 1PE15.8, ' Data=', 1PE15.8, &
+ ' Absolute uncertainty=', 1PE14.5)
IF (N.GT.0) STOP '[STOP in Rddatx in dat/mdat2.f # 3]'
-C
-C *** convert to variance
+!
+! *** convert to variance
DO I=1,Ndat
Vardat(I) = Vardat(I)**2
END DO
N = Ndat
-C
-C
+!
+!
ELSE
-C *** Here Vardat is off-diagonal (though we have not yet read the off-
-C *** diagonal pieces); convert to covariance
+! *** Here Vardat is off-diagonal (though we have not yet read the off-
+! *** diagonal pieces); convert to covariance
DO I=1,Ndat
Dummy(I) = Vardat(I) ** 2
END DO
@@ -732,25 +735,25 @@ C *** diagonal pieces); convert to covariance
Vardat(Ij) = Dummy(I)
END DO
N = Ij
-C
+!
END IF
-C
+!
RETURN
- END
-C
-C
-C
-C --------------------------------------------------------------
-C
+ END SUBROUTINE Rddatx
+!
+!
+!
+! --------------------------------------------------------------
+!
SUBROUTINE Qdatcv (Vardat)
-C
+!
use ifwrit_m
use namfil_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
-C
+!
DIMENSION Vardat(*)
CALL Filopn (63, Fdtcov, 0)
-C
+!
IF (Kdatv.EQ.3) THEN
Ij = 0
Jj = 1
@@ -769,7 +772,7 @@ C
Jj = Ij + 1
END DO
END IF
-C
+!
CLOSE (UNIT=63)
Jj = 0
DO J=1,Ndat
@@ -777,24 +780,24 @@ C
IF (Vardat(Jj).EQ.0.0d0) GO TO 30
END DO
RETURN
-C
+!
30 WRITE (6,99998) J
WRITE (21,99998) J
99998 FORMAT (' Uncertainty on Data Point', I3, ' is zero')
STOP '[STOP in Qdatcv in dat/mdat2.f]'
-C
- END
-C
-C
-C --------------------------------------------------------------
-C
+!
+ END SUBROUTINE Qdatcv
+!
+!
+! --------------------------------------------------------------
+!
SUBROUTINE Qdatv1 (Energy, Vardat, Ndat)
-C
+!
use fixedr_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
-C
+!
DIMENSION Energy(*), Vardat(*)
-C
+!
Ij = 0
DO I=1,Ndat
A = Dcova + Energy(I)*Dcovb
@@ -805,43 +808,43 @@ C
END DO
END DO
RETURN
- END
-C
-C
-C --------------------------------------------------------------
-C
+ END SUBROUTINE Qdatv1
+!
+!
+! --------------------------------------------------------------
+!
SUBROUTINE Wr44 (Energy, Data, Vardat, Nvpdtp, Nnndat, Ndatt)
-C
+!
use ifwrit_m
use samxxx_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
DIMENSION Energy(*), Data(*), Vardat(*)
-C
+!
CALL Newopn (50, Sam50x, 1)
WRITE (50) (Energy(I),I=1,Ndat)
CLOSE (UNIT=50)
-C
+!
CALL Newopn (44, Sam44x, 1)
WRITE (44) (Data(J),J=1,Nnndat)
WRITE (44) (Vardat(J),J=1,Ndatt)
CLOSE (UNIT=44)
RETURN
- END
-C
-C
-C --------------------------------------------------------------
-C
+ END SUBROUTINE Wr44
+!
+!
+! --------------------------------------------------------------
+!
SUBROUTINE Cklimi (Energy, Data, Vardat)
-C
-C *** Purpose -- Check to be sure limits in Energy are still correct. First
-C *** Data point should be ABOVE Emin and last data point BELOW Emax.
-C
+!
+! *** Purpose -- Check to be sure limits in Energy are still correct. First
+! *** Data point should be ABOVE Emin and last data point BELOW Emax.
+!
use fixedi_m
use ifwrit_m
use fixedr_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
DIMENSION Energy(*), Data(Numcro,*), Vardat(Numcro,*)
-C
+!
Imin = 0
N = Min0(5,Ndat)
DO I=1,N
@@ -864,57 +867,56 @@ C
END DO
Ndat = Ndat - Imin
END IF
-C
+!
N = Max0(Ndat-4,1)
Imax = N
DO I=N,Ndat
IF (Energy(I).LE.Emax) Imax = I
END DO
Ndat = Imax
-C
-C
-C *** display information
+!
+!
+! *** display information
WRITE (21,99998) Emin, Emax, Ndat
-99998 FORMAT (/' Energy range of data is from ', 1PE11.5, ' to ',
- * E11.5, ' eV.', /,
- * ' Number of experimental data points =', I8, /)
-C
+99998 FORMAT (/' Energy range of data is from ', 1PE11.5, ' to ', &
+ E11.5, ' eV.', /, &
+ ' Number of experimental data points =', I8, /)
+!
RETURN
- END
-C
-C
-C --------------------------------------------------------------
-C
- SUBROUTINE Angxrd (Energy, Ee, Data, Vardat, Dummy, Iwhich, Mind,
- * Mine, Maxe, Maxd)
-C
-C
-C *** PURPOSE -- READ THE Energy, CROSS SECTIONs at all angles,
-C *** AND DETERMine THE VARIANCE Vardat
-C *** This sbroutne for ASCII data file for Differential Elastic data
-C
+ END SUBROUTINE Cklimi
+!
+!
+! --------------------------------------------------------------
+!
+ SUBROUTINE Angxrd (Energy, Ee, Data, Vardat, Dummy, Iwhich, Mind, &
+ Mine, Maxe, Maxd)
+!
+!
+! *** PURPOSE -- READ THE Energy, CROSS SECTIONs at all angles,
+! *** AND DETERMine THE VARIANCE Vardat
+! *** This sbroutne for ASCII data file for Differential Elastic data
+!
use fixedi_m
use ifwrit_m
use fixedr_m
use namfil_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
-C
- DIMENSION Energy(*), Ee(*), Data(Numcro,*), Vardat(Numcro,*),
- * Dummy(*)
+!
+ DIMENSION Energy(*), Ee(*), Data(Numcro,*), Vardat(Numcro,*), Dummy(*)
DATA Zero /0.0d0/
-C
-C
+!
+!
10000 FORMAT (8F10.1)
-C
+!
IF (Mind.GT.1) THEN
-C *** READ records before data on file
+! *** READ records before data on file
DO I=1,Mind-1
READ (13,10000) (X,J=1,Nangle+1)
READ (13,10000) (X,J=1,Nangle+1)
END DO
END IF
-C
-C *** Read from Emind to Emin (or Emax to Emaxd)
+!
+! *** Read from Emind to Emin (or Emax to Emaxd)
N = Mine - Mind
IF (N.GT.0) THEN
DO I=1,N
@@ -922,20 +924,20 @@ C *** Read from Emind to Emin (or Emax to Emaxd)
READ (13,10000) X, (X,J=1,Nangle)
END DO
END IF
-C
-C *** Read data
+!
+! *** Read data
DO I=1,Ndat
READ (13,10000) Energy(I), (Data(J,I),J=1,Nangle)
READ (13,10000) X, (Vardat(J,I),J=1,Nangle)
END DO
-C
-C *** Copy Energy to Energb
+!
+! *** Copy Energy to Energb
DO I=1,Ndat
Ee(I+N) = Energy(I)
END DO
N = N + Ndat
-C
-C *** Read Energb above data
+!
+! *** Read Energb above data
M = Maxd - Maxe
IF (M.GT.0) THEN
DO I=1,M
@@ -944,35 +946,35 @@ C *** Read Energb above data
END DO
END IF
Ndatb = N + M
-C
+!
IF (Iwhich.EQ.1) THEN
-C *** reorder Energy, Data, and Ee
+! *** reorder Energy, Data, and Ee
DO I=1,Ndat
Dummy(I) = Energy(I)
END DO
CALL Upside (Energy, Dummy, Ndat, 1)
-C
+!
DO J=1,Nangle
DO I=1,Ndat
Dummy(I) = Data(J,I)
END DO
CALL Upside (Data(J,1), Dummy, Ndat, Nangle)
END DO
-C
+!
DO J=1,Nangle
DO I=1,Ndat
Dummy(I) = Vardat(J,I)
END DO
CALL Upside (Vardat(J,1), Dummy, Ndat, Nangle)
END DO
-C
+!
DO I=1,Ndatb
Dummy(i) = Ee(I)
END DO
CALL Upside (Ee, Dummy, Ndatb, 1)
-C
+!
END IF
-C
+!
DO I=1,Ndat
DO J=1,Nangle
@@ -980,38 +982,38 @@ C
Vardat(J,I) = Vardat(J,I)**2
END DO
END DO
-C
+!
CALL Cklimi (Energy, Data, Vardat)
RETURN
- END
-C
-C
-C --------------------------------------------------------------
-C
+ END SUBROUTINE Angxrd
+!
+!
+! --------------------------------------------------------------
+!
SUBROUTINE Upside (Aa, B, N, M)
IMPLICIT DOUBLE PRECISION (a-h,o-z)
DIMENSION Aa(*), B(*)
-C DIMENSION Aa(N), B(N)
+! DIMENSION Aa(N), B(N)
J = (N-1)*M + 1
DO I=1,N
Aa(J) = B(I)
J = J - M
END DO
RETURN
- END
-C
-C
-C ______________________________________________________________
-C
+ END SUBROUTINE Upside
+!
+!
+! ______________________________________________________________
+!
SUBROUTINE Makegd (Energy, Ee, Data, Vardat, Emin, Emax)
-C
-C *** Purpose -- Create an artificial energy grid when there is
-C *** no data file
-C
-C *** For Kartgd=1, grid is equally-spaced in velocity since this makes
-C *** most sense at low energy and doesn't hurt at higher energy
-C *** For Kkclqx=1, uniform in energy; =2, in velocity; =3, in 1/V=time
-C
+!
+! *** Purpose -- Create an artificial energy grid when there is
+! *** no data file
+!
+! *** For Kartgd=1, grid is equally-spaced in velocity since this makes
+! *** most sense at low energy and doesn't hurt at higher energy
+! *** For Kkclqx=1, uniform in energy; =2, in velocity; =3, in 1/V=time
+!
use ifwrit_m
use oopsch_common_m
use abro_common_m
@@ -1019,16 +1021,16 @@ C
DIMENSION Energy(*), Ee(*), Data(*), Vardat(*)
Data Zero /0.0d0/, One /1.0d0/, Two /2.0d0/, Four /4.0d0/
Data Hundrth /0.01d0/
-C
-C
+!
+!
Energy(1) = Emin
Energy(Ndat) = Emax
Ee(1) = Energy(1)
Ee(Ndat) = Energy(Ndat)
-C
+!
IF (Kkclqx.EQ.1) THEN
-C
-C *** uniform in energy
+!
+! *** uniform in energy
Smin = Emin
Edelta = (Emax-Smin)/dFLOAT(Ndat-1)
DO I=2,Ndat-1
@@ -1037,10 +1039,10 @@ C *** uniform in energy
END DO
Emin = Emin - Edelta*Hundrth
Emax = Emax + Edelta*Hundrth
-C
+!
ELSE IF (Kkclqx.EQ.2 .OR. Kartgd.EQ.1) THEN
-C
-C *** uniform in velocity
+!
+! *** uniform in velocity
Smin = dSQRT(Emin)
Smax = dSQRT(Emax)
Edelta = (Smax-Smin)/dFLOAT(Ndat-1)
@@ -1052,8 +1054,8 @@ C *** uniform in velocity
Emin = (Smin-Edelta*Hundrth)**2
Emax = (Smax+Edelta*Hundrth)**2
ELSE
-C *** Here the change in velocity is greater than the smallest
-C *** velocity so need to force additional points to be added
+! *** Here the change in velocity is greater than the smallest
+! *** velocity so need to force additional points to be added
IF (Energy(1).NE.Zero) THEN
Energy(2) = Four*Energy(1)
ELSE
@@ -1068,10 +1070,10 @@ C *** velocity so need to force additional points to be added
END DO
Emax = (Smax+Edelta*Hundrth)**2
END IF
-C
+!
ELSE IF (Kkclqx.EQ.3) THEN
-C
-C *** uniform in 1/V=time
+!
+! *** uniform in 1/V=time
Smin = One/dSQRT(Emin)
Smax = One/dSQRT(Emax)
Edelta = (Smax-Smin)/dFLOAT(Ndat-1)
@@ -1081,9 +1083,9 @@ C *** uniform in 1/V=time
END DO
Emin = One/(Smin-Edelta*Hundrth)**2
Emax = One/(Smax+Edelta*Hundrth)**2
-C
+!
END IF
-C
+!
IF (Kkkclq.NE.0) THEN
CALL Make_Clqdv (Energy, Data, Vardat)
ELSE
@@ -1092,7 +1094,7 @@ C
Vardat(I) = One
END DO
END IF
-C
+!
Ooo = One
IF (Kartgd.EQ.0) THEN
IF (Keveng.EQ.0) THEN
@@ -1110,7 +1112,7 @@ C
Odffff = Ooo
Nsntyp = 7
If_Odf = 1
-C *** = 1 needed to get SAMMY.PLT file
+! *** = 1 needed to get SAMMY.PLT file
CALL Pltio (72, 'SAMMY.ODF ', 1, Nsntyp, Ndat, Keveng)
CALL Pltzer (72, Nsntyp, 1, Ndat)
IF (Keveng.NE.1) THEN
@@ -1129,17 +1131,17 @@ C *** = 1 needed to get SAMMY.PLT file
CALL Plt_Close (72)
END IF
RETURN
- END
-C
-C
-C ______________________________________________________________
-C
+ END SUBROUTINE Makegd
+!
+!
+! ______________________________________________________________
+!
SUBROUTINE Artificial_Energy (Energy, Ndat, Keveng)
-C
+!
IMPLICIT DOUBLE PRECISION (a-h,o-z)
DIMENSION Energy(*)
-C
-C *** Initialize the Plot File
+!
+! *** Initialize the Plot File
Nsntyp = 11
New = 1
Input = 0
@@ -1171,30 +1173,30 @@ C *** Initialize the Plot File
END IF
CALL Plt_Close (72)
RETURN
- END
-C
-C
-C --------------------------------------------------------------
-C
+ END SUBROUTINE Artificial_Energy
+!
+!
+! --------------------------------------------------------------
+!
SUBROUTINE Make_Clqdv (Energy, Data, Vardat)
-C
-C *** PURPOSE -- Generate "cross section" which is Constant (Kkkclq=1),
-C *** Linear (2), Quadratic (3), Dirac-delta (4), 1/v (5)
-C *** for use in debugging resolution (& other)
-C
+!
+! *** PURPOSE -- Generate "cross section" which is Constant (Kkkclq=1),
+! *** Linear (2), Quadratic (3), Dirac-delta (4), 1/v (5)
+! *** for use in debugging resolution (& other)
+!
use ifwrit_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
-C
-C
+!
+!
DIMENSION Energy(*), Data(*), Vardat(*)
Data Zero /0.0d0/, Tenth /0.1d0/, One /1.0d0/, Two /2.0d0/
-C
+!
Eminxx = Energy(1)
Emaxxx = Energy(Ndat)
Em = Zero
-C
+!
IF (Kkclqx.LE.1) THEN
-C cross section is a function of Energy
+! cross section is a function of Energy
X2 = Emaxxx
X1 = Eminxx
IF (Kkkclq.EQ.4) THEN
@@ -1202,7 +1204,7 @@ C cross section is a function of Energy
Em = Xm
END IF
ELSE IF (Kkclqx.EQ.2) THEN
-C cross section is a function of velocity
+! cross section is a function of velocity
X2 = dSQRT(Emaxxx)
X1 = dSQRT(Eminxx)
IF (Kkkclq.EQ.4) THEN
@@ -1210,7 +1212,7 @@ C cross section is a function of velocity
Em = Xm**2
END IF
ELSE IF (Kkclqx.EQ.3) THEN
-C cross section is a function of time
+! cross section is a function of time
X2 = One/dSQRT(Emaxxx)
X1 = One/dSQRT(Eminxx)
IF (Kkkclq.EQ.4) THEN
@@ -1220,7 +1222,7 @@ C cross section is a function of time
ELSE
STOP '[Kkclqx is out-of-bounds in Make_Clqdv in dat/mdat2.f]'
END IF
-C
+!
Jmid = 1
IF (Kkkclq.EQ.4) THEN
DO Jdat=1,Ndat
@@ -1231,7 +1233,7 @@ C
END DO
10 CONTINUE
END IF
-C
+!
A0 = One
A1 = Zero
A2 = Zero
@@ -1257,40 +1259,40 @@ C
ELSE
STOP '[Kkkclq is out-of-bounds in Make_Clqdv in dat/mdat2.f]'
END IF
-C
-C
-C
+!
+!
+!
DO Jdat=1,Ndat
Su = Energy(Jdat)
Squ = dSQRT(Su)
-C
+!
IF (Kkkclq.LT.4) THEN
-C constant, linear, or Quadratic
+! constant, linear, or Quadratic
IF (Kkclqx.EQ.1) THEN
-C in Energy
+! in Energy
X = Su
ELSE IF (Kkclqx.EQ.2) THEN
-C in velocity
+! in velocity
X = Squ
ELSE IF (Kkclqx.EQ.3) THEN
-C in time
+! in time
X = One/Squ
ELSE
X = Zero
END IF
Data(Jdat) = A0 + A1*X + A2*X**2
ELSE IF (Kkkclq.EQ.4) THEN
-C Dirac delta function
+! Dirac delta function
Data(Jdat) = Zero
IF (Jdat.EQ.Jmid) Data(Jdat) = One
ELSE IF (Kkkclq.EQ.5) THEN
-C 1/v = 1/sqrt(E)
+! 1/v = 1/sqrt(E)
Data(Jdat) = One/Squ
END IF
-C
+!
END DO
-C *** end of do-loop on Energies
-C
+! *** end of do-loop on Energies
+!
DO Jdat=1,Ndat
IF (Data(Jdat).NE.Zero) THEN
Vardat(Jdat) = Tenth*Data(Jdat)
@@ -1298,6 +1300,7 @@ C
Vardat(Jdat) = Tenth
END IF
END DO
-C
+!
RETURN
- END
+ END SUBROUTINE Make_Clqdv
+end module mdat2_m
diff --git a/sammy/src/dat/mdat3.f b/sammy/src/dat/mdat3.f
index b1b69e472eba8e5405627c5164751feb19357841..af5e655bac6ec47fcb7c24b911d7ae6a9bf903f7 100755
--- a/sammy/src/dat/mdat3.f
+++ b/sammy/src/dat/mdat3.f
@@ -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,*),
diff --git a/sammy/src/dat/mdatb.f b/sammy/src/dat/mdatb.f
deleted file mode 100644
index 881b4ac69de532088fbe67ebb73057ade6f36126..0000000000000000000000000000000000000000
--- a/sammy/src/dat/mdatb.f
+++ /dev/null
@@ -1,114 +0,0 @@
-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
diff --git a/sammy/src/dat/mdatb.f90 b/sammy/src/dat/mdatb.f90
new file mode 100644
index 0000000000000000000000000000000000000000..71e48c74d7b4ab18991b00f7a4288cc8098c0c20
--- /dev/null
+++ b/sammy/src/dat/mdatb.f90
@@ -0,0 +1,109 @@
+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
diff --git a/sammy/src/endf/EndfData.cpp b/sammy/src/endf/EndfData.cpp
index 53e9cbd6a6f1aa760fb41f10fba849c566f27b98..fe5fae5f78a4ea4ac27b3a791131837f82413ef2 100644
--- a/sammy/src/endf/EndfData.cpp
+++ b/sammy/src/endf/EndfData.cpp
@@ -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;
+}
diff --git a/sammy/src/endf/EndfData.h b/sammy/src/endf/EndfData.h
index a12fb94c5d58ca44f502cc6f6a174d9334eea77a..df2394571e27c8582e5bcb62892cd3dfe6a2b388 100644
--- a/sammy/src/endf/EndfData.h
+++ b/sammy/src/endf/EndfData.h
@@ -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;
};
}
diff --git a/sammy/src/endf/interface/cix/EndfData.cpp2f.xml b/sammy/src/endf/interface/cix/EndfData.cpp2f.xml
index dbfa7d69c55f3f10a5abd7c5d78aeed73f620ae8..9df87270889fd706c9c9b034132b47566d3d7d86 100644
--- a/sammy/src/endf/interface/cix/EndfData.cpp2f.xml
+++ b/sammy/src/endf/interface/cix/EndfData.cpp2f.xml
@@ -1,6 +1,7 @@
<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>
diff --git a/sammy/src/endf/interface/cpp/EndfDataInterface.cpp b/sammy/src/endf/interface/cpp/EndfDataInterface.cpp
index 49cbea540b6c27c447b395dbd48fa41fd180ca95..97f92693743ee92878c6b3aba4792c2e5ea10931 100644
--- a/sammy/src/endf/interface/cpp/EndfDataInterface.cpp
+++ b/sammy/src/endf/interface/cpp/EndfDataInterface.cpp
@@ -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();
diff --git a/sammy/src/endf/interface/cpp/EndfDataInterface.h b/sammy/src/endf/interface/cpp/EndfDataInterface.h
index fa61a9e858bea9405bc175a96894cbc917f79f88..4d90d3c8138f508f23e673038d1827830f7c00c6 100644
--- a/sammy/src/endf/interface/cpp/EndfDataInterface.h
+++ b/sammy/src/endf/interface/cpp/EndfDataInterface.h
@@ -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
diff --git a/sammy/src/endf/interface/fortran/EndfData_I.f90 b/sammy/src/endf/interface/fortran/EndfData_I.f90
index a1d7fdc7cbde98e686f09ddd118ba1ae417f11fb..60de4e528db344d8fb5c9f80501649888a4bf598 100644
--- a/sammy/src/endf/interface/fortran/EndfData_I.f90
+++ b/sammy/src/endf/interface/fortran/EndfData_I.f90
@@ -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
diff --git a/sammy/src/endf/interface/fortran/EndfData_M.f90 b/sammy/src/endf/interface/fortran/EndfData_M.f90
index ea33df84ed09afd7a15a4bd378b01a56fb4b37c9..89ef3037226001eadb106fa0245810470c956a0e 100644
--- a/sammy/src/endf/interface/fortran/EndfData_M.f90
+++ b/sammy/src/endf/interface/fortran/EndfData_M.f90
@@ -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
diff --git a/sammy/src/mas/mmas0.f b/sammy/src/mas/mmas0.f90
similarity index 51%
rename from sammy/src/mas/mmas0.f
rename to sammy/src/mas/mmas0.f90
index db6c8f49f9ddba25e705d4032d9c7431c1cc73c2..cbe52848216117fdb86cdbf182c7d062d02030f5 100644
--- a/sammy/src/mas/mmas0.f
+++ b/sammy/src/mas/mmas0.f90
@@ -1,34 +1,36 @@
-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
+
+
+
diff --git a/sammy/src/mas/mmas1.f b/sammy/src/mas/mmas1.f90
similarity index 65%
rename from sammy/src/mas/mmas1.f
rename to sammy/src/mas/mmas1.f90
index 7d0436193618632825d9b1318e0e014293a2c3f7..0a3c07c5b1629cacc9da5723e776a0e7ffd60e24 100644
--- a/sammy/src/mas/mmas1.f
+++ b/sammy/src/mas/mmas1.f90
@@ -1,15 +1,17 @@
-C
-C
-C --------------------------------------------------------------
-C
+module mmas1_m
+contains
+!
+!
+! --------------------------------------------------------------
+!
SUBROUTINE Inppar
-C
+!
use namfil_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
-C
-C
-C *************************************************************** File 1
-C *** NAME OF INPUT FILE
+!
+!
+! *************************************************************** File 1
+! *** NAME OF INPUT FILE
WRITE (6,99997)
99997 FORMAT (' What is the name of the INPut file? ')
READ (5,99998) Finput
@@ -18,29 +20,29 @@ C *** NAME OF INPUT FILE
89995 FORMAT (' >>> ', A70, ' <<<')
WRITE (21,99995) Finput
99995 FORMAT (' Name of input file: ', /, ' >>> ', A70, ' <<<')
-C
-C *************************************************************** File 2
-C *** NAME OF PARAMETER FILE
+!
+! *************************************************************** File 2
+! *** NAME OF PARAMETER FILE
WRITE (6,99996)
99996 FORMAT (' What is the name of the PARameter file? ')
READ (5,99998) Fparam
WRITE (6,89995) Fparam
WRITE (21,99994) Fparam
99994 FORMAT (' Name of parameter file: ', /, ' >>> ', A70, ' <<<')
-C
+!
RETURN
-C
- END
-C
-C
-C --------------------------------------------------------------
-C
+!
+ END SUBROUTINE Inppar
+!
+!
+! --------------------------------------------------------------
+!
SUBROUTINE Finpx
-C
-C *** Purpose -- Read INPut file to get values of Kvendf, Kywywy,
-C *** Kwywyw, Krdspn, Kpntws, Ndfinp, Kompci, Nretro, Kedepu,
-C *** Mcy2
-C
+!
+! *** Purpose -- Read INPut file to get values of Kvendf, Kywywy,
+! *** Kwywyw, Krdspn, Kpntws, Ndfinp, Kompci, Nretro, Kedepu,
+! *** Mcy2
+!
use fixedi_m
use ifwrit_m
use samxxx_common_m
@@ -51,7 +53,7 @@ C
use ntyp_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
CHARACTER*5 Elemnt
-C
+!
Komment = 0
Kvendf = 1
Kwywyw = 0
@@ -69,18 +71,18 @@ C
Kompci = 0
Kedepu = 0
Ktzero = 0
-C
+!
CALL Filopn (11, Finput, 0)
READ (11,99999) (Alfnum(K),K=1,12)
99999 FORMAT (16A5)
READ (11,99998) Elemnt
99998 FORMAT (A5)
-C
+!
10 CONTINUE
READ (11,99997,END=50,ERR=50) Alfnum
CALL Convert_To_Caps (Alfnum, 20, Kpound)
IF (Kpound.EQ.1) GO TO 10
-C
+!
Nnnhuh = Nnnnnn
IF (Komment.EQ.0) THEN
IF (Alfnum(1).EQ.Z(1,340)) THEN
@@ -94,7 +96,7 @@ C
Number = Num
GO TO 40
30 CONTINUE
-C Here this command is unrecognizable; get another
+! Here this command is unrecognizable; get another
IF (Komment.EQ.0) THEN
WRITE (21,10300) (Alfnum(I),I=1,8)
WRITE (6,10300) (Alfnum(I),I=1,8)
@@ -108,112 +110,112 @@ C Here this command is unrecognizable; get another
Komment = 0
END IF
GO TO 10
-C
+!
40 CONTINUE
IF (Number.EQ.5) THEN
IF (Komment.EQ.0) THEN
-C *** This is the beginning of a comment block
+! *** This is the beginning of a comment block
Komment = 1
ELSE
-C *** This is the end of a comment block; but we won't get here
+! *** This is the end of a comment block; but we won't get here
Komment = 0
END IF
GO TO 10
END IF
-C
-C *** Here the command is recognized, so now take action
+!
+! *** Here the command is recognized, so now take action
IF (Komment.EQ.1) GO TO 10
IF (Number.EQ.1) GO TO 50
-C
+!
IF (Number.EQ. 19 .OR. Number.EQ. 20) THEN
-C *** data are ENDF file
+! *** data are ENDF file
Ndfdat = 1
-C
+!
ELSE IF (Number.EQ. 54 .OR. Number.EQ. 55) THEN
Krdspn = 2
ELSE IF (Number.EQ. 56) THEN
Krdspn = 3
-C
+!
ELSE IF (Number.EQ.61) THEN
-C *** input is ENDF file file 2
+! *** input is ENDF file file 2
Ndfinp = 1
-C
+!
ELSE IF (Number.EQ.71 .OR. Number.EQ.72) THEN
-C *** resonance parameter covariance matrix is retroactive
+! *** resonance parameter covariance matrix is retroactive
Nretro = 1
-C
+!
ELSE IF (Number.EQ.75) THEN
-C *** resonance parameter covariance matrix is retroactive
+! *** resonance parameter covariance matrix is retroactive
Nretro = 3
-C
+!
ELSE IF (Number.EQ.89 .OR. Number.EQ.90) THEN
-C *** prior resonance parameter covariance matrix is ENDF file 32
+! *** prior resonance parameter covariance matrix is ENDF file 32
Kompci = 1
-C
+!
ELSE IF (Number.EQ.141 .OR. Number.EQ.142) THEN
Kvendf = 1
-C *** use [current, 1999] endf values of constants (not older values)
-C
+! *** use [current, 1999] endf values of constants (not older values)
+!
ELSE IF (Number.EQ.143 .OR. Number.EQ.144) THEN
Kvendf = 0
-C *** use older values of constants (1995 endf values)
-C
+! *** use older values of constants (1995 endf values)
+!
ELSE IF (Number.EQ.145) THEN
Kvendf = 2
-C *** use much older values of constants (SAMMY-K1 "precise" values)
-C
+! *** use much older values of constants (SAMMY-K1 "precise" values)
+!
ELSE IF (Number.EQ.197) THEN
-C *** Read direct capture component of cross section
+! *** Read direct capture component of cross section
Kadddc = 1
-C
+!
ELSE IF (Number.EQ.294 .OR. Number.EQ.295) THEN
Kpntws = 1
-C *** generate point-wise cross sections
-C
+! *** generate point-wise cross sections
+!
ELSE IF (Number.EQ.299) THEN
-C *** Automatic ndf file creation
+! *** Automatic ndf file creation
Ndfndf = 1
-C
+!
ELSE IF (Number.EQ.301) THEN
-C *** Preserve Gamma_N not gGamma_N
+! *** Preserve Gamma_N not gGamma_N
Kprsrv = 1
-C
+!
ELSE IF (Number.EQ.247) THEN
-C *** Y2 values are tabulated
+! *** Y2 values are tabulated
Mcy2 = 1
-C
+!
ELSE IF (Number.EQ.6 .OR. Number.EQ.7) THEN
-C *** energy-dependent initial uncertainty multiplier
+! *** energy-dependent initial uncertainty multiplier
Kedepu = 1
ELSE IF (Number.EQ.8 .OR. Number.EQ.9) THEN
Kedepu = 1
-C
+!
ELSE IF (Number.EQ.336 .OR. Number.EQ.337) THEN
-C *** combining wwi & yyi to give www & yyy
+! *** combining wwi & yyi to give www & yyy
Kywywy = 1
-C
+!
ELSE IF (Number.EQ.338 .OR. Number.EQ.339) THEN
-C *** combining wwi & yyi to give www & yyy
+! *** combining wwi & yyi to give www & yyy
Kwywyw = 1
-C
+!
ELSE IF (Number.EQ.356 .OR. Number.EQ.357) THEN
Keveng = 1
-C *** Energies in plot files are in eV always
+! *** Energies in plot files are in eV always
ELSE IF (Number.EQ.358 .OR. Number.EQ.359) THEN
Keveng = 2
-C *** Energies in plot files are in keV
+! *** Energies in plot files are in keV
ELSE IF (Number.EQ.360 .OR. Number.EQ.361) THEN
Keveng = 3
-C *** Energies in plot files are in MeV
-C
+! *** Energies in plot files are in MeV
+!
ELSE
END IF
GO TO 10
-C
-C
+!
+!
50 CONTINUE
-C *** Now read through the rest of the file to see if TZERO miscellaneous
-C *** parameters are given here
+! *** Now read through the rest of the file to see if TZERO miscellaneous
+! *** parameters are given here
READ (11,99997,END=60,ERR=60) Alfnum
CALL Convert_To_Caps (Alfnum, 5, Kpound)
IF (Kpound.NE.1) THEN
@@ -226,26 +228,26 @@ C *** parameters are given here
60 CONTINUE
CLOSE (UNIT=11)
RETURN
-C
+!
99997 FORMAT (9A5, A3, 6A5)
- END
-C
-C
-C --------------------------------------------------------------
-C
+ END SUBROUTINE Finpx
+!
+!
+! --------------------------------------------------------------
+!
SUBROUTINE Fpar_If_Cov
-C
-C *** Purpose -- Read parameter file to see if there exists
-C *** a covariance file so that we can get its name
-C *** into the input stream.
-C
+!
+! *** Purpose -- Read parameter file to see if there exists
+! *** a covariance file so that we can get its name
+! *** into the input stream.
+!
use fixedi_m
use ifwrit_m
use Junk_common_m
use namfil_common_m
use mssccc_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
-C
+!
Icovar = 0
IF (Kompci.EQ.1) Icovar = 1
IF (Nretro.GT.0) Icovar = 1
@@ -253,12 +255,12 @@ C
10 CONTINUE
READ (12,99999,END=40,ERR=40) Aaapar
99999 FORMAT (10A1)
-C
-C *** Check whether tzero is to be varied...
+!
+! *** Check whether tzero is to be varied...
CALL Convert_To_Caps (Aaapar, 5, Kpound)
- IF (Aaapar(1).EQ.'T' .AND. Aaapar(2).EQ.'Z' .AND. Aaapar(3).EQ.'E'
- * .AND. Aaapar(4).EQ.'R' .AND. Aaapar(5).EQ.'O' ) Ktzero = 1
-C
+ IF (Aaapar(1).EQ.'T' .AND. Aaapar(2).EQ.'Z' .AND. Aaapar(3).EQ.'E' &
+ .AND. Aaapar(4).EQ.'R' .AND. Aaapar(5).EQ.'O' ) Ktzero = 1
+!
Mi = 1
DO I=1,10
IF (Aaapar(I).EQ.Acov(Mi)) THEN
@@ -267,21 +269,21 @@ C
END IF
END DO
GO TO 10
-C
+!
30 Icovar = 1
40 CONTINUE
CLOSE (UNIT=12)
RETURN
- END
-C
-C --------------------------------------------------------------
-C
-C
+ END SUBROUTINE Fpar_If_Cov
+!
+! --------------------------------------------------------------
+!
+!
SUBROUTINE Finp (Lrfx)
-C
-C *** Purpose -- Read INPut file, obtain information needed to create
-C *** other "INPut" files for each pass
-C
+!
+! *** Purpose -- Read INPut file, obtain information needed to create
+! *** other "INPut" files for each pass
+!
use fixedi_m
use ifwrit_m
use samxxx_common_m
@@ -293,8 +295,9 @@ C
use misccc_common_m
use ntyp_common_m
use dattyp_common_m
+ use mmas6_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
-C
+!
CHARACTER*5 Elemnt
CHARACTER*10 Alf1
CHARACTER*20 Alf(30), Alf2
@@ -303,24 +306,24 @@ C
CHARACTER*80 Alf8
CHARACTER*1 Kt, Kc, Ktotal, Ktran
DATA Kt /'T'/, Kc /'C'/
-C
+!
Ndfinp = 0
Nangle = 0
Kkkclq = 0
-C
+!
CALL Filopn (11, Finput, 0)
READ (11,99999) (Alfnum(K),K=1,12)
99999 FORMAT (16A5)
READ (11,99998) Elemnt, Aw, Emin, Emax, Nepnts, Itmax, Ixxchn
99998 FORMAT (A5, 5X, 3F10.1, 2I5, 20X, I10)
-C
+!
CALL Zeroxx (Ktotal, Ktran, K123xx)
Iiiiik = 0
-C
-C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!
+! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
10 CONTINUE
READ (11,99997,END=200,ERR=200) Alfnum
-C
+!
CALL Convert_To_Caps (Alfnum, 20, Kpound)
IF (Kpound.EQ.1) GO TO 10
Nnnhuh = Nnnnnn
@@ -332,7 +335,7 @@ C
GO TO 40
30 CONTINUE
GO TO 10
-C
+!
40 CONTINUE
IF (Number.EQ.1) THEN
IF (Krdspn.EQ.2 .OR. Krdspn.EQ.3) THEN
@@ -345,105 +348,105 @@ C
GO TO 50
END IF
END IF
-C
+!
IF (Number.EQ.5) THEN
-C *** This line says that the next several lines are to be ignored,
-C *** so read until find another line of dashes
+! *** This line says that the next several lines are to be ignored,
+! *** so read until find another line of dashes
71 CONTINUE
READ (11,99999) Alfnum
IF (Z(1,5).NE.Alfnum(1)) GO TO 71
ELSE
-C
+!
CALL Whatis (Number, K123xx)
IF (Kssmsc.Gt.0 .AND. K123xx.EQ.1) Kssmsc = 2
-C
+!
END IF
GO TO 10
-C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-C
-C
+! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!
+!
50 CONTINUE
-C
+!
IF (Kompci.EQ.1) Ignore = 0
-C
+!
IF (Ndfinp.EQ.1) CALL Endf1 (Ap, Matnum, Lrfx)
-C
+!
IF (Kaverg.GE.1) THEN
Kbayes = 1
Ksum = 0
END IF
-C
+!
IF (Ksum.EQ.1 .OR. Kendf.EQ.1) THEN
Kbayes = 1
Kaverg = 0
Kgen = 0
Ntggen = 0
END IF
-C
+!
IF (Kgenpd.EQ.1) THEN
Ignore = 1
Kbayes = 1
Ksum = 0
Kaverg = 0
END IF
-C
+!
IF (Krecon.EQ.1) THEN
Ksum = 0
Kgen = 0
END IF
-C
+!
IF (Kresol.EQ.1) THEN
-C *** CARD SET # 4.5
+! *** CARD SET # 4.5
READ (11,99997) Alfnum
IF (Ndfinp.EQ.1) WRITE (13,99997) Alfnum
END IF
-C
+!
IF (Kbrd.EQ.1) THEN
-C *** CARD SET #5
+! *** CARD SET #5
READ (11,10100) Alf4, Y, Alf2
10100 FORMAT (A40, F10.4, A20)
IF (Ndfinp.EQ.1) WRITE (13,10100) Alf4, Y, Alf2
-C
+!
IF (Y.LT.0) THEN
-C *** CARD SET #6, card #1
+! *** CARD SET #6, card #1
READ (11,10200) Alf1, N
10200 FORMAT (A10, I5)
IF (Ndfinp.EQ.1) WRITE (13,10200) Alf1, N
-C
-C *** CARD SET #6, CARD #2
+!
+! *** CARD SET #6, CARD #2
IF (N.GT.30) STOP '[STOP in Finp in mas/mmas1.f]'
READ (11,10300) (Alf(I),I=1,N)
10300 FORMAT (4A20)
IF (Ndfinp.EQ.1) WRITE (13,10300) (Alf(I),I=1,N)
END IF
END IF
-C
-C *** CARD SET #7
+!
+! *** CARD SET #7
READ (11,10400) X, Thick, Alf2, Yy, Alf1
10400 FORMAT (2F10.6, A20, F10.5, A10)
IF (Ndfinp.EQ.1) WRITE (13,10400) Ap, Thick, Alf2, Yy, Alf1
Vmin = Yy
-C
-C *** CARD SET #8 (data type)
+!
+! *** CARD SET #8 (data type)
60 CONTINUE
READ (11,99997,END=200,ERR=200) Alfnum
CALL Convert_To_Caps (Alfnum, 20, Kpound)
IF (Kpound.EQ.1) GO TO 60
-C
+!
IF (Alfnum(1).EQ.Comb) THEN
WRITE (6,10800)
10800 FORMAT ('COMBInation of data types is no longer available')
STOP '[STOP in Finp in mas/mmas1.f # 2]'
-C
+!
ELSE
-C *** ELSE IF (Alfnum(1).NE.Comb) THEN
-C
+! *** ELSE IF (Alfnum(1).NE.Comb) THEN
+!
IF (Ndfinp.EQ.1) WRITE (13,99997) Alfnum
CALL Convert_To_Caps (Alfnum, 80, Kpound)
IF (Alfnum(1).EQ.Apair .OR. Alfnum(1).EQ.Afinal) THEN
CALL Test_Angula (Angula, Alfnum(1))
END IF
-C
+!
IF (Ndfdat.EQ.1) THEN
IF (Alfnum(1).EQ.Total) THEN
Ndfdat = 1
@@ -458,18 +461,18 @@ C
END IF
Ksodf = - Ndfdat
END IF
-C
+!
IF (Alfnum(1).EQ.Total .OR. Alfnum(1).EQ.Trans) THEN
-C *** transmission and/or total cross sections
+! *** transmission and/or total cross sections
Ktotal = Kt
IF (Alfnum(1).EQ.Total .OR. Alfnum(6).EQ.Cross) Ktran = Kc
-C
+!
ELSE IF (Alfnum(1).EQ.Ntgrl) THEN
-C *** integral data
+! *** integral data
Ntgrlq = 1
-C
+!
ELSE IF (Alfnum(1).EQ.Diffe .OR. Alfnum(1).EQ.Angula) THEN
-C *** angular distributions
+! *** angular distributions
IF (Ksodf.NE.3) Ksodf = 2
READ (11,10500) Nangle, Alf7
10500 FORMAT (I5, 5X, A70)
@@ -486,62 +489,62 @@ C *** angular distributions
10600 FORMAT (A80)
END DO
END IF
-C
+!
ELSE
IF (Alfnum(1).EQ.Const) Kkkclq = 1
IF (Alfnum(1).EQ.Linea) Kkkclq = 2
IF (Alfnum(1).EQ.Quadr) Kkkclq = 3
IF (Alfnum(1).EQ.Dirac) Kkkclq = 4
IF (Alfnum(1).EQ.Oneov) Kkkclq = 5
-C *** Don't bother checking rest of file unless we need to...
+! *** Don't bother checking rest of file unless we need to...
END IF
-C
-C
-C *** If (not-real cross section) then (do not solve)
+!
+!
+! *** If (not-real cross section) then (do not solve)
IF (Kkkclq.GT.0) Kbayes = 1
-C
+!
Ntggen = 0
IF (Kgen.EQ.1 .OR. (Ntgrlq.EQ.1 .AND. Kbayes.EQ.0)) Ntggen = 1
IF (Kkclqx.NE.0) Ntggen = 0
-C
-C *** If reconstruct then do not solve
+!
+! *** If reconstruct then do not solve
IF (Krecon.EQ.1) Kbayes = 1
-C
+!
IF (Kgen.NE.0) THEN
-C *** generating plot file
+! *** generating plot file
CALL Newopn (18, Sam18x, 0)
Mmm = Mmdata
IF (Ksodf.LT.0) Mmm = Matdat
Ndummy = 1
- WRITE (18,10700) Ktotal, Ktran, Thick, Ndummy, Vmin, Ksodf,
- * Mmm, Nangle, Ixxchn, Ktzero, Iprcnt
+ WRITE (18,10700) Ktotal, Ktran, Thick, Ndummy, Vmin, Ksodf, &
+ Mmm, Nangle, Ixxchn, Ktzero, Iprcnt
10700 FORMAT (A1, A1, F15.5, I5, F15.5, 3I5, I10, 2i1)
END IF
-C
-C
+!
+!
END IF
-C
-C
+!
+!
IF (Ndfinp.NE.1) REWIND (11)
-C
+!
IF (Kgen.NE.0) Finput = Fff22x
IF (Ntggen.NE.0 .AND. Kbayes.NE.0) Finput = Fff22x
RETURN
-C
-C
+!
+!
200 CONTINUE
IF (Iftacs.EQ.1) RETURN
WRITE (6,10900)
-10900 FORMAT (//' *** CAUTION *** There is no blank card at end of',
- * /, ' alphanumeric input in INPut file')
+10900 FORMAT (//' *** CAUTION *** There is no blank card at end of', &
+ /, ' alphanumeric input in INPut file')
STOP '[STOP in Finp in mas/mmas1.f # 3]'
-C
+!
99997 FORMAT (9A5, A3, 6A5)
- END
-C
-C
-C --------------------------------------------------------------
-C
+ END SUBROUTINE Finp
+!
+!
+! --------------------------------------------------------------
+!
SUBROUTINE Zeroxx (Ktotal, Ktran, K123xx)
use ifwrit_m
use samxxx_common_m
@@ -556,7 +559,7 @@ C
IMPLICIT DOUBLE PRECISION (a-h,o-z)
CHARACTER*1 Kt, Kc, Ktotal, Ktran
DATA Kt /'T'/, Kc /'C'/
-C
+!
Ksodf = 0
Mmdata = 0
Iprcnt = 0
@@ -594,11 +597,11 @@ C
Kexptd = 0
Kredwa = 0
RETURN
- END
-C
-C
-C --------------------------------------------------------------
-C
+ END SUBROUTINE Zeroxx
+!
+!
+! --------------------------------------------------------------
+!
SUBROUTINE Whatis (Number, K123xx)
use fixedi_m
use ifwrit_m
@@ -613,375 +616,373 @@ C
use mdf5_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
-C
-C
-C ************************************************************
-C *** General
-C ************************************************************
-C
+!
+!
+! ************************************************************
+! *** General
+! ************************************************************
+!
IF (Number.EQ.2 .OR. Number.EQ.3 .OR. Number.EQ.4) THEN
Iftacs = 1
-C *** unresolved resonance region via Fritz Froehner's FITACS
-C
-C
-C ************************************************************
-C *** Input control for data
-C ************************************************************
-C
+! *** unresolved resonance region via Fritz Froehner's FITACS
+!
+!
+! ************************************************************
+! *** Input control for data
+! ************************************************************
+!
ELSE IF (Number.EQ.12 .OR. Number.EQ.13 .OR. Number.EQ.14) THEN
Mmdata = 1
-C *** Data are one-point-per-line with absolute uncertainties (csisrs)
-C
+! *** Data are one-point-per-line with absolute uncertainties (csisrs)
+!
ELSE IF (Number.EQ. 15 .OR. Number.EQ. 16) THEN
Mmdata = 2
-C *** Data are one-point-per-line with twenty significant digits
-C
+! *** Data are one-point-per-line with twenty significant digits
+!
ELSE IF (Number.EQ.17 .OR. Number.EQ.391) THEN
WRITE (21,99996) Alfnum
Ksodf = 1
-C *** DATA ARE IN STANDARD ODF FORMAT
-C
+! *** DATA ARE IN STANDARD ODF FORMAT
+!
ELSE IF (Number.EQ.18 .OR. Number.EQ.400) THEN
WRITE (21,99996) Alfnum
Kdodf = 1
-C *** DATA ARE IN ODF FILE
-C
+! *** DATA ARE IN ODF FILE
+!
ELSE IF (Number.EQ.19 .OR. Number.EQ.20) THEN
CALL Convert_To_Caps (Alfnum, 30, Kpound)
Ndfdat = 1
-C *** Data are ENDF/B file
+! *** Data are ENDF/B file
CALL Jsq_Find_Equal (Alfn80, Jstart, Jquit)
- IF (Jstart.GT.0) CALL Get_Intg (Alfn80, Jstart, Jquit, Matdat,
- * Intgx, Kintgx)
-C *** Matdat is ENDF Material Number
-C
+ IF (Jstart.GT.0) CALL Get_Intg (Alfn80, Jstart, Jquit, Matdat, Intgx, Kintgx)
+! *** Matdat is ENDF Material Number
+!
ELSE IF (Number.EQ.22 .OR. Number.EQ.399) THEN
WRITE (21,99996) Alfnum
Ksodf = 3
-C *** DIFFERENTIAL DATA ARE IN ASCII FORMAT
-C
+! *** DIFFERENTIAL DATA ARE IN ASCII FORMAT
+!
ELSE IF (Number.EQ.24) THEN
WRITE (21,99996) Alfnum
Kdiv = 1
-C *** DIVIDE DATA INTO REGIONS WITH A FIXED Number OF POINTS
-C
-C
-C ************************************************************
-C *** Data Covariance Matrix
-C ************************************************************
-C
+! *** DIVIDE DATA INTO REGIONS WITH A FIXED Number OF POINTS
+!
+!
+! ************************************************************
+! *** Data Covariance Matrix
+! ************************************************************
+!
ELSE IF (Number.EQ.31 .OR. Number.EQ.32) THEN
Kidcxx = 1
-C *** use implicit data covariance
-C
+! *** use implicit data covariance
+!
ELSE IF (Number.EQ.33 .OR. Number.EQ.34) THEN
Kidcxx = 2
-C
+!
ELSE IF (Number.EQ.35) THEN
Kpupcv = 1
-C *** PUP covariance file exists
-C
+! *** PUP covariance file exists
+!
ELSE IF (Number.EQ.43 .OR. Number.EQ.44) THEN
Iprcnt = 1
-C *** use ten percent data uncertainty
-C
-C
-C ************************************************************
-C *** Input control for parameters
-C ************************************************************
-C
+! *** use ten percent data uncertainty
+!
+!
+! ************************************************************
+! *** Input control for parameters
+! ************************************************************
+!
ELSE IF (Number.EQ.61) THEN
CALL Convert_To_Caps (Alfnum, 30, Kpound)
Ndfinp = 1
-C *** input is ENDF/B file 2
+! *** input is ENDF/B file 2
CALL Jsq_Find_Equal (Alfn80, Jstart, Jquit)
- IF (Jstart.GT.0) CALL Get_Intg (Alfn80, Jstart, Jquit, Matnum,
- * Intgx, Kintgx)
-C *** Matnum is ENDF Material Number
-C
+ IF (Jstart.GT.0) CALL Get_Intg (Alfn80, Jstart, Jquit, Matnum, Intgx, Kintgx)
+! *** Matnum is ENDF Material Number
+!
ELSE IF (Number.EQ.71 .OR. Number.EQ.72) THEN
-C *** resonance parameter covariance matrix is retroactive
+! *** resonance parameter covariance matrix is retroactive
Nretro = 1
-C
+!
ELSE IF (Number.EQ.75) THEN
-C *** resonance parameter covariance matrix is retroactive
+! *** resonance parameter covariance matrix is retroactive
Nretro = 3
-C
+!
ELSE IF (Number.EQ.89 .OR. Number.EQ.90) THEN
Kompci = 1
-C *** input par cov mtrx is ENDF/B file 32
-C
+! *** input par cov mtrx is ENDF/B file 32
+!
ELSE IF (Number.EQ.62) THEN
WRITE (21,99996) Alfnum
Kerang = 1
-C *** use energy range from ENDF file
-C
+! *** use energy range from ENDF file
+!
ELSE IF (Number.EQ.65 .OR. Number.EQ.66) THEN
Ignore = 1
-C *** Ignore INPUT BINARY FILE
-C
-C
-C ************************************************************
-C *** Output control for parameters
-C ************************************************************
-C
-C
-C ************************************************************
-C *** Line-printer output options
-C ************************************************************
-C
-C
-C ************************************************************
-C *** Constants
-C ************************************************************
-C
+! *** Ignore INPUT BINARY FILE
+!
+!
+! ************************************************************
+! *** Output control for parameters
+! ************************************************************
+!
+!
+! ************************************************************
+! *** Line-printer output options
+! ************************************************************
+!
+!
+! ************************************************************
+! *** Constants
+! ************************************************************
+!
ELSE IF (Number.EQ.141 .OR. Number.EQ.142) THEN
Kvendf = 1
-C *** use [current 2001] endf values of constants (not older values)
-C
+! *** use [current 2001] endf values of constants (not older values)
+!
ELSE IF (Number.EQ.143 .OR. Number.EQ.144) THEN
Kvendf = 0
-C *** use older values of constants (1995 endf values)
-C
+! *** use older values of constants (1995 endf values)
+!
ELSE IF (Number.EQ.145) THEN
Kvendf = 2
-C *** use SAMMY-K1 "precise" values of constants
-C
-C
-C ************************************************************
-C *** Bayes' solution
-C ************************************************************
-C
+! *** use SAMMY-K1 "precise" values of constants
+!
+!
+! ************************************************************
+! *** Bayes' solution
+! ************************************************************
+!
ELSE IF (Number.EQ.152) THEN
Kbayes = 1
-C *** DO NOT SOLVE BAYES EQUATIONS
-C
-C
-C ************************************************************
-C *** Cross section generation
-C ************************************************************
+! *** DO NOT SOLVE BAYES EQUATIONS
+!
+!
+! ************************************************************
+! *** Cross section generation
+! ************************************************************
ELSE IF (Number.EQ.184) THEN
Kredwa = 1
-C *** Input resonance parameters are reduced width amplitudes
-C
-C
-C ************************************************************
-C *** Cross section details
-C ************************************************************
-C
-C
-C ************************************************************
-C *** Broadening options
-C ************************************************************
-C
+! *** Input resonance parameters are reduced width amplitudes
+!
+!
+! ************************************************************
+! *** Cross section details
+! ************************************************************
+!
+!
+! ************************************************************
+! *** Broadening options
+! ************************************************************
+!
ELSE IF (Number.EQ.202) THEN
WRITE (21,99996) Alfnum
Kbrd = 0
-C *** BROADENING IS NOT WANTED
-C
-C
-C ************************************************************
-C *** Doppler broadening options
-C ************************************************************
-C
+! *** BROADENING IS NOT WANTED
+!
+!
+! ************************************************************
+! *** Doppler broadening options
+! ************************************************************
+!
ELSE IF (Number.EQ.219 .OR. Number.EQ.220) THEN
Kkkdop = 3
-C *** Use CLM for Doppler broadening
-C
-C
-C ************************************************************
-C *** Resolution broadening options
-C ************************************************************
-C
+! *** Use CLM for Doppler broadening
+!
+!
+! ************************************************************
+! *** Resolution broadening options
+! ************************************************************
+!
ELSE IF (Number.EQ.236) THEN
Kresol = 1
-C *** want to make plot file for resolution function
-C
-C
-C ************************************************************
-C *** Multiple-scattering corrections
-C ************************************************************
-C
- ELSE IF (Number.EQ.256 .OR. Number.EQ.257 .OR. Number.EQ.258
- * .OR. Number.EQ.259 .OR. Number.EQ.260 .OR. Number.EQ.261) THEN
+! *** want to make plot file for resolution function
+!
+!
+! ************************************************************
+! *** Multiple-scattering corrections
+! ************************************************************
+!
+ ELSE IF (Number.EQ.256 .OR. Number.EQ.257 .OR. Number.EQ.258 &
+ .OR. Number.EQ.259 .OR. Number.EQ.260 .OR. Number.EQ.261) THEN
Kssmsc = 1
-C *** self-shielding and multiple-scattering corrections are wanted
-C
+! *** self-shielding and multiple-scattering corrections are wanted
+!
ELSE IF (Number.EQ.262 .OR. Number.EQ.263) THEN
K123xx = 1
-C *** infinite slab
-C
+! *** infinite slab
+!
ELSE IF (Number.EQ.264 .OR. Number.EQ.265) THEN
K123xx = 0
-C *** finite slab
-C
+! *** finite slab
+!
ELSE IF (Number.EQ.266) THEN
Kssedg = 2
-C *** make new file with edge effects
-C
+! *** make new file with edge effects
+!
ELSE IF (Number.EQ.267) THEN
Kssedg = 1
-C *** file with edge effects already exists
-C
-C
-C ************************************************************
-C *** Angular distribution data
-C ************************************************************
-C
-C
-C ************************************************************
-C *** ENDF output
-C ************************************************************
-C
+! *** file with edge effects already exists
+!
+!
+! ************************************************************
+! *** Angular distribution data
+! ************************************************************
+!
+!
+! ************************************************************
+! *** ENDF output
+! ************************************************************
+!
ELSE IF (Number.EQ.291 .OR. Number.EQ.292) THEN
Kendf = 1
-C *** want to create ENDF/B-VI file 2
-C
-C *** This one to be eliminated eventually
+! *** want to create ENDF/B-VI file 2
+!
+! *** This one to be eliminated eventually
ELSE IF (Number.EQ.394) THEN
CALL Convert_To_Caps (Alfnum, 30, Kpound)
IF (Alfn80_21.EQ.'NG AND MUL') Kssmsc = 1
-C *** self-shielding and multiple-scattering corrections are wanted
-C
-C
-C ************************************************************
-C *** ENDF as input
-C ************************************************************
-C
-C
-C ************************************************************
-C *** No pre-defined energy grid
-C ************************************************************
-C
+! *** self-shielding and multiple-scattering corrections are wanted
+!
+!
+! ************************************************************
+! *** ENDF as input
+! ************************************************************
+!
+!
+! ************************************************************
+! *** No pre-defined energy grid
+! ************************************************************
+!
ELSE IF (Number.EQ.306) THEN
Krecon = 1
-C *** reconstruct point-wise cross sections from resonance parameters
-C
+! *** reconstruct point-wise cross sections from resonance parameters
+!
ELSE IF (Number.EQ.307) THEN
WRITE (21,99996) Alfnum
Kartgd = 1
-C *** artificial energy grid is needed
-C
-C
-C ************************************************************
-C *** Averages etc.
-C ************************************************************
-C
+! *** artificial energy grid is needed
+!
+!
+! ************************************************************
+! *** Averages etc.
+! ************************************************************
+!
ELSE IF (Number.EQ.311 .OR. Number.EQ.312) THEN
WRITE (21,99996) Alfnum
Kaverg = 1
-C *** average over energy ranges
-C
+! *** average over energy ranges
+!
ELSE IF (Number.EQ.313 .OR. Number.EQ.314 .OR. Number.EQ.315) THEN
WRITE (21,99996) Alfnum
Kaverg = 2
-C *** group average, Bondarenko
-C
+! *** group average, Bondarenko
+!
ELSE IF (Number.EQ.325 .OR. Number.EQ.326) THEN
WRITE (21,99996) Alfnum
Kaverg = 3
-C *** energy average using constant flux
-C
+! *** energy average using constant flux
+!
ELSE IF (Number.EQ.316 .OR. Number.EQ.317 .OR. Number.EQ.318) THEN
Maxwel = 1
-C *** we want the Maxwellian-averaged capture cross sections
-C
+! *** we want the Maxwellian-averaged capture cross sections
+!
ELSE IF (Number.EQ.319) THEN
WRITE (21,99996) Alfnum
Mxwrec = 1
Maxwel = 1
-C *** calculate Maxwellian averages after reconstructing cross sections
-C
+! *** calculate Maxwellian averages after reconstructing cross sections
+!
ELSE IF (Number.EQ.320) THEN
WRITE (21,99996) Alfnum
kaddcr = 1
-C *** add cross sections from ENDF/B file 3
-C
-C
-C ************************************************************
-C *** Special options
-C ************************************************************
-C
+! *** add cross sections from ENDF/B file 3
+!
+!
+! ************************************************************
+! *** Special options
+! ************************************************************
+!
ELSE IF (Number.EQ.331) THEN
WRITE (21,99996) Alfnum
Ksum = 1
Kbayes = 1
-C *** PERFORM SUMMARY ANALYSIS
-C
+! *** PERFORM SUMMARY ANALYSIS
+!
ELSE IF (Number.EQ.332) THEN
Kgenpd = 1
-C *** want to generate only the partial derivatives
-C
+! *** want to generate only the partial derivatives
+!
ELSE IF (Number.EQ.342) THEN
Kkclqx = 1
-C *** uniform-in-energy grid
-C
+! *** uniform-in-energy grid
+!
ELSE IF (Number.EQ.343) THEN
Kkclqx = 2
-C *** uniform-in-velocity grid
-C
+! *** uniform-in-velocity grid
+!
ELSE IF (Number.EQ.344) THEN
Kkclqx = 3
-C *** uniform-in-time grid
-C
-C
-C ************************************************************
-C *** Plot file control
-C ************************************************************
-C
+! *** uniform-in-time grid
+!
+!
+! ************************************************************
+! *** Plot file control
+! ************************************************************
+!
ELSE IF (Kwywyw.NE.1 .AND. (Number.EQ.351.OR.Number.EQ.352)) THEN
WRITE (21,99996) Alfnum
Kgen = 1
-C *** GENERATE PLOT FILE AUTOMATICALLY
-C
-C
-C ************************************************************
-C *** URR controls
-C ************************************************************
-C
+! *** GENERATE PLOT FILE AUTOMATICALLY
+!
+!
+! ************************************************************
+! *** URR controls
+! ************************************************************
+!
ELSE IF (Number.EQ.371) THEN
Kexptd = 1
-C *** experimental data are in separate files (unresolved region)
-C
-C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C *** THE FOLLOW OPTIONS ARE NOT DISCUSSED IN THE MANUAL BUT
-C WILL NEVERTHELESS BE RETAINED FOR A WHILE ANYWAY
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C
-cx ELSE IF (Number.EQ.386) THEN
-cx Kreads = 1
-cxC *** read cross sections rather than calculating them
-C
+! *** experimental data are in separate files (unresolved region)
+!
+!
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+! *** THE FOLLOW OPTIONS ARE NOT DISCUSSED IN THE MANUAL BUT
+! WILL NEVERTHELESS BE RETAINED FOR A WHILE ANYWAY
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+!
+!x ELSE IF (Number.EQ.386) THEN
+!x Kreads = 1
+!xC *** read cross sections rather than calculating them
+!
END IF
RETURN
-C
+!
99996 FORMAT (1X, 9A5, A3, 6A5)
- END
-C
-C
-C --------------------------------------------------------------
-C
+ END SUBROUTINE Whatis
+!
+!
+! --------------------------------------------------------------
+!
SUBROUTINE Sumstr
-C
-C *** Purpose -- Prepare to evaluate summed strengths
-C
+!
+! *** Purpose -- Prepare to evaluate summed strengths
+!
use samxxx_common_m
use Junk_common_m
use namfil_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
-C
+!
CALL Newopn (16, Sam16x, 0)
WRITE (16,99999) Finput
WRITE (16,99999) Fparam
WRITE (16,99999) Summry
WRITE (16,99999) Fprcov
99999 FORMAT (A70)
-C
+!
WRITE (6,99985)
-99985 FORMAT (' INPUT INFORMATION FOR SUMMARY ANALYSIS ...',
- * ' GROUP NO.? Emin? Emax? ')
-C
+99985 FORMAT (' INPUT INFORMATION FOR SUMMARY ANALYSIS ...', &
+ ' GROUP NO.? Emin? Emax? ')
+!
10 CONTINUE
READ (5,*,END=20,ERR=20) Ngrp, Ngrp2, Emina, Emaxa
IF (Ngrp.EQ.0) GO TO 20
@@ -990,27 +991,27 @@ C
WRITE (16,99983) Ngrp, Ngrp2, Emina, Emaxa
99983 FORMAT (2I5, 1P2G20.10)
GO TO 10
-C
+!
20 CONTINUE
CLOSE (UNIT=16)
RETURN
-C
- END
-C
-C
-C --------------------------------------------------------------
-C
+!
+ END SUBROUTINE Sumstr
+!
+!
+! --------------------------------------------------------------
+!
SUBROUTINE Get_Stop_Segment (Alfnum)
-C
-C *** Purpose -- determine the segment before which the code should write
-C *** files and stop (for debugging)
-C
+!
+! *** Purpose -- determine the segment before which the code should write
+! *** files and stop (for debugging)
+!
use Sammy1_common_m
CHARACTER*5 Alfnum(12), Count(15)
- DATA Count /'1 ', '2 ', '3 ', '4 ', '5 ',
- * '6 ', '7 ', '8 ', '9 ', '10 ',
- * '11 ', '12 ', '13 ', '14 ', '15 '/
-C
+ DATA Count /'1 ', '2 ', '3 ', '4 ', '5 ', &
+ '6 ', '7 ', '8 ', '9 ', '10 ', &
+ '11 ', '12 ', '13 ', '14 ', '15 '/
+!
If (Alfnum(2).EQ.'ACS ') Stop_Segment = 'samacs'
If (Alfnum(2).EQ.'ANG ') Stop_Segment = 'samang'
If (Alfnum(2).EQ.'AVG ') Stop_Segment = 'samavg'
@@ -1059,11 +1060,13 @@ C
If (Alfnum(2).EQ.'XCT ') Stop_Segment = 'samxct'
If (Alfnum(2).EQ.'XXX ') Stop_Segment = 'samxxx'
If (Alfnum(2).EQ.'YWY ') Stop_Segment = 'samywy'
-C
+!
DO I=1,15
If (Alfnum(3).EQ.Count(I)) K_Stop_Segment = I
END DO
IF (K_Stop_Segment.EQ.0) K_Stop_Segment = 1
-C
+!
RETURN
- END
+ END SUBROUTINE Get_Stop_Segment
+end module mmas1_m
+
diff --git a/sammy/src/mas/mmas3.f b/sammy/src/mas/mmas3.f90
similarity index 64%
rename from sammy/src/mas/mmas3.f
rename to sammy/src/mas/mmas3.f90
index 255148a19568b24a72014225b0a502909c49e23e..110efbedfcf55f85e950b53c0b85df7fae621f98 100644
--- a/sammy/src/mas/mmas3.f
+++ b/sammy/src/mas/mmas3.f90
@@ -1,12 +1,15 @@
-C
-C
-C
-C ----------------------------------------------------------------------
-C
+module mmas3_m
+
+contains
+!
+!
+!
+! ----------------------------------------------------------------------
+!
SUBROUTINE Datcov
-C
-C *** Purpose -- learn DATa file names and energy ranges
-C
+!
+! *** Purpose -- learn DATa file names and energy ranges
+!
use fixedi_m
use ifwrit_m
use samxxx_common_m
@@ -17,33 +20,32 @@ C
IMPLICIT DOUBLE PRECISION (a-h,o-z)
CHARACTER*70 Wwwyyy
DATA Zero /0.0d0/
-C
-C ------------------------------------------------------------------
-C Several lines of input
-C ------------------------------------------------------------------
-C
+!
+! ------------------------------------------------------------------
+! Several lines of input
+! ------------------------------------------------------------------
+!
IF (Kendf.EQ.1) THEN
-C *** This run will create ENDF File 2
-C ************************************************************** File 4
+! *** This run will create ENDF File 2
+! ************************************************************** File 4
WRITE (6,10100)
10100 FORMAT (' What is name of input file for ENDF output? ')
CALL Fixnam (Fdata, Eemin, Eemax, Eeeeee)
WRITE (6,10400) Fdata
10400 FORMAT (' >>> ', A70, ' <<<')
WRITE (21,10500) Fdata
-10500 FORMAT (' Input file for ENDF output is ', /, ' >>> ', A70,
- * ' <<<')
-C
+10500 FORMAT (' Input file for ENDF output is ', /, ' >>> ', A70, ' <<<')
+!
ELSE
-C
-C *************************************************************** File 3
+!
+! *************************************************************** File 3
WRITE (6,10200)
10200 FORMAT (' What is the DATa file name? EMIN? EMAX? ')
CALL Fixnam (Fdata, Eemin, Eemax, Eeeeee)
-C
+!
IF (Kwywyw.EQ.1) THEN
-C *************************************************************** File 5
-C *** Read and Write Names of files for KWYWYW
+! *************************************************************** File 5
+! *** Read and Write Names of files for KWYWYW
WRITE (6,10205)
10205 FORMAT (' What are names of WY files?')
WRITE (21,10210)
@@ -63,22 +65,21 @@ C *** Read and Write Names of files for KWYWYW
20 CONTINUE
CLOSE (UNIT=32)
RETURN
-C
+!
ELSE
-C
-C *** Usual case here, Kwywyw = 0
+!
+! *** Usual case here, Kwywyw = 0
WRITE (6,10400) Fdata
WRITE (21,10600) Fdata
-10600 FORMAT (' Name of experimental data file is: ', /,
- * ' >>> ', A70, ' <<<')
-C
+10600 FORMAT (' Name of experimental data file is: ', /,' >>> ', A70, ' <<<')
+!
END IF
25 CONTINUE
-C
+!
END IF
-C ------------------------------------------------------------------
-C
-C
+! ------------------------------------------------------------------
+!
+!
IF (Eeeeee.NE.Zero) THEN
Eemin = Eemax
Eemax = Eeeeee
@@ -88,33 +89,32 @@ C
WRITE (6,10650) Emin, Emax
WRITE (21,10650) Emin, Emax
10650 FORMAT (' Emin and Emax = ',1p5g14.6)
-C
+!
IF (Kadddc.EQ.1) THEN
-C *************************************************************** File 6
-C *** Read name of direct-capture DRC file
+! *************************************************************** File 6
+! *** Read name of direct-capture DRC file
WRITE (6,10249)
10249 FORMAT (' What is name of file with values of direct capture?')
READ (5,10300,END=30,ERR=30) Fdrcap
WRITE (6,10400) Fdrcap
WRITE (21,10250) Fdrcap
-10250 FORMAT (' File for direct capture values is named', /,
- * ' >>> ', A70, ' <<<')
+10250 FORMAT (' File for direct capture values is named', /, ' >>> ', A70, ' <<<')
GO TO 40
30 CONTINUE
STOP '[STOP no name for direct capture file]'
40 CONTINUE
END IF
-C
-C
+!
+!
IF (Ndfinp.EQ.1) THEN
-C *** Options when using endf/b file as input
-C
-C *** Set Emin and Emax to values given in endf/b file
+! *** Options when using endf/b file as input
+!
+! *** Set Emin and Emax to values given in endf/b file
IF (Kerang.EQ.1) THEN
Emin = Endfmn
Emax = Endfmx
END IF
-C
+!
Ifgo = 1
IF (Emin.LT.Endfmn) THEN
IF ( (Endfmn-Emin)/Endfmn.GT.0.01D0 ) THEN
@@ -129,167 +129,166 @@ C
IF (Ifgo.EQ.0) THEN
WRITE (21,10700) Emin, Emax, Endfmn, Endfmx
WRITE (6,10700) Emin, Emax, Endfmn, Endfmx
-10700 FORMAT (' WARNING: Emin, Emax =', 1p2g15.8, ' for this run',
- * /, ' Emin, Emax =', 1p2g15.8, ' for ENDF file',
- * /, ' But cannot use energy range outside ENDF limits.')
+10700 FORMAT (' WARNING: Emin, Emax =', 1p2g15.8, ' for this run', &
+ /, ' Emin, Emax =', 1p2g15.8, ' for ENDF file', &
+ /, ' But cannot use energy range outside ENDF limits.')
STOP '[STOP in Datcov in mas/mmas3.f]'
END IF
-C
+!
END IF
IF (Emin.EQ.Zero) Emin = 0.00000000001
IF (Kdodf.NE.0) THEN
Odfmin = Emin
Odfmax = Emax
END IF
-C
-C *** Specify Fdatay, the name of ASCII data file
+!
+! *** Specify Fdatay, the name of ASCII data file
IF (Kdodf.NE.0) THEN
-C *** Here for (non-standard) ODF file
+! *** Here for (non-standard) ODF file
Fdatay = Samexp
ELSE
-C *** Here for ASCII file or standard ODF file
+! *** Here for ASCII file or standard ODF file
Fdatay = Fdata
END IF
-C
-C
+!
+!
RETURN
- END
-C
-C
-C _____________________________________________________________________
-C
+ END SUBROUTINE Datcov
+!
+!
+! _____________________________________________________________________
+!
SUBROUTINE Fdat (E, D, Meeeee)
-C
-C *** Purpose -- Check whether data in the specified range are in the
-C DATa file
-C
+!
+! *** Purpose -- Check whether data in the specified range are in the
+! DATa file
+!
use fixedi_m
use ifwrit_m
use Junk_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
COMMON /E1E2/ E1, E2
DIMENSION E(*), D(*)
-C
-C *** For data on (non-standard) ODF file, need to keep track of
-C *** energy ranges so that can make ASCII file eventually
+!
+! *** For data on (non-standard) ODF file, need to keep track of
+! *** energy ranges so that can make ASCII file eventually
IF (Kdiv.EQ.0 .AND. Kdodf.EQ.1) THEN
E1 = Emin
E2 = Emax
-C
-C *** Go through standard ODF file to check if data are there
- ELSE IF (.NOT.(Kdiv.EQ.0 .AND. Kdodf.EQ.1) .AND.
- * (Ksodf.EQ.1 .OR. Ksodf.EQ.2)) THEN
+!
+! *** Go through standard ODF file to check if data are there
+ ELSE IF (.NOT.(Kdiv.EQ.0 .AND. Kdodf.EQ.1) .AND. &
+ (Ksodf.EQ.1 .OR. Ksodf.EQ.2)) THEN
CALL Stdodf (E, D, Meeeee, Ndat)
-C
-C *** Read ENDF file and extract File 3 data
+!
+! *** Read ENDF file and extract File 3 data
ELSE IF (Ndfdat.NE.0) THEN
CALL F3dat (E, D, Meeeee)
-C
-C *** Go through ASCII data file to check if data are there
+!
+! *** Go through ASCII data file to check if data are there
ELSE IF (.NOT.(Kdiv.EQ.0 .AND. Kdodf.EQ.1) .AND. Ksodf.EQ.0) THEN
CALL Ascidt (E, Meeeee)
-C
-C *** Go through ASCII data file to check if data are there (for angle-
-C *** differential data)
+!
+! *** Go through ASCII data file to check if data are there (for angle-
+! *** differential data)
ELSE IF (.NOT.(Kdiv.EQ.0 .AND. Kdodf.EQ.1) .AND. Ksodf.EQ.3) THEN
CALL Ascxdt (E, Meeeee, Ndat)
-C
+!
ELSE
STOP '[STOP in Fdat in mas/mmas3.f]'
END IF
-C
-C *** Divide data into regions if needed
+!
+! *** Divide data into regions if needed
IF (Kdiv.EQ.1) CALL Fdat1 (E, Ndat)
- END
-C
-C
-C --------------------------------------------------------------
-C
+ END SUBROUTINE Fdat
+!
+!
+! --------------------------------------------------------------
+!
SUBROUTINE F3dat (E, D, Meeeee)
-C
-C *** Purpose -- Read ENDF data file to be sure there are data within
-C *** limits given
-C
+!
+! *** Purpose -- Read ENDF data file to be sure there are data within
+! *** limits given
+!
use fixedi_m
use ifwrit_m
use Junk_common_m
use namfil_common_m
+ use mmas6_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
DIMENSION E(*), D(*)
DIMENSION Lxx(20), Lyy(20)
-C
+!
CALL Filopn (13, Fdata, 0)
-C
-C *** Read from the ENDF file until find the right Material Number,
-C *** then read through first line in File 3
- CALL Find_Matnum_In_ENDF_File (Matdat, 3, Ndfdat, Za, Awr, Nisotp,
- * 13)
-C
- CALL Rtab1 (A, B, La, Lb, Lc, Ld, Lxx, Lyy, E, D, Mat, Mf, Mt, Ns,
- * 13)
+!
+! *** Read from the ENDF file until find the right Material Number,
+! *** then read through first line in File 3
+ CALL Find_Matnum_In_ENDF_File (Matdat, 3, Ndfdat, Za, Awr, Nisotp, 13)
+!
+ CALL Rtab1 (A, B, La, Lb, Lc, Ld, Lxx, Lyy, E, D, Mat, Mf, Mt, Ns, 13)
CLOSE (Unit=13)
-C
+!
IF (Ld.GT.Meeeee) THEN
WRITE (6,10100) Meeeee
-10100 FORMAT (' Maximum number of data points is greater than', I7,
- * '.', /,
- * ' Increase dimension of E and corresponding value of Meeeee.')
+10100 FORMAT (' Maximum number of data points is greater than', I7, &
+ '.', /, &
+ ' Increase dimension of E and corresponding value of Meeeee.')
STOP '[STOP in F3dat in mas/mmas3.f # 1]'
END IF
-C
+!
DO I=1,Ld
IF (E(I).GT.Emin .AND. E(I).LE.Emax) RETURN
END DO
-C
+!
WRITE (6,10200) Emin, Emax, Matdat, Ndfdat
-10200 FORMAT (' ENDF File3 does not contain any data in the energy',
- * 1X, 'range from', /, 1PE14.6, ' to', 1PE14.6,
- * ' for Material Number', I5, ' and MT number', I4)
+10200 FORMAT (' ENDF File3 does not contain any data in the energy', &
+ 1X, 'range from', /, 1PE14.6, ' to', 1PE14.6, &
+ ' for Material Number', I5, ' and MT number', I4)
STOP '[STOP in F3dat in mas/mmas3.f # 2]'
- END
-C
-C
-C --------------------------------------------------------------
-C
+ END SUBROUTINE F3dat
+!
+!
+! --------------------------------------------------------------
+!
SUBROUTINE Ascidt (E, Meeeee)
-C
-C *** Purpose -- Read ASCII data file to be sure there are data within
-C *** limits given
-C
+!
+! *** Purpose -- Read ASCII data file to be sure there are data within
+! *** limits given
+!
use ifwrit_m
use Junk_common_m
use namfil_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
DIMENSION E(*)
DATA Zero /0.0d0/
-C
+!
DIMENSION Aaadat(3)
-C
+!
Numlin = 3
IF (Mmdata.NE.0) Numlin = 1
-C
-C *** The following initialization needed to prevent problems with some
-C *** compilers (noteably, HP)
+!
+! *** The following initialization needed to prevent problems with some
+! *** compilers (noteably, HP)
CALL Zero_Array (Aaadat, 3)
-C
-C *** Open data file
+!
+! *** Open data file
CALL Filopn (13, Fdata, 0)
-C
+!
10 CONTINUE
Aold = Aaadat(1)
IF (Mmdata.EQ.0) THEN
-C *** original format, 3-data-points per line
-cx READ (13,10100,END=60,ERR=90) Aaadat
+! *** original format, 3-data-points per line
+!x READ (13,10100,END=60,ERR=90) Aaadat
READ (13,10100,END=60,ERR=60) Aaadat
10100 FORMAT (E15.8, 22X, E15.8, 22X, E15.8)
ELSE IF (Mmdata.EQ.1) THEN
-C *** CSISRS format, 1-data-point per line
-cx READ (13,10200,END=60,ERR=90) Aaadat
+! *** CSISRS format, 1-data-point per line
+!x READ (13,10200,END=60,ERR=90) Aaadat
READ (13,10200,END=60,ERR=60) Aaadat
10200 FORMAT ((3E11.4))
ELSE IF (Mmdata.EQ.2) THEN
-C *** TWENTY format, 1-data-point per line
-cx READ (13,10300,END=60,ERR=90) Aaadat
+! *** TWENTY format, 1-data-point per line
+!x READ (13,10300,END=60,ERR=90) Aaadat
READ (13,10300,END=60,ERR=60) Aaadat
10300 FORMAT ((3E20.1))
ELSE
@@ -298,22 +297,21 @@ cx READ (13,10300,END=60,ERR=90) Aaadat
STOP '[in Ascidt in mas/mmas3.f # 2]'
END IF
IF (Aaadat(Numlin).EQ.Zero) GO TO 10
- IF (Aaadat(Numlin).GT.Emax .OR. Aaadat(Numlin).LT.Emin)
- * GO TO 10
-C
-C *** Here Aaadat(Numlin).LE.Emax and .GE. Emin; so this is start of data
+ IF (Aaadat(Numlin).GT.Emax .OR. Aaadat(Numlin).LT.Emin) GO TO 10
+!
+! *** Here Aaadat(Numlin).LE.Emax and .GE. Emin; so this is start of data
K = 0
DO 20 I=1,Numlin
IF (Aold.GT.Emax .AND. Aaadat(I).GT.Emax) GO TO 20
IF (Aold.GT.Emax .AND. Aaadat(I).LT.Emin) GO TO 70
- IF (Aold.GT.Zero .AND. Aold.LT.Emin .AND.
- * Aaadat(I).GT.Emax) GO TO 70
- IF (Aold.GT.Zero .AND. Aold.LT.Emin .AND.
- * Aaadat(I).LT.Emin) GO TO 20
+ IF (Aold.GT.Zero .AND. Aold.LT.Emin .AND. &
+ Aaadat(I).GT.Emax) GO TO 70
+ IF (Aold.GT.Zero .AND. Aold.LT.Emin .AND. &
+ Aaadat(I).LT.Emin) GO TO 20
K = K + 1
E(K) = Aaadat(I)
20 CONTINUE
-C
+!
30 CONTINUE
IF (Mmdata.EQ.0) READ (13,10100,END=50,ERR=50) Aaadat
IF (Mmdata.EQ.1) READ (13,10200,END=50,ERR=50) Aaadat
@@ -325,68 +323,68 @@ C
E(K) = Aaadat(I)
END DO
GO TO 30
-C
+!
50 Ndat = K
-C
+!
CLOSE (UNIT=13)
RETURN
-C
+!
60 CONTINUE
WRITE (6,10500)
10500 FORMAT (/, ' OOPS--Emax IS SMALLER THAN ALL YOUR DATA')
IF (Mmdata.EQ.0) THEN
WRITE (6,10600)
-10600 FORMAT (' You did not specify a data type.', /,
- * ' Should it perhaps be "CSISRS" or "Twenty" ?')
+10600 FORMAT (' You did not specify a data type.', /, &
+ ' Should it perhaps be "CSISRS" or "Twenty" ?')
END IF
WRITE (6,10700) Emin, Emax, (Aaadat(I),I=1,numlin)
10700 FORMAT (/, ' Emin, Emax, datapoints=', 1P5G14.6)
STOP '[in Ascidt in mas/mmas3.f # 3]'
-C
+!
70 WRITE (6,10800) Emax, Emin, Aaadat(I)
-10800 FORMAT (/, ' Emax=', 1PE15.8, ' Emin=', E15.8,
- * ' but highest data point is', E15.8)
+10800 FORMAT (/, ' Emax=', 1PE15.8, ' Emin=', E15.8, &
+ ' but highest data point is', E15.8)
STOP '[in Ascidt in mas/mmas3.f # 4]'
-C
+!
80 WRITE (6,10900) Meeeee
-10900 FORMAT (' Maximum number of data points is greater than', I7, '.',
- * /, ' Increase dimension of E and corresponding value of Meeeee.')
+10900 FORMAT (' Maximum number of data points is greater than', I7, '.', &
+ /, ' Increase dimension of E and corresponding value of Meeeee.')
STOP '[in Ascidt in mas/mmas3.f # 5]'
-C
+!
90 WRITE (6,11000)
-11000 FORMAT (' Error in reading data file. Check these possibilities:'
- * /, ' Are there asterisks in data file?')
+11000 FORMAT (' Error in reading data file. Check these possibilities:' &
+ /, ' Are there asterisks in data file?')
IF (Mmdata.EQ.0) THEN
WRITE (6,11100)
-11100 FORMAT (' Should data type "CSISRS" or "TWENTY" be given',
- * 1X, 'in INPut file?')
+11100 FORMAT (' Should data type "CSISRS" or "TWENTY" be given', &
+ 1X, 'in INPut file?')
ELSE IF (Mmdata.EQ.1) THEN
WRITE (6,11200)
-11200 FORMAT (' Data type given in INPut file is "CSISRS".', 2X,
- * 'Is that correct?')
+11200 FORMAT (' Data type given in INPut file is "CSISRS".', 2X, &
+ 'Is that correct?')
ELSE IF (Mmdata.EQ.2) THEN
WRITE (6,11300)
-11300 FORMAT (' Data type given in INPut file is "TWENTY".', 2X,
- * 'Is that correct?')
+11300 FORMAT (' Data type given in INPut file is "TWENTY".', 2X, &
+ 'Is that correct?')
ELSE
END IF
STOP '[in Ascidt in mas/mmas3.f # 6]'
-C
- END
-C
-C
-C --------------------------------------------------------------
-C
+!
+ END SUBROUTINE Ascidt
+!
+!
+! --------------------------------------------------------------
+!
SUBROUTINE Ascxdt (E, Meeeee, Ndat)
-C
-C *** Purpose -- Read ASCII data file for differential data,
-C to be sure there are data within limits given
-C
+!
+! *** Purpose -- Read ASCII data file for differential data,
+! to be sure there are data within limits given
+!
use Junk_common_m
use namfil_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
DIMENSION E(*)
-C
+!
CALL Filopn (13, Fdata, 0)
A = 0.0d0
10 CONTINUE
@@ -395,8 +393,8 @@ C
READ (13,99999,END=60,ERR=60) B
IF (A.EQ.0.0) GO TO 10
IF (A.GT.Emax .OR. A.LT.Emin) GO TO 10
-C
-C *** HERE A.LE.Emax and .GE. Emin; SO THIS IS START OF DATA
+!
+! *** HERE A.LE.Emax and .GE. Emin; SO THIS IS START OF DATA
K = 0
IF (Aold.GT.Emax .AND. A.GT.Emax) GO TO 20
IF (Aold.GT.Emax .AND. A.LT.Emin) GO TO 70
@@ -405,7 +403,7 @@ C *** HERE A.LE.Emax and .GE. Emin; SO THIS IS START OF DATA
K = K + 1
E(K) = A
20 CONTINUE
-C
+!
30 CONTINUE
READ (13,99999,END=50,ERR=50) A
READ (13,99999,END=50,ERR=50) B
@@ -414,66 +412,66 @@ C
IF (K.GT.Meeeee) GO TO 80
E(K) = A
GO TO 30
-C
+!
50 Ndat = K
-C
+!
CLOSE (UNIT=13)
RETURN
-C
+!
60 WRITE (6,99998)
STOP '[in Ascxdt in mas/mmas3.f # 1]'
-C
+!
70 WRITE (6,99997) Emax, Emin, A
STOP '[in Ascxdt in mas/mmas3.f # 2]'
-C
+!
80 WRITE (6,99996) Meeeee
STOP '[in Ascxdt in mas/mmas3.f # 3]'
-C
+!
99999 FORMAT (F10.1)
-99998 FORMAT (/, ' OOPS--Emax IS SMALLER THAN ALL YOUR DATA')
-99997 FORMAT (/, ' Emax=', 1PE15.8, ' Emin=', E15.8,
- * ' but highest data point is', E15.8)
-99996 FORMAT (' Maximum number of data points is greater than', I7, '.',
- * /, 'Increase dimension of E and corresponding value of Meeeee.')
- END
-C
-C
-C --------------------------------------------------------------
-C
+99998 FORMAT (/, ' OOPS--Emax IS SMALLER THAN ALL YOUR DATA')
+99997 FORMAT (/, ' Emax=', 1PE15.8, ' Emin=', E15.8, &
+ ' but highest data point is', E15.8)
+99996 FORMAT (' Maximum number of data points is greater than', I7, '.', &
+ /, 'Increase dimension of E and corresponding value of Meeeee.')
+ END SUBROUTINE Ascxdt
+!
+!
+! --------------------------------------------------------------
+!
SUBROUTINE Fdat1 (E, Ndat)
-C
-C *** Purpose -- Divide into regions if needed
-C
+!
+! *** Purpose -- Divide into regions if needed
+!
use Junk_common_m
use where_mas_common_m
use eees_common_m
use namfil_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
DIMENSION E(*)
-C
+!
DATA Kdivmx /100/, Ndeflt /500/
-C
+!
IF (Nepnts.EQ.0) THEN
WRITE (6,99999) Ndeflt
-99999 FORMAT (' YOU FORGOT TO SPECIFY THE NUMBER OF POINTS FOR',
- * 1X, 'EACH ENERGY REGION.', /, ' SAMMY WILL ARBITRARILY USE',
- * I5, ' POINTS.')
+99999 FORMAT (' YOU FORGOT TO SPECIFY THE NUMBER OF POINTS FOR', &
+ 1X, 'EACH ENERGY REGION.', /, ' SAMMY WILL ARBITRARILY USE', &
+ I5, ' POINTS.')
Nepnts = Ndeflt
END IF
-C
+!
KK = Ndat/Nepnts + 1
-C
+!
IF (KK.GT.Kdivmx) THEN
KK = Kdivmx
ELSE IF (KK.EQ.Kdivmx) THEN
Nepnts = Ndat/KK + 1
WRITE (6,99998) Nepnts
-99998 FORMAT (' SAMMY IS CHANGING Nepnts TO', I10,
- * ' IN ORDER TO AVOID HAVING MORE THAN 100 ENERGY REGIONS.',/,
- * ' SEE N.M.LARSON IF YOU OBJECT.')
+99998 FORMAT (' SAMMY IS CHANGING Nepnts TO', I10, &
+ ' IN ORDER TO AVOID HAVING MORE THAN 100 ENERGY REGIONS.',/, &
+ ' SEE N.M.LARSON IF YOU OBJECT.')
ELSE
END IF
-C
+!
Eeemmm(1,1) = Emin
Eeemmm(2,KK) = Emax
IF (KK.GT.1) THEN
@@ -487,37 +485,38 @@ C
END IF
END DO
Kdiv = KK
-C ?????
+! ?????
IF (Max.LE.10) THEN
Kdiv = Kdiv - 1
Eeemmm(2,Kdiv) = Emax
END IF
END IF
RETURN
- END
-C
-C
-C
-C ----------------------------------------------------------------------
-C
+ END SUBROUTINE Fdat1
+!
+!
+!
+! ----------------------------------------------------------------------
+!
SUBROUTINE Parcov (Lrfx)
-C
-C *** Purpose -- Learn name of parameter covariance file, create PAR file
-C *** if needed
-C
+!
+! *** Purpose -- Learn name of parameter covariance file, create PAR file
+! *** if needed
+!
use fixedi_m
use ifwrit_m
use Junk_common_m
use namfil_common_m
use mssccc_common_m
+ use mmas6_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
-C
-C *** Learn name of PARameter COVariance file
+!
+! *** Learn name of PARameter COVariance file
IF (Icovar.EQ.0) THEN
ELSE IF (Kgenpd.EQ.1 .OR. Ignore.EQ.1) THEN
Fprcov = Dignor
ELSE
-C *************************************************************** File 7
+! *************************************************************** File 7
WRITE (6,10100)
10100 FORMAT (' What is name of parameter COVariance file? ')
READ (5,10200) Fprcov
@@ -525,19 +524,19 @@ C *************************************************************** File 7
IF (Fprcov.EQ.Fblank) THEN
WRITE (6,10300)
WRITE (21,10300)
-10300 FORMAT ('##############################################',
- * /, '# Name of COVariance file must not be blank. #',
- * /, '##############################################')
- STOP
+10300 FORMAT ('##############################################', &
+ /, '# Name of COVariance file must not be blank. #', &
+ /, '##############################################')
+ STOP
ELSE
WRITE (6,11100) Fprcov
11100 FORMAT (' >>> ', A70, ' <<<')
WRITE (21,11200) Fprcov
-11200 FORMAT (' Name of initial parameter covariance file is: ',
- * /, ' >>> ', A70, ' <<<')
+11200 FORMAT (' Name of initial parameter covariance file is: ', &
+ /, ' >>> ', A70, ' <<<')
END IF
END IF
-C
+!
IF (Ndfinp.EQ.1) THEN
IF (Lrfx.EQ.7) THEN
CALL Endf7 (Kompci)
@@ -545,9 +544,10 @@ C
CALL Endf2 (Kompci, Matnum)
END IF
END IF
-C
+!
IF (Kgen.NE.0) Finput = Fff22x
IF (Ntggen.NE.0 .AND. Kbayes.NE.0) Finput = Fff22x
-C
+!
RETURN
- END
+ END SUBROUTINE Parcov
+end module mmas3_m
diff --git a/sammy/src/mas/mmas6.f b/sammy/src/mas/mmas6.f90
similarity index 68%
rename from sammy/src/mas/mmas6.f
rename to sammy/src/mas/mmas6.f90
index c96078fdd36fbe195da0ae9b4486aaa707b20ce4..c0f4bada92ab3acb4b177dfb53d91f7c0568dcb8 100644
--- a/sammy/src/mas/mmas6.f
+++ b/sammy/src/mas/mmas6.f90
@@ -1,14 +1,17 @@
-C
-C
-C ____________________________________________________________________________
-C
+module mmas6_m
+
+contains
+!
+!
+! ____________________________________________________________________________
+!
SUBROUTINE Endf1 (Apx, Matnum, Lrfx)
-C
-C *** Purpose -- Copy most of first part of INPut file to use ENDF-file
-C *** information along with user-supplied information
-C
-C *** Modified by NML from Andy Braeutigam's version
-C
+!
+! *** Purpose -- Copy most of first part of INPut file to use ENDF-file
+! *** information along with user-supplied information
+!
+! *** Modified by NML from Andy Braeutigam's version
+!
use ifwrit_m
use Junk_common_m
use namfil_common_m
@@ -16,84 +19,83 @@ C
use constn_common_m
use EndfData_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
-C
- COMMON /ENDFab/ Sp(300), xRdeff(300),
- * xRdtru(300), Gx(300), Ip(300),
- * Ll(300), Radeff(200), Radtru(200), Krad(200), Icrad(200),
- * Igrad(500,200), Bound(200), Igroup, Jradx, Nendfy
+!
+ COMMON /ENDFab/ Sp(300), xRdeff(300), &
+ xRdtru(300), Gx(300), Ip(300), &
+ Ll(300), Radeff(200), Radtru(200), Krad(200), Icrad(200), &
+ Igrad(500,200), Bound(200), Igroup, Jradx, Nendfy
DIMENSION Lxxx(200), Lyyy(200), Eminxx(200), Appxx(200)
-C
-C *** Rewind original input file
+!
+! *** Rewind original input file
REWIND 11
call resParData%cleanIsotopes()
-C
-C *** Open ENDF file
+!
+! *** Open ENDF file
CALL Filopn (10, Fparam, 0)
-C
-C *** Open new input file
+!
+! *** Open new input file
CALL Newopn (13, 'SAMNDF.INP', 0)
-C
+!
IF (Matnum.GT.0) THEN
-C *** Read from the ENDF file until find the right Material Number,
-C *** then read through first line in File 2
+! *** Read from the ENDF file until find the right Material Number,
+! *** then read through first line in File 2
Ifile = 2
Mtx = 151
- CALL Find_Matnum_In_ENDF_File (Matnum, 2, 151, Za, Awr, Nisotp,
- * 10)
+ CALL Find_Matnum_In_ENDF_File (Matnum, 2, 151, Za, Awr, Nisotp, 10)
ELSE
-C *** first entry in partial ENDF/B-VI file
+! *** first entry in partial ENDF/B-VI file
CALL Rcontx (Za, Awr, Lx, Lx, Nisotp, Lx, Mat, Mf, Mt, Ns)
Matnum = Mat
END IF
-C
-C *** Mass Awr replaces whatever the user supplied in INPut file
-C for Aw=Aaawww; but remember that ENDF units are "ratio to
-C neutron" rather than "atomic mass units"
+!
+! *** Mass Awr replaces whatever the user supplied in INPut file
+! for Aw=Aaawww; but remember that ENDF units are "ratio to
+! neutron" rather than "atomic mass units"
Awr = Awr*Aneutr
-C
+!
-C
+!
IF (Nisotp.GT.1) STOP '[STOP in Endf1 in mas/mmas6.f]'
-C
-C *** Begin do loop over isotopes (although SAMMY can handle only one so far)
-C
+!
+! *** Begin do loop over isotopes (although SAMMY can handle only one so far)
+!
Misotp = 1
-C only one isotope is permitted
-C
-C *** second entry in ENDF/B-VI file
+! only one isotope is permitted
+!
+! *** second entry in ENDF/B-VI file
CALL Rcont (Zai, Abn, Lx, Lfw, Ner, Lx, Mat, Mf, Mt, Ns)
-C only one isotope for now
+! only one isotope for now
call resParData%addIsotope(abn, int(Zai), awr)
-C
-C *** Third entry in ENDF/B-VI file
-C *** This is what ENDF manual calls "the range card" (CONT record)
+!
+! *** Third entry in ENDF/B-VI file
+! *** This is what ENDF manual calls "the range card" (CONT record)
CALL Rcont (Endfmn, Endfmx, Lru, Lrf, Nro, Naps, Mat, Mf,Mt,Ns)
-C
+!
Lrfx = Lrf
WRITE (21,20100) Lrf
WRITE (6,20100) Lrf
20100 FORMAT ('ENDF file has Lrf=', I3)
-C
-C
+!
+!
CALL Newinp (Endfmn, Endfmx, Kerang, Krdspn)
-C
-C
+!
+!
IF (Lru.GT.1) STOP '[STOP in Endf1 in mas/mmas6.f # 2]'
-C *** Lru=2 => unresolved resonance parameters
-C
+! *** Lru=2 => unresolved resonance parameters
+!
IF (Nro.EQ.1) THEN
-C *** Nro=1 => Radius is not energy-independent
+! *** Nro=1 => Radius is not energy-independent
WRITE (21,10000)
WRITE (6,10000)
10000 FORMAT (' Nro=1 => Radius is not energy-independent')
-C *** fourth entry in ENDF/B-VI file
- CALL Rtab1 (Xx, Xx, Lx, Lx, Nr, Np, Lxxx, Lyyy, Eminxx,
- * Appxx, Mat, Mf, Mt, Ns, 10)
+! *** fourth entry in ENDF/B-VI file
+ CALL Rtab1 (Xx, Xx, Lx, Lx, Nr, Np, Lxxx, Lyyy, Eminxx, &
+ Appxx, Mat, Mf, Mt, Ns, 10)
END IF
-C
+!
IF (Ndfndf.EQ.1) THEN
CALL Newopn (93, 'SAMNDF.NDF', 0)
WRITE (93,10100) Matnum
@@ -107,58 +109,58 @@ C
WRITE (93,10500)
10500 FORMAT (/, 'Isotope=1', /)
END IF
-C
-C *** fifth entry in ENDF/B-VI file (gives Nls=Nendfx=Number of L-values)
+!
+! *** fifth entry in ENDF/B-VI file (gives Nls=Nendfx=Number of L-values)
CALL Rcont (Spi, Ap, L1, L2, L3, L4, Mat, Mf, Mt, Ns)
Nendfx = L3
Nendfy = Nendfx
Ap = Ap * 10.0d0
Apx = Ap
-C
-C
+!
+!
IF (Lrf.EQ.7) THEN
Ifg = L1
IF (Ifg.NE.0) STOP '[STOP in Endf1 in mas/mmas6.f # 3]'
Krm = L2
IF (Krm.NE.3) STOP '[STOP in Endf1 in mas/mmas6.f # 4]'
Njs = L3
-C *** Read particle-pair definitions from ENDF file, write into
-C *** SAMMY INPut file
+! *** Read particle-pair definitions from ENDF file, write into
+! *** SAMMY INPut file
CALL Read_Pp7
END IF
RETURN
- END
-C
-C
-C ____________________________________________________________________________
-C
+ END SUBROUTINE Endf1
+!
+!
+! ____________________________________________________________________________
+!
SUBROUTINE Newinp (Endfmn, Endfmx, Kerang, Krdspn)
-C
-C *** Purpose -- Read alphanumeric information from original
-C *** input file and write new input file.
-C
+!
+! *** Purpose -- Read alphanumeric information from original
+! *** input file and write new input file.
+!
use endfaa_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
-C
+!
CHARACTER*1 A(80), Ub(20), Blank, Uc(20)
CHARACTER*10 Elemnt
- DATA Ub /'I','N','P','U','T',' ','I','S',' ',
- * 'E','N','D','F','/','B',' ','F','I','L','E'/
- DATA Uc /'U','S','E',' ','E','N','E','R','G','Y',
- * ' ','R','A','N','G','E',' ','F','R','O'/
+ DATA Ub /'I','N','P','U','T',' ','I','S',' ', &
+ 'E','N','D','F','/','B',' ','F','I','L','E'/
+ DATA Uc /'U','S','E',' ','E','N','E','R','G','Y', &
+ ' ','R','A','N','G','E',' ','F','R','O'/
DATA Blank /' '/
-C Ub="INPUT IS ENDF/B FILE"
-C Uc="USE ENERGY RANGE FROm endf file"
-C
+! Ub="INPUT IS ENDF/B FILE"
+! Uc="USE ENERGY RANGE FROm endf file"
+!
10100 FORMAT (80A1)
-C *** Copy first line from old INPut file to new
+! *** Copy first line from old INPut file to new
READ (11,10100) A
CALL Mina (A, Max)
WRITE (13,10100) (A(J),J=1,Max)
-C
-C *** Copy second line from old INPut file to new with appropriate changes
- READ (11,10200) Elemnt, Aw, Emin, Emax, Nepnts, Itmax, Icorr,
- * Nxtra, Iptdop, Iptwid, Ixxchn
+!
+! *** Copy second line from old INPut file to new with appropriate changes
+ READ (11,10200) Elemnt, Aw, Emin, Emax, Nepnts, Itmax, Icorr, &
+ Nxtra, Iptdop, Iptwid, Ixxchn
10200 FORMAT (A10, 3F10.5, 2I5, I2, 2X, I1, I2, 1X, I2, I10)
IF (Kerang.EQ.1) THEN
Emin = Endfmn
@@ -167,32 +169,32 @@ C *** Copy second line from old INPut file to new with appropriate changes
END IF
IF (Emin.GE.0.00001 .AND. Emin.LT.99.99999) THEN
IF (Emax.GE.0.00001 .AND. Emax.LT.9999.99999) THEN
- WRITE (13,10300) Elemnt, Awr, Emin, Emax, Nepnts,
- * Itmax, Icorr, Nxtra, Iptdop, Iptwid, Ixxchn
-10300 FORMAT (A10, F10.6, F9.5, 1X, F9.4, 1X, 2I5, I2, 2X,
- * I1, I2, 1X, I2, I10)
+ WRITE (13,10300) Elemnt, Awr, Emin, Emax, Nepnts, &
+ Itmax, Icorr, Nxtra, Iptdop, Iptwid, Ixxchn
+10300 FORMAT (A10, F10.6, F9.5, 1X, F9.4, 1X, 2I5, I2, 2X, &
+ I1, I2, 1X, I2, I10)
ELSE
- WRITE (13,10400) Elemnt, Awr, Emin, Emax, Nepnts,
- * Itmax, Icorr, Nxtra, Iptdop, Iptwid, Ixxchn
-10400 FORMAT (A10, F10.6, F9.5, 1X, 1PG10.4, 2I5, I2, 2X,
- * I1, I2, 1X, I2, I10)
+ WRITE (13,10400) Elemnt, Awr, Emin, Emax, Nepnts, &
+ Itmax, Icorr, Nxtra, Iptdop, Iptwid, Ixxchn
+10400 FORMAT (A10, F10.6, F9.5, 1X, 1PG10.4, 2I5, I2, 2X, &
+ I1, I2, 1X, I2, I10)
END IF
ELSE
IF (Emax.GE.0.00001 .AND. Emax.LT.9999.99999) THEN
- WRITE (13,10500) Elemnt, Awr, Emin, Emax, Nepnts,
- * Itmax, Icorr, Nxtra, Iptdop, Iptwid, Ixxchn
-10500 FORMAT (A10, F10.6, 1PG10.4, 0PF10.5, 2I5, I2, 2x,
- * I1, I2, 1X, I2, I10)
+ WRITE (13,10500) Elemnt, Awr, Emin, Emax, Nepnts, &
+ Itmax, Icorr, Nxtra, Iptdop, Iptwid, Ixxchn
+10500 FORMAT (A10, F10.6, 1PG10.4, 0PF10.5, 2I5, I2, 2x, &
+ I1, I2, 1X, I2, I10)
ELSE
- WRITE (13,10600) Elemnt, Awr, Emin, Emax, Nepnts,
- * Itmax, Icorr, Nxtra, Iptdop, Iptwid, Ixxchn
-10600 FORMAT (A10, F10.6, 1PG10.4, 1PG10.4, 2I5, I2, 2x,
- * I1, I2, 1X, 5I2, I10)
+ WRITE (13,10600) Elemnt, Awr, Emin, Emax, Nepnts, &
+ Itmax, Icorr, Nxtra, Iptdop, Iptwid, Ixxchn
+10600 FORMAT (A10, F10.6, 1PG10.4, 1PG10.4, 2I5, I2, 2x, &
+ I1, I2, 1X, 5I2, I10)
END IF
END IF
-C
+!
10 CONTINUE
-C *** Read and write alphanumeric lines
+! *** Read and write alphanumeric lines
READ (11,10100) A
CALL Mina (A, Max)
CALL Convert_to_Caps (A, Max, Kpound)
@@ -202,23 +204,23 @@ C *** Read and write alphanumeric lines
DO I=1,Maxb
IF (Ub(I).NE.A(I)) GO TO 30
END DO
-C *** Here we do not want to repeat the line saying "INPUT IS ENDF/B FILE"
+! *** Here we do not want to repeat the line saying "INPUT IS ENDF/B FILE"
GO TO 10
-C
+!
30 CONTINUE
DO I=1,Maxb
IF (Uc(I).NE.A(I)) GO TO 40
END DO
-C *** Here we do not want to repeat "use energy range from endf file"
+! *** Here we do not want to repeat "use energy range from endf file"
GO TO 10
-C
+!
40 CONTINUE
-C *** Here we do copy line onto new file
+! *** Here we do copy line onto new file
WRITE (13,10100) (A(J),J=1,Max)
GO TO 10
-C
+!
50 CONTINUE
-C *** Directly before blank line, add new lines to alphanumeric info
+! *** Directly before blank line, add new lines to alphanumeric info
IF (Lrf.EQ.1) THEN
WRITE (13,10800)
10800 FORMAT ('SLBW FORMALISM IS WANTED')
@@ -237,14 +239,14 @@ C *** Directly before blank line, add new lines to alphanumeric info
WRITE (13,11200)
11200 FORMAT ('QUANTUM NUMBERS ARE IN PARAMETER FILE')
END IF
-C
-C *** End of card set 3, blank line
+!
+! *** End of card set 3, blank line
WRITE (13,11300) Blank
11300 FORMAT (A1)
-C
+!
IF (Krdspn.EQ.2 .OR. Krdspn.EQ.3) THEN
-C *** Need to read particle-pair definitions from INPut file before
-C *** moving on to other things
+! *** Need to read particle-pair definitions from INPut file before
+! *** moving on to other things
60 CONTINUE
READ (11,10100) A
CALL Mina (A, Max)
@@ -253,17 +255,17 @@ C *** moving on to other things
70 CONTINUE
END IF
RETURN
- END
-C
-C
-C ____________________________________________________________________________
-C
+ END SUBROUTINE Newinp
+!
+!
+! ____________________________________________________________________________
+!
SUBROUTINE Mina (A, Max)
IMPLICIT DOUBLE PRECISION (a-h,o-z)
CHARACTER*1 A(80)
CHARACTER*1 Blank
DATA Blank /' '/
-C
+!
N = 81
DO I=1,80
N = N - 1
@@ -274,131 +276,131 @@ C
END DO
Max = 0
RETURN
- END
-C
-C
-C ____________________________________________________________________________
-C
+ ENDSUBROUTINE Mina
+!
+!
+! ____________________________________________________________________________
+!
SUBROUTINE Endf2 (Kompci, Matnum)
-C
-C *** Purpose -- Create rest of INPut file using ENDF-file information
-C *** also make PARameter file using ENDF-file information
-C *** Modified by NML from Andy Braeutigam's version
-C
+!
+! *** Purpose -- Create rest of INPut file using ENDF-file information
+! *** also make PARameter file using ENDF-file information
+! *** Modified by NML from Andy Braeutigam's version
+!
use samxxx_common_m
use Junk_common_m
use namfil_common_m
use endfaa_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
-C
-C
+!
+!
Knofis = 100
-C *** If ENDF covariance file exists, open and read to see how many
-C *** parameters per resonance are to be flagged
+! *** If ENDF covariance file exists, open and read to see how many
+! *** parameters per resonance are to be flagged
IF (Kompci.NE.0) THEN
CALL Read_Cov_Mpar (Mpar, Matnum)
Knofis = Mpar
END IF
-C
-C
-C *** Figure quantum numbers
+!
+!
+! *** Figure quantum numbers
CALL Quantu
-C
-C *** Open new parameter file
+!
+! *** Open new parameter file
CALL Newopn (38, Sam38x, 0)
-C
+!
IF (Lrf.EQ.1 .OR. Lrf.EQ.2) THEN
CALL Smlbw (Kompci)
-C *** Lrf=1 => single-level Breit-Wigner
-C *** Lrf=2 => multilevel Breit-Wigner
-C
+! *** Lrf=1 => single-level Breit-Wigner
+! *** Lrf=2 => multilevel Breit-Wigner
+!
ELSE IF (Lrf.EQ.3) THEN
CALL Rmoore (Kompci, Knofis)
-C *** Lrf=3 => Reich-Moore
-C
+! *** Lrf=3 => Reich-Moore
+!
ELSE IF (Lrf.EQ.7) THEN
STOP '[in Endf2 in mmas6.f, Endf7 should be called instead]'
-C Endf7 should be called instead
-C *** Lrf=7 => true Reich-Moore format
-C
+! Endf7 should be called instead
+! *** Lrf=7 => true Reich-Moore format
+!
ELSE
-C ELSE IF ( (Lrf.GT.3 .AND. Lrf.LT.7) .OR. Lrf.GT.7) THEN
+! ELSE IF ( (Lrf.GT.3 .AND. Lrf.LT.7) .OR. Lrf.GT.7) THEN
STOP '[STOP in Endf2 in mas/mmas6.f # 2]'
-C *** Lrf=4 => Adler-Adler
-C *** Lrf=5 => general R-matrix
-C *** Lrf=6 => hybrid R-funtion
-C
+! *** Lrf=4 => Adler-Adler
+! *** Lrf=5 => general R-matrix
+! *** Lrf=6 => hybrid R-funtion
+!
END IF
WRITE (38,99997)
WRITE (38,99997)
99997 FORMAT (' ')
CLOSE (UNIT=10)
CLOSE (UNIT=11)
-C
+!
REWIND (UNIT=38)
-C
-C *** Open new parameter file
+!
+! *** Open new parameter file
CALL Newopn (12, 'SAMNDF.PAR', 0)
-C *** Re-write from old to new file
+! *** Re-write from old to new file
Iux = 0
CALL Rewrite_12 (Iux, Iux, 38, 12)
IF (Kompci.NE.0) THEN
WRITE (12,99996)
99996 FORMAT ('Covariance matrix is available in ENDF file')
END IF
-C *** Close both files
+! *** Close both files
CLOSE (UNIT=12)
CLOSE (UNIT=38)
-C
-C *** Write spin group information into new INPut file
+!
+! *** Write spin group information into new INPut file
CALL Newin2
CLOSE (UNIT=13)
-C
-C *** allow SAMMY to read from new input and parameter files instead of
-C *** from original input and ENDF files
+!
+! *** allow SAMMY to read from new input and parameter files instead of
+! *** from original input and ENDF files
Finput = 'SAMNDF.INP'
Fparam = 'SAMNDF.PAR'
CALL Filopn (11, Finput, 0)
-C
+!
RETURN
- END
-C
-C
-C ___________________________________________________________________________
-C
+ END SUBROUTINE Endf2
+!
+!
+! ___________________________________________________________________________
+!
SUBROUTINE Quantu
-C
-C *** purpose of routine is to generate all possible combinations of
-C *** l,s,J for given I.
-C
+!
+! *** purpose of routine is to generate all possible combinations of
+! *** l,s,J for given I.
+!
use endfaa_common_m
use constn_common_m
use EndfData_common_m
use SammySpinGroupInfo_M
IMPLICIT DOUBLE PRECISION (a-h,o-z)
-C
+!
type(SammySpinGroupInfo)::spinInfo
DATA Smalli /0.5d0/, Zero /0.0d0/, One /1.0d0/
-C
-C
+!
+!
Capi = Spi
Parity = One
IF (Spi.LT.Zero) Parity = - One
-c
+!
S(1) = dABS(Capi) - Smalli
S(2) = dABS(Capi) + Smalli
Is = 2
IF (Capi.EQ.Zero) S(1) = Smalli
IF (Capi.EQ.Zero) Is = 1
Ischan = Is
-C
+!
Ng = 0
Parl = -Parity
DO 30 Ll=1,Nendfx
eL = float(ll-1)
L = Ll - 1
Parl = - Parl
-C
+!
DO Iis = 1,Is
Capj = dABS(S(Iis)-eL)
Capjmx = S(Iis) + eL
@@ -406,7 +408,7 @@ C
C = Capj*Parl
Ng = Ng + 1
IF (Ng.GT.20) STOP '[STOP in Quantu in mas/mmas6.f]'
-C *** set values for all arrays in /Endfaa/
+! *** set values for all arrays in /Endfaa/
Chspin(1,Ng) = S(Iis)
Enbnd (1,Ng) = Zero
Echan (1,Ng) = Zero
@@ -427,41 +429,40 @@ C *** set values for all arrays in /Endfaa/
IF (Capj.LE.Capjmx) GO TO 10
END DO
-C
+!
30 CONTINUE
Ngroup = Ng
RETURN
- END
-C
-C
-C ____________________________________________________________________________
-C
+ END SUBROUTINE Quantu
+!
+!
+! ____________________________________________________________________________
+!
SUBROUTINE Smlbw (Kompci)
-C
+!
use endfaa_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
DIMENSION Efixj(200)
DATA Nfixj/200/, Zero /0.0d0/, Thous /1000.0d0/
-C
-C
+!
+!
J01 = 0
IF (Kompci.EQ.1) J01 = 1
Kfixj = 0
DO Mendfg=1,Nendfx
-C
-C *** first part of sixth entry in ENDF/B-VI file
+!
+! *** first part of sixth entry in ENDF/B-VI file
CALL Rcont (Awri, Ax, Llll, Lx, Nrs6, Nrs, Mat, Mf, Mt, Ns)
-C
-C *** second part of sixth entry
+!
+! *** second part of sixth entry
II = 0
DO N=1,Nrs
-C
-C *** Read resonance parameters
- CALL Rlist (E, Spinjj, Gamt, Gamn, Gamg, Gamf, Mat, MF, MT,
- * NS)
-C
+!
+! *** Read resonance parameters
+ CALL Rlist (E, Spinjj, Gamt, Gamn, Gamg, Gamf, Mat, MF, MT, NS)
+!
10 CONTINUE
-C *** find spin group numbers
+! *** find spin group numbers
CALL Findsp (Llll, Spinjj, Is)
IF (Is.EQ.0) THEN
Kfixj = Kfixj + 1
@@ -470,13 +471,13 @@ C *** find spin group numbers
Ii = Ii + 1
GO TO 10
END IF
-C
-C *** convert to SAMMY units
+!
+! *** convert to SAMMY units
Gamg = Gamg*Thous
Gamn = Gamn*Thous
-C
+!
IF (Gamf.EQ.Zero) THEN
-C *** write results for one-channel case
+! *** write results for one-channel case
WRITE (38,30000) E, Gamg, Gamn, Zero, Zero,J01,J01,J01,Is
30000 FORMAT ('#30', 5F30.15, 3I2, 4X, I2)
WRITE (38,30100) E, Gamg, Gamn, Zero, Zero
@@ -490,48 +491,48 @@ C *** write results for one-channel case
WRITE (38,40100) E, Gamg, Gamn, Gamf, Zero
40100 FORMAT ('#40', 5(1PG12.5))
END IF
-C
+!
END DO
END DO
-C
+!
IF (Kfixj.EQ.0) THEN
RETURN
ELSE IF (Kfixj.GT.Nfixj) THEN
WRITE (6,10000) Nfixj, Kfixj
WRITE (21,10000) Nfixj, Kfixj
-10000 FORMAT (' Increase Nfixj and dimension on Efixj in mmas6.f in',
- * 1X, 'routine Smlbw from', I5, ' to', I5)
+10000 FORMAT (' Increase Nfixj and dimension on Efixj in mmas6.f in', &
+ 1X, 'routine Smlbw from', I5, ' to', I5)
STOP '[STOP in Smlbw in mas/mmas6.f]'
ELSE
WRITE (6,10100) Kfixj
-10100 FORMAT (' J-Spin value in ENDF file is unspecified for', I5,
- * ' resonances.', /)
+10100 FORMAT (' J-Spin value in ENDF file is unspecified for', I5, &
+ ' resonances.', /)
WRITE (21,10200) Kfixj
-10200 FORMAT (/, ' *** J-Spin value in ENDF file is unspecified for',
- * I5, ' resonances.', /
- * ' *** GammaN will be recalculated using J = Jfalse +/- 1/2',
- * /, ' *** Resonance energies (In eV) are :')
+10200 FORMAT (/, ' *** J-Spin value in ENDF file is unspecified for', &
+ I5, ' resonances.', / &
+ ' *** GammaN will be recalculated using J = Jfalse +/- 1/2', &
+ /, ' *** Resonance energies (In eV) are :')
WRITE (21,10300) (Efixj(I),i=1,Kfixj)
10300 FORMAT ((5X, 4(1PG14.6)))
WRITE (21,10400)
10400 FORMAT(' ***')
END IF
RETURN
- END
-C
-C
-C __________________________________________________________________________
-C
+ END SUBROUTINE Smlbw
+!
+!
+! __________________________________________________________________________
+!
SUBROUTINE Rmoore (Kompci, Knofis)
-C
+!
use endfaa_common_m
use constn_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
DIMENSION Efixj(200), Rade(20), Radt(20), Lkount(20)
DATA Nfixj /200/
- DATA Zero /0.0d0/, Zz8 /0.8d0/, Z123 /1.23d0/, One /1.0d0/,
- * Three /3.0d0/, Ten /10.0d0/, Thous /1000.0d0/, Small /0.0001d0/
-C
+ DATA Zero /0.0d0/, Zz8 /0.8d0/, Z123 /1.23d0/, One /1.0d0/, &
+ Three /3.0d0/, Ten /10.0d0/, Thous /1000.0d0/, Small /0.0001d0/
+!
IF (Kompci.EQ.1) THEN
J01 = 1
J02 = 1
@@ -545,47 +546,46 @@ C
END IF
Is_Kount = 0
Kfixj = 0
-C
-C &&&
-C *** The following is consistent with NJOY and AMPX but not with the
-C *** ENDF-102 manual; ergo, we must change the manual (Nov. 2002)
+!
+! &&&
+! *** The following is consistent with NJOY and AMPX but not with the
+! *** ENDF-102 manual; ergo, we must change the manual (Nov. 2002)
Awri = Aneutr*Awri
-C
+!
DO Mendfg=1,Nendfx
-C
-C *** First part of sixth entry in ENDF/B-VI file
+!
+! *** First part of sixth entry in ENDF/B-VI file
CALL Rcont (Awri, Apl, Llll, Lx, Nrs6, Nrs, Mat, Mf, Mt, Ns)
-C
-C
+!
+!
IF (Apl.EQ.Zero) THEN
Aptru = Z123 * Awri**(One/Three) + Zz8
Apeff = Ap
ELSE
-C ELSE IF (Apl.NE.Zero) THEN
+! ELSE IF (Apl.NE.Zero) THEN
Apeff = Apl*Ten
IF (Naps.EQ.1) THEN
Aptru = Apl*Ten
ELSE
-C ELSE IF (Naps.EQ.0) THEN
+! ELSE IF (Naps.EQ.0) THEN
Aptru = Z123 * Awri**(One/Three) + Zz8
END IF
END IF
-C &&&
-C
+! &&&
+!
Rade(Mendfg) = Apeff
Radt(Mendfg) = Aptru
Lkount(Mendfg) = Llll
-C
-C *** second part of sixth entry
+!
+! *** second part of sixth entry
Ii = 0
DO N=1,Nrs
-C
-C *** Read resonance parameters
- CALL Rlist (E, Spinjj, Gamn, Gamg, Gamf, Gamf2, Mat, Mt, Mt,
- * Ns)
-C
+!
+! *** Read resonance parameters
+ CALL Rlist (E, Spinjj, Gamn, Gamg, Gamf, Gamf2, Mat, Mt, Mt, Ns)
+!
10 CONTINUE
-C *** Find spin group number "Is" for this resonance
+! *** Find spin group number "Is" for this resonance
CALL Findsp (Llll, Spinjj, Is)
IF (Is.EQ.0) THEN
Kfixj = Kfixj + 1
@@ -600,53 +600,53 @@ C *** Find spin group number "Is" for this resonance
END IF
GO TO 10
END IF
-C
-C *** Convert to SAMMY units etc
+!
+! *** Convert to SAMMY units etc
IF (Awri.NE.Zero) Emmm1(1,Is) = Awri
Rdeff(1,Is) = Apeff
Rdtru(1,Is) = Aptru
Gamg = Gamg*Thous
Gamn = Gamn*Thous
-C
+!
IF (Gamf.EQ.Zero .AND. Gamf2.EQ.Zero) THEN
IF (Ntotc(Is).EQ.1) THEN
-C *** Write results for one-channel case
- WRITE (38,30000) E, Gamg, Gamn, Zero, Zero,
- * (J01,J=1,3), Is
+! *** Write results for one-channel case
+ WRITE (38,30000) E, Gamg, Gamn, Zero, Zero, &
+ (J01,J=1,3), Is
30000 FORMAT ('#30', 5F30.15, 3I2, 4X, I2)
WRITE (38,30100) E, Gamg, Gamn, Zero, Zero
30100 FORMAT ('#30', 5(1PG12.5))
ELSE IF (Ntotc(Is).EQ.2) THEN
- WRITE (38,40000) E, Gamg, Gamn, Zero, Zero,
- * (J01,J=1,3), J02, Is
+ WRITE (38,40000) E, Gamg, Gamn, Zero, Zero, &
+ (J01,J=1,3), J02, Is
WRITE (38,40100) E, Gamg, Gamn, Zero, Zero
ELSE IF (Ntotc(Is).EQ.3) THEN
- WRITE (38,50000) E, Gamg, Gamn, Zero, Zero,
- * (J01,J=1,3), J02, J03, Is
+ WRITE (38,50000) E, Gamg, Gamn, Zero, Zero, &
+ (J01,J=1,3), J02, J03, Is
WRITE (38,50100) E, Gamg, Gamn, Zero, Zero
END IF
-C
+!
ELSE IF (Gamf2.EQ.Zero) THEN
-C *** write results for two-channel case
+! *** write results for two-channel case
Gamf = Gamf*Thous
IF (Ntotc(Is).LT.2) THEN
Ntotc(Is) = 2
Lpent(2,Is) = 0
END IF
IF (Ntotc(Is).EQ.2) THEN
- WRITE (38,40000) E, Gamg, Gamn, Gamf, Zero,
- * (J01,J=1,3), J02, Is
+ WRITE (38,40000) E, Gamg, Gamn, Gamf, Zero, &
+ (J01,J=1,3), J02, Is
40000 FORMAT ('#40', 5F30.15, 4I2, 2X, I2)
WRITE (38,40100) E, Gamg, Gamn, Gamf, Zero
40100 FORMAT ('#40', 5(1PG12.5))
ELSE IF (Ntotc(Is).EQ.3) THEN
- WRITE (38,50000) E, Gamg, Gamn, Gamf, Zero,
- * (J01,J=1,3), J02, J03, Is
+ WRITE (38,50000) E, Gamg, Gamn, Gamf, Zero, &
+ (J01,J=1,3), J02, J03, Is
WRITE (38,50100) E, Gamg, Gamn, Gamf, Zero
END IF
-C
+!
ELSE
-C *** write results for three-channel case
+! *** write results for three-channel case
IF (Ntotc(Is).LT.3) THEN
Ntotc(Is) = 3
Lpent(2,Is) = 0
@@ -655,44 +655,44 @@ C *** write results for three-channel case
Gamf = Gamf*Thous
IF (Gamf.EQ.Zero) Gamf = Small
Gamf2 = Gamf2*Thous
- WRITE (38,50000) E, Gamg, Gamn, Gamf, Gamf2,
- * (J01,J=1,3), J02, J03, Is
+ WRITE (38,50000) E, Gamg, Gamn, Gamf, Gamf2, &
+ (J01,J=1,3), J02, J03, Is
50000 FORMAT ('#50', 5F30.15, 6I2)
WRITE (38,50100) E, Gamg, Gamn, Gamf, Gamf2
50100 FORMAT ('#50', 5(1PG12.5))
END IF
-C
+!
END DO
END DO
-C
+!
CALL Wrtrad (Rade, Radt, Lkount)
-C
+!
IF (Kfixj.EQ.0) THEN
RETURN
ELSE IF (Kfixj.GT.Nfixj) THEN
WRITE ( 6,10000) Nfixj, Kfixj
WRITE (21,10000) Nfixj, Kfixj
-10000 FORMAT (' Increase Nfixj and dimension on Efixj in mmas6.f',
- * 1X, 'in routine RMoore from', I5, ' to', I5)
+10000 FORMAT (' Increase Nfixj and dimension on Efixj in mmas6.f', &
+ 1X, 'in routine RMoore from', I5, ' to', I5)
STOP '[STOP in Rmoore in mas/mmas6.f # 2]'
ELSE
WRITE (6,10100) Kfixj
-10100 FORMAT (' J-Spin value in ENDF file is unspecified for', I5,
- * ' resonances.')
+10100 FORMAT (' J-Spin value in ENDF file is unspecified for', I5, &
+ ' resonances.')
WRITE (21,10200) Kfixj
-10200 FORMAT (' J-Spin value in ENDF file is unspecified for', I5,
- * ' resonances.', /
- * ' J is defined using J = Jfalse +/- 1/2 (alternating)',/
- * ' Resonance energies (In eV) are :')
+10200 FORMAT (' J-Spin value in ENDF file is unspecified for', I5, &
+ ' resonances.', / &
+ ' J is defined using J = Jfalse +/- 1/2 (alternating)',/ &
+ ' Resonance energies (In eV) are :')
WRITE (21,10300) (Efixj(I),I=1,Kfixj)
10300 FORMAT (5X, 4(1PG14.6))
END IF
RETURN
- END
-C
-C
-C _____________________________________________________________________________
-C
+ END SUBROUTINE Rmoore
+!
+!
+! _____________________________________________________________________________
+!
SUBROUTINE Rcontx (C1, C2, L1, L2, N1, N2, Mat, Mf, Mt, Ns)
IMPLICIT DOUBLE PRECISION (a-h,o-z)
CHARACTER*64 Alf
@@ -703,36 +703,36 @@ C
READ (10,99999,ERR=10) C1, C2, L1, L2, N1, N2, Mat, Mf, Mt, Ns
99999 FORMAT (2E11.4, 4I11, I4, I2, I3, I5)
IF (C1.EQ.A1) THEN
-C WRITE (6,99997) A1, C1, C2, l1, l2, N1, N2
-C99997 FORMAT (' A1, C1, C2, L1, L2, N1, N2=', 1P3G14.6, 4I6)
+! WRITE (6,99997) A1, C1, C2, l1, l2, N1, N2
+!99997 FORMAT (' A1, C1, C2, L1, L2, N1, N2=', 1P3G14.6, 4I6)
REWIND 10
READ (10,99999,ERR=10) C1, C2, L1, L2, N1, N2
END IF
IF (C1.EQ.0.0d0) GO TO 10
RETURN
- END
-C
-C
-C __________________________________________________________________________
-C
+ END SUBROUTINE Rcontx
+!
+!
+! __________________________________________________________________________
+!
SUBROUTINE Rcont (C1, C2, L1, L2, N1, N2, Mat, Mf, Mt, Ns)
IMPLICIT DOUBLE PRECISION (a-h,o-z)
READ (10,99999) C1, C2, L1, L2, N1, N2
99999 FORMAT (2E11.4, 4I11, I4, I2, I3, I5)
RETURN
- END
-C
-C
-C __________________________________________________________________________
-C
- SUBROUTINE Rtab1 (C1, C2, L1, L2, Nr, Np, Nbt, Int, X, Y,
- * Mat, Mf, Mt, Ns, Iunit)
+ ENDSUBROUTINE Rcont
+!
+!
+! __________________________________________________________________________
+!
+ SUBROUTINE Rtab1 (C1, C2, L1, L2, Nr, Np, Nbt, Int, X, Y, &
+ Mat, Mf, Mt, Ns, Iunit)
IMPLICIT DOUBLE PRECISION (a-h,o-z)
DIMENSION Nbt(*), Int(*), X(*), Y(*)
-C
+!
READ (Iunit,99999) C1, C2, L1, L2, Nr, Np, Mat, Mf, Mt, Ns
99999 FORMAT (1P2E11.4, 4I11, I4, I2, I3, I5)
-C
+!
Nr6 = Nr/3
Min = 1
Max = 3
@@ -754,8 +754,8 @@ C
IF (Nr-Min+1.EQ.2) READ (Iunit,99998) (Nbt(N), Int(N), N=Min,Nr)
IF (Nr-Min+1.EQ.1) READ (Iunit,99998) (Nbt(N), Int(N), N=Min,Nr)
99998 FORMAT (6I11)
-C
-C
+!
+!
Np3 = Np/3
Min = 1
Max = 3
@@ -772,21 +772,21 @@ C
IF (Np-Min+1.EQ.1) READ (Iunit,99983) (X(N), Y(N), N=Min,Np)
99983 FORMAT (6E11.4)
RETURN
- END
-C
-C
-C ______________________________________________________________
-C
+ END SUBROUTINE Rtab1
+!
+!
+! ______________________________________________________________
+!
SUBROUTINE Rlist (A, B, C, D, E, F, Mat, Mf, Mt, Ns)
IMPLICIT DOUBLE PRECISION (a-h,o-z)
READ (10,99999) A, B, C, D, E, F, Mat, Mf, Mt, Ns
99999 FORMAT (E11.4, F11.2, 4E11.4, I4, I2, I3, I5)
RETURN
- END
-C
-C
-C __________________________________________________________________________
-C
+ END SUBROUTINE Rlist
+!
+!
+! __________________________________________________________________________
+!
SUBROUTINE Findsp (Llll, Spinjj, Is)
use endfaa_common_m
use EndfData_common_m
@@ -796,12 +796,12 @@ C
type(SammySpinGroupInfo)::spinInfo
type(RMatSpinGroup)::spinGroup
DATA Small /0.01d0/, Ifneg /0/
-C
-C *** Purpose of routine is to find group number (Is) for given Llll and
-C *** Spinjj. [Note that Spinjj is the ENDF value Aj.]
-C *** November 1999 mod: IF Spinjj < 0 then specify use lower value of
-C *** channel spin
-C
+!
+! *** Purpose of routine is to find group number (Is) for given Llll and
+! *** Spinjj. [Note that Spinjj is the ENDF value Aj.]
+! *** November 1999 mod: IF Spinjj < 0 then specify use lower value of
+! *** channel spin
+!
Is = 0
DO I=1,resParData%getNumSpinGroups()
call resParData%getSpinGroupInfo(spinInfo, I)
@@ -832,37 +832,36 @@ C
WRITE (6,10000)
WRITE (21,10000)
STOP '[STOP in Findsp in mas/mmas6.f]'
-10000 FORMAT (' ### Quantum numbers in ENDF file 2 do not make sense! A
- *bort. ###')
+10000 FORMAT (' ### Quantum numbers in ENDF file 2 do not make sense! Abort. ###')
END IF
RETURN
- END
-C
-C
-C ------------------------------------------------------------------------
-C
+ END SUBROUTINE Findsp
+!
+!
+! ------------------------------------------------------------------------
+!
SUBROUTINE Fixjvl (aJ, Gamn, N)
-C
-C *** Purpose -- find "correct" value of aJ if J-value in endf/b
-C *** is not known (endf set J=I+L). Also correct Gamn
-C *** that is wanted.
-C
+!
+! *** Purpose -- find "correct" value of aJ if J-value in endf/b
+! *** is not known (endf set J=I+L). Also correct Gamn
+! *** that is wanted.
+!
use Junk_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
aJ1 = aJ
aJ = aJ1 + 0.5d0*(-1.0d0)**N
IF (Kprsrv.EQ.0) Gamn = (2*aJ1+1)/(2*aJ+1) * Gamn
-C
+!
RETURN
- END
-C
-C
-C ___________________________________________________________________________
-C
+ END SUBROUTINE Fixjvl
+!
+!
+! ___________________________________________________________________________
+!
SUBROUTINE Newin2
-C
-C *** purpose of routine is to write remainder of INPut file
-C
+!
+! *** purpose of routine is to write remainder of INPut file
+!
use ifwrit_m
use endfaa_common_m
use EndfData_common_m
@@ -873,16 +872,16 @@ C
type(SammySpinGroupInfo)::spinInfo
type(RMatSpinGroup)::spinGroup
DATA Zero /0.0d0/
-C
-C *** No longer need this line, as of July 2002
-C *** Ii = 1
-C *** WRITE (13,10000) Spi, Ii
-C ***10000 FORMAT (F10.1, 15X, I5)
-C
+!
+! *** No longer need this line, as of July 2002
+! *** Ii = 1
+! *** WRITE (13,10000) Spi, Ii
+! ***10000 FORMAT (F10.1, 15X, I5)
+!
IF (Ndfndf.EQ.1) CALL Zero_Integer (Lllndf, 110)
-C
+!
DO N=1,Ngroup
-C
+!
IF (Ndfndf.EQ.1) THEN
L = Lspin(1,N)
IF (L.GT.10) STOP '[Need more than 11 in Lllndf(10,11)]'
@@ -895,30 +894,29 @@ C
STOP '[Need more than 10 in Lllndf(10,11) mas/mmas6.f]'
10 CONTINUE
END IF
-C
+!
Ntot = Ntotc(N)
Nent = 1
Next = Ntot - Nent
call resParData%getSpinGroupInfo(spinInfo, N)
call resParData%getSpinGroup(spinGroup, spinInfo)
- WRITE (13,10100) N, Nent, Next,
- * spinGroup%getJ(),
- * spinInfo%getAbundance(), Spi
+ WRITE (13,10100) N, Nent, Next, &
+ spinGroup%getJ(), &
+ spinInfo%getAbundance(), Spi
10100 FORMAT (I3, 2x, 2I5, F5.1, F10.1, F5.1)
-C
+!
IF (Enbnd(1,N).NE.Zero .OR. Echan(1,N).NE.Zero) THEN
WRITE (6,10200) Enbnd(1,N), Echan(1,N)
10200 FORMAT ('Error -- Enbnd,Echan must be zero', 2F20.10)
STOP '[STOP in newin2 in mmas6.f]'
END IF
DO M=1,Ntot
- WRITE (13,10300) M, Lpent(M,N), Ishift(1,N), Lspin(1,N),
- * Chspin(1,N)
+ WRITE (13,10300) M, Lpent(M,N), Ishift(1,N), Lspin(1,N), Chspin(1,N)
10300 FORMAT (4I5, F10.1)
END DO
-C
+!
END DO
-C
+!
IF (Ndfndf.EQ.1) THEN
DO L=1,11
Nmax = 10
@@ -936,23 +934,23 @@ C
END DO
CLOSE (UNIT=93)
END IF
-C
+!
RETURN
- END
-C
-C
-C __________________________________________________________________________
-C
+ END SUBROUTINE Newin2
+!
+!
+! __________________________________________________________________________
+!
SUBROUTINE Wrtrad (Rade, Radt, Lkount)
use endfaa_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
DIMENSION Rade(*), Radt(*), Lkount(*), Kountx(20)
-C
-C *** purpose -- write radii at end of parameter file
-C
+!
+! *** purpose -- write radii at end of parameter file
+!
WRITE (38,10000)
10000 FORMAT (/, /, 'RADIUS PARAMETERS FOLLOW')
-C
+!
DO I=1,Nendfx
DO J=1,Ngroup
Kountx(J) = 0
@@ -965,26 +963,26 @@ C
END IF
END DO
IF (K.NE.0) THEN
-c&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
+!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
WRITE (38,10100) Rade(I), Radt(I), (Kountx(J),J=1,K)
-c&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
+!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
10100 FORMAT (2F10.7, ' 0 0', 20I2)
END IF
END DO
-C
+!
RETURN
- END
-C
-C
-C ____________________________________________________________________________
-C
+ END SUBROUTINE Wrtrad
+!
+!
+! ____________________________________________________________________________
+!
SUBROUTINE Read_Cov_Mpar (Mpar, Matnum)
-C *** Purpose -- Open and read ENDF covariance file to see how many
-C *** parameters per resonance are to be flagged
+! *** Purpose -- Open and read ENDF covariance file to see how many
+! *** parameters per resonance are to be flagged
use namfil_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
CHARACTER*1 A(66)
-C
+!
CALL Filopn (62, Fprcov, 0)
10 CONTINUE
READ (62,10100,END=20,ERR=20) A, Mat, Mf, Mt
@@ -992,12 +990,12 @@ C
IF (Matnum.NE.0 .AND. Matnum.NE.Mat) GO TO 10
IF (Mf.EQ.32 .AND. Mt.EQ.151) GO TO 30
GO TO 10
-C
+!
20 CONTINUE
WRITE (6,10200)
10200 FORMAT ('ENDF File 32 is not present in the "covariance file"')
STOP '[STOP in Read_Cov_Mpar in mmas6.f # 1]'
-C
+!
30 CONTINUE
READ (62,10100,END=20,ERR=20) A
READ (62,10300) Lru, Lrf
@@ -1017,4 +1015,7 @@ C
END IF
CLOSE (UNIT=62)
RETURN
- END
+ END SUBROUTINE Read_Cov_Mpar
+end module mmas6_m
+
+
diff --git a/sammy/src/odf/modf0.f b/sammy/src/odf/modf0.f90
similarity index 62%
rename from sammy/src/odf/modf0.f
rename to sammy/src/odf/modf0.f90
index d53be5d121feaf99938468a9f4ee55dd0579813e..907b8078b041b0426e4b4bc2b12a63bb5b8710fc 100644
--- a/sammy/src/odf/modf0.f
+++ b/sammy/src/odf/modf0.f90
@@ -1,11 +1,14 @@
-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
diff --git a/sammy/src/odf/modf1.f b/sammy/src/odf/modf1.f90
similarity index 73%
rename from sammy/src/odf/modf1.f
rename to sammy/src/odf/modf1.f90
index 1208b327436ddf827da8cd8561a8597422d9bfe7..be863bc8ed26bc6e96c3590e9de73c900647981c 100644
--- a/sammy/src/odf/modf1.f
+++ b/sammy/src/odf/modf1.f90
@@ -1,11 +1,14 @@
-C
-C
-C --------------------------------------------------------------
-C
+module modf1_m
+
+contains
+!
+!
+! --------------------------------------------------------------
+!
SUBROUTINE Chck18 (Ktzero)
-C
-C *** Purpose -- Read unit 18 (SAM18.DAT) to count Nregns
-C
+!
+! *** Purpose -- Read unit 18 (SAM18.DAT) to count Nregns
+!
use samxxx_common_m
use namfil_common_m
use aaaodf_common_m
@@ -13,12 +16,12 @@ C
IMPLICIT DOUBLE PRECISION (a-h,o-z)
COMMON /Dataaa/ Ksect, Kener, Kch, Mmdata, Ieordr, Iprcnt
DATA Zero /0.0d0/
-C
- READ (18,99999) Data_Type, C_Total, Th, Ndummy, Vmin, Ksodf,
- * Mmdata, Nangle, Ixxchn, Ktzero, Iprcnt
+!
+ READ (18,99999) Data_Type, C_Total, Th, Ndummy, Vmin, Ksodf, &
+ Mmdata, Nangle, Ixxchn, Ktzero, Iprcnt
99999 FORMAT (2A1, F15.5, I5, F15.5, 3I5, I10, 2I1)
Odfmul = Zero
-C
+!
Nregns = 0
Keveng = 0
60 CONTINUE
@@ -41,32 +44,29 @@ C
END IF
GO TO 60
END IF
-C
+!
70 CONTINUE
IF (Nregns.GT.Nregmx) GO TO 150
REWIND (18)
IF (Nregns.GT.1) THEN
-C
-C
-C Check if data overlap. If they do, exit. If they do not,
-C then Energy-order.
+!
+!
+! Check if data overlap. If they do, exit. If they do not,
+! then Energy-order.
DO I=2,Nregns
Im1 = I - 1
DO J=1,Im1
- IF ( Emin(J).LT.Emax(I) .AND.
- * Emax(J).GT.Emin(I) ) THEN
-C
-C *** Here Emin(J) < Emax(I) or Emax(J) > Emin(I) so
-C there is overlap. Ergo, decide if significant;
-C if so, then stop. If not, then reassign values.
+ IF ( Emin(J).LT.Emax(I) .AND. Emax(J).GT.Emin(I)) THEN
+!
+! *** Here Emin(J) < Emax(I) or Emax(J) > Emin(I) so
+! there is overlap. Ergo, decide if significant;
+! if so, then stop. If not, then reassign values.
IF (Emin(I).GE.Emin(J)) THEN
WRITE (6,10100) J, I, Emax(J), Emin(I)
-10100 FORMAT(' OVERLAP Emax(', I2, '), Emin(',
- * I2, ')=', 2F20.10)
+10100 FORMAT(' OVERLAP Emax(', I2, '), Emin(', I2, ')=', 2F20.10)
De = (Emax(J)-Emin(I))/2.0d0
Ee = (Emax(J)+Emin(I))/2.0d0
- IF (Ee/Ee.GT.1.0d-8)
- * STOP '[STOP in Chck18 in odf/modf1.f]'
+ IF (Ee/Ee.GT.1.0d-8) STOP '[STOP in Chck18 in odf/modf1.f]'
IF (Ee.EQ.0.0d0) De = 1.0d-8*Ee
Emin(I) = Ee + De
Emax(J) = Ee - De
@@ -74,8 +74,7 @@ C if so, then stop. If not, then reassign values.
WRITE (6,10100) I, J, Emax(I), Emin(J)
De = (Emax(I)-Emin(J))/2.0d0
Ee = (Emax(I)+Emin(J))/2.0d0
- IF (De/Ee.GT.1.0d-8)
- * STOP '[STOP in Chck18 of modf1.f # 2]'
+ IF (De/Ee.GT.1.0d-8) STOP '[STOP in Chck18 of modf1.f # 2]'
IF (De.EQ.0.0d0) De = 1.0d-8*Ee
Emin(J) = Ee + De
Emax(i) = Ee - De
@@ -83,8 +82,8 @@ C if so, then stop. If not, then reassign values.
END IF
END DO
END DO
-C
-C Energy-Order
+!
+! Energy-Order
DO I=2,Nregns
Iflip = 0
DO J=2,Nregns
@@ -105,7 +104,7 @@ C Energy-Order
IF (Iflip.EQ.0) GO TO 120
END DO
120 CONTINUE
-C
+!
WRITE (18,99996) Data_Type, C_Total, Th, Ndummy, Vmin, Ksodf
99996 FORMAT (2A1, F15.5, I5, F15.5, I5)
99995 FORMAT (3F20.10)
@@ -116,36 +115,39 @@ C
REWIND (18)
END IF
RETURN
-C
-C
+!
+!
150 CONTINUE
WRITE (21,99994) Nregns, Nregmx
WRITE ( 6,99994) Nregns, Nregmx
-99994 FORMAT (/, ' Need Nregns=', I6, ' +1 in samodf, but have only',
- * I6, ' so change in COMMON /Aaaaa/')
+99994 FORMAT (/, ' Need Nregns=', I6, ' +1 in samodf, but have only', &
+ I6, ' so change in COMMON /Aaaaa/')
STOP '[STOP in Chck18 in odf/modf1.f # 3]'
-C
+!
99998 FORMAT (A70)
99997 FORMAT (3F20.10)
- END
-C
-C
-C --------------------------------------------------------------
-C
- SUBROUTINE Read18 (Dum, Ndat, Nmax)
-C
-C *** Purpose -- Read info from Unit 18 (SAM18.DAT)
-C *** Also scan the data file
-C
+ END SUBROUTINE Chck18
+!
+!
+! --------------------------------------------------------------
+!
+ SUBROUTINE Read18 (Dum, Ndat, Nmax, reader)
+!
+! *** Purpose -- Read info from Unit 18 (SAM18.DAT)
+! *** Also scan the data file
+!
use over_common_m
use samxxx_common_m
use namfil_common_m
use aaaodf_common_m
use ffnnnn_common_m
+ use modf4_m
+ use EndfData_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
+ type(EndfData)::reader
COMMON /Dataaa/ Ksect, Kener, Kch, Mmdata, Ieordr, Iprcnt
DIMENSION Dum(*)
-C
+!
READ (18,99999) Data_Type, C_Total, Thick, N, Vmin
Ndat = 0
Kind = 1
@@ -157,7 +159,7 @@ C
Nsect = Nangle*2 + 1
ELSE
IF (Data_Type.EQ.Ttt) THEN
-C HERE DATA IS TOTAL CROSS SECTION (OR TRANSMISSION)
+! HERE DATA IS TOTAL CROSS SECTION (OR TRANSMISSION)
Nsect = 11
Kind = 2
IF (C_Total.EQ.Ttt) THEN
@@ -167,24 +169,21 @@ C HERE DATA IS TOTAL CROSS SECTION (OR TRANSMISSION)
END IF
END IF
END IF
-C
+!
DO Nregn=1,Nregns
READ (18,99998) Fnnnnn(Nregn)
READ (18,99997) Emin(Nregn), Emax(Nregn)
IF (Ksodf.EQ.0) THEN
CALL Filopn (13, Fnnnnn(Nregn), 0)
- CALL Chck13 (Emin(Nregn), Emax(Nregn),
- * Ndatr, Nsize)
+ CALL Chck13 (Emin(Nregn), Emax(Nregn), Ndatr, Nsize)
ELSE IF (Ksodf.EQ.1 .OR. Ksodf.EQ.2) THEN
- CALL Codf13 (Dum, Nregn, Emin(Nregn),
- * Emax(Nregn), Ndatr)
+ CALL Codf13 (Dum, Nregn, Emin(Nregn), Emax(Nregn), Ndatr)
ELSE IF (Ksodf.EQ.3) THEN
CALL Filopn (13, Fnnnnn(Nregn), 0)
CALL Cxxx13 (Emin(Nregn), Emax(Nregn), Ndatr, Nangle)
ELSE IF (Ksodf.LT.0) THEN
- CALL Filopn (13, Fnnnnn(Nregn), 0)
- CALL C13_Endf (Emin(Nregn), Emax(Nregn),
- * Ndatr, Nmax, Ksodf, Mmdata)
+ call reader%setFileName(trim(Fnnnnn(Nregn)))
+ CALL GetNumFile3Points (Emin(Nregn), Emax(Nregn), Ndatr, Nmax, Ksodf, Mmdata, reader)
ELSE
WRITE (6,10100)
10100 FORMAT ('Ksodf=', I3, ' which is not allowed.')
@@ -197,81 +196,80 @@ C
99999 FORMAT (2A1, F15.5, I5, F15.5, I5)
99998 FORMAT (A70)
99997 FORMAT (2F20.10)
- END
-C
-C
-C --------------------------------------------------------------
-C
- SUBROUTINE Fixodf (Energy, Data, Error, Dum, Ktzero, Nmax)
-C
-C *** Purpose -- Read data files and generate the plot files
-C
+ END SUBROUTINE Read18
+!
+!
+! --------------------------------------------------------------
+!
+ SUBROUTINE Fixodf (Energy, Data, Error, Dum, Ktzero, Nmax, reader)
+!
+! *** Purpose -- Read data files and generate the plot files
+!
use samxxx_common_m
use namfil_common_m
use aaaodf_common_m
use ffnnnn_common_m
+ use over_common_m
+ use EndfData_m
+ use modf4_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
DIMENSION Energy(*), Data(*), Error(*), Dum(*)
-C
+ type(EndfData)::reader
+!
Numodf = 71
Numodf = Numodf + 1
Nsntyp = Nsect
IF (Ktzero.NE.0) Nsntyp = Nsntyp + 2
Ndat = Ne
New = 1
- CALL Pltio (Numodf, 'SAMMY.ODF ', New, Nsntyp, Ndat,
- * Keveng)
-C *** initialize -- zero the plot file
+ CALL Pltio (Numodf, 'SAMMY.ODF ', New, Nsntyp, Ndat, Keveng)
+! *** initialize -- zero the plot file
nwhere = 1
CALL Pltzer (Numodf, Nsntyp, Nwhere, Ndat)
-C
+!
Nwhere = 1
DO Nregn=1,Nregns
IF (Ksodf.EQ.0) THEN
CALL Filopn (13, Fnnnnn(Nregn), 0)
- CALL Read13 (Energy, Data, Error, Emin(Nregn),
- * Emax(Nregn), Kmin, Kmax, Odfmul, Ndat)
+ CALL Read13 (Energy, Data, Error, Emin(Nregn), &
+ Emax(Nregn), Kmin, Kmax, Odfmul, Ndat)
ELSE IF (Ksodf.EQ.3) THEN
-C angle-differential data in ascii format
+! angle-differential data in ascii format
CALL Filopn (13, Fnnnnn(Nregn), 0)
- CALL Rxxx13 (Energy, Data, Error, Emin(Nregn),
- * Emax(Nregn), Kmin, Kmax, Ndat)
+ CALL Rxxx13 (Energy, Data, Error, Emin(Nregn), &
+ Emax(Nregn), Kmin, Kmax, Ndat)
ELSE IF (Ksodf.EQ.1 .OR. Ksodf.EQ.2) THEN
- CALL Rodf13 (Energy, Data, Error, Dum,
- * Ksodfn(Nregn), Ksodfx(Nregn),
- * Kmin, Kmax, Odfmul, Ndat)
+ CALL Rodf13 (Energy, Data, Error, Dum, &
+ Ksodfn(Nregn), Ksodfx(Nregn), &
+ Kmin, Kmax, Odfmul, Ndat)
ELSE IF (Ksodf.LT.0) THEN
- CALL R13_Endf (Energy, Data, Error, Emin(Nregn),
- * Emax(Nregn), Odfmul, Kmin, Kmax, Ndat,
- * Nmax)
+ CALL SetFromFile3Data (Energy, Data, Error, Emin(Nregn), &
+ Emax(Nregn), Odfmul, Kmin, Kmax, Ndat, ksodf, reader)
ELSE
WRITE (6,10100) Ksodf
10100 FORMAT ('Ksodf =', I3, ' which is not permitted')
STOP '[STOP in Fixodf in odf/modf1.f]'
END IF
-C *** Read13 (or Rodf13 or Rxxx13 or R13_Endf) reads data file
-C *** to get energy, data, and uncertainty
+! *** Read13 (or Rodf13 or Rxxx13 or SetFromFile3Data) reads data file
+! *** to get energy, data, and uncertainty
Ndatr = Kmax - Kmin + 1
-C
+!
Isn = 1
Iiin = 1
Eee = Energy(Kmin)
- CALL Pltout (Numodf, Nsntyp, Isn, Nwhere, Ndatr,
- * Energy(Kmin), Iiin)
-C
+ CALL Pltout (Numodf, Nsntyp, Isn, Nwhere, Ndatr, Energy(Kmin), Iiin)
+!
IF (Ksodf.NE.2 .AND. Ksodf.NE.3) THEN
- CALL Pltout (Numodf, Nsntyp, Kdata,
- * Nwhere, Ndatr, Data(Kmin), Iiin)
- CALL Pltout (Numodf, Nsntyp, Kerror,
- * Nwhere, Ndatr, Error(Kmin), Iiin)
-C
+ CALL Pltout (Numodf, Nsntyp, Kdata, Nwhere, Ndatr, Data(Kmin), Iiin)
+ CALL Pltout (Numodf, Nsntyp, Kerror, Nwhere, Ndatr, Error(Kmin), Iiin)
+!
Kkkkkk = Kind
-10200 FORMAT (
- * ' #########################################################',
- * /, ' # When data are transmission or total cross section, #',
- * /, ' # then thickness cannot be Zero. Use non-Zero value for #',
- * /, ' # thickness. See Card Set 7 of INPut file, Table VIA.1. #',
- * /, ' #########################################################')
+10200 FORMAT ( &
+ ' #########################################################', &
+ /, ' # When data are transmission or total cross section, #', &
+ /, ' # then thickness cannot be Zero. Use non-Zero value for #', &
+ /, ' # thickness. See Card Set 7 of INPut file, Table VIA.1. #', &
+ /, ' #########################################################')
IF (Kkkkkk.EQ.3) THEN
if (thick.eq.0.0d0) then
WRITE ( 6,10200)
@@ -279,36 +277,34 @@ C
stop
end if
-C *************** total cross section, when input is transmission
+! *************** total cross section, when input is transmission
DO I=Kmin,Kmax
A = Thick*Data(I)
IF (A.GT.0.0) Error(I) = Error(I)/A
IF (A.LE.0.0) Error(I) = 10.0D0/Thick
-C this is value used in SELAV
+! this is value used in SELAV
END DO
DO I=Kmin,Kmax
A = Data(I)
IF (A.GT.0.0) Data(I) = - dLOG(A)/Thick
IF (A.LE.0.0) Data(I) = 15.0/Thick
-C this is value used in SELAV
+! this is value used in SELAV
END DO
Isn = 2
- CALL Pltout (Numodf, Nsntyp, Isn, Nwhere, Ndatr,
- * Data(Kmin), Iiin)
+ CALL Pltout (Numodf, Nsntyp, Isn, Nwhere, Ndatr, Data(Kmin), Iiin)
Isn = 3
- CALL Pltout (Numodf, Nsntyp, Isn, Nwhere, Ndatr,
- * Error(Kmin), Iiin)
-C
-10210 FORMAT (
- * ' #########################################################',
- * /, ' # Warning: When converting input total cross section to #',
- * /, ' # transmission values, the thickness should not be Zero.#',
- * /, ' # Execution will continue, but the transmission related #',
- * /, ' # columns in the LST file will be meaningless. To set #',
- * /, ' # thickness, see Card Set 7 of INPut file, Table VIA.1. #',
- * /, ' #########################################################')
+ CALL Pltout (Numodf, Nsntyp, Isn, Nwhere, Ndatr, Error(Kmin), Iiin)
+!
+10210 FORMAT ( &
+ ' #########################################################', &
+ /, ' # Warning: When converting input total cross section to #', &
+ /, ' # transmission values, the thickness should not be Zero.#', &
+ /, ' # Execution will continue, but the transmission related #', &
+ /, ' # columns in the LST file will be meaningless. To set #', &
+ /, ' # thickness, see Card Set 7 of INPut file, Table VIA.1. #', &
+ /, ' #########################################################')
ELSE IF (Kkkkkk.NE.1) THEN
-C
+!
if (thick.eq.0.0d0) then
WRITE ( 6,10210)
WRITE (21,10210)
@@ -316,32 +312,30 @@ C
DO I=Kmin,Kmax
IF (Data(I).GT.0.0) Data(I) = dEXP(-Thick*Data(I))
-C ***************** changed the following IF statement from .LE. to .LT.
-C ***************** because for large values of Data(I) the value returned
-C ***************** by dEXP(-Thick*Data(I)) would become so small that
-C ***************** it could not be represented, becoming effectively equal to 0.0
+! ***************** changed the following IF statement from .LE. to .LT.
+! ***************** because for large values of Data(I) the value returned
+! ***************** by dEXP(-Thick*Data(I)) would become so small that
+! ***************** it could not be represented, becoming effectively equal to 0.0
IF (Data(I).LT.0.0) Data(I) = 1.0
END DO
Isn = 6
- CALL Pltout (Numodf, Nsntyp, Isn, Nwhere, Ndatr,
- * Data(Kmin), Iiin)
+ CALL Pltout (Numodf, Nsntyp, Isn, Nwhere, Ndatr, Data(Kmin), Iiin)
DO I=Kmin,Kmax
Error(I) = Thick*Data(I)*Error(I)
END DO
Isn = 7
- CALL Pltout (Numodf, Nsntyp, Isn, Nwhere, Ndatr,
- * Error(Kmin), Iiin)
+ CALL Pltout (Numodf, Nsntyp, Isn, Nwhere, Ndatr, Error(Kmin), Iiin)
END IF
END IF
-C
+!
Nwhere = Nwhere + Ndatr
END DO
-C
+!
CALL Plt_Close (Numodf)
-C
+!
IF (Ksodf.NE.3) RETURN
-C *** here write plot file SAMMY.DAT that holds experimental data for
-C *** differential elastic cross sections
+! *** here write plot file SAMMY.DAT that holds experimental data for
+! *** differential elastic cross sections
Nsntyp = Nangle*2 + 1
New = 1
CALL Pltio (Numodf, 'SAMMY.DAT ', New, Nsntyp, Ndat,Keveng)
@@ -359,20 +353,20 @@ C *** differential elastic cross sections
END DO
CALL Plt_Close (Numodf)
RETURN
-C
- END
-C
-C
-C --------------------------------------------------------------
-C
+!
+ END SUBROUTINE Fixodf
+!
+!
+! --------------------------------------------------------------
+!
SUBROUTINE Cxxx13 (Emin, Emax, Ndat, Nangle)
-C
-C *** Purpose -- Decide how many points (Ndat) are in this data set
-C *** for use with ASCII differential elastic data
-C
+!
+! *** Purpose -- Decide how many points (Ndat) are in this data set
+! *** for use with ASCII differential elastic data
+!
IMPLICIT DOUBLE PRECISION (a-h,o-z)
COMMON /Dataaa/ Ksect, Kener, Kch, Mmdata, Ieordr, Iprcnt
-C
+!
N = 0
nml=0
10 CONTINUE
@@ -381,18 +375,18 @@ C
READ (13,99999,END=30,ERR=30) X, (X,J=1,Nangle)
En1 = Aa
IF (Aa.GT.Emax .OR. Aa.LT.Emin) GO TO 10
-C
-C *** found first data point. Count it, and find next point.
+!
+! *** found first data point. Count it, and find next point.
N = N + 1
READ (13,99999,END=30,ERR=30) Aa, (X,J=1,Nangle)
READ (13,99999,END=30,ERR=30) X, (X,J=1,Nangle)
N = N + 1
En2 = Aa
Ieordr = 1
-C *** ie ordering is low-E to high-E
+! *** ie ordering is low-E to high-E
IF (En1.GT.En2) Ieordr = 2
-C *** ie high-E to low-E
-C
+! *** ie high-E to low-E
+!
20 CONTINUE
READ (13,99999,END=30,ERR=30) Aa, (X,J=1,Nangle)
READ (13,99999,END=30,ERR=30) X, (X,J=1,Nangle)
@@ -400,43 +394,42 @@ C
IF (Aa.LT.Emin .OR. Aa.GT.Emax) GO TO 30
N = N + 1
GO TO 20
-C
+!
30 CONTINUE
Ndat = N
CLOSE (UNIT=13)
RETURN
99999 FORMAT (8F10.1)
- END
-C
-C
-C --------------------------------------------------------------
-C
- SUBROUTINE Rxxx13 (Energy, Data, Error, Eemin, Eemax, Kmin,
- * Kmax, Ndat)
-C
-C *** Purpose -- Read data file for Energy, Data, and Errors
-C *** (angular distribution ASCII data)
-C
+ END SUBROUTINE Cxxx13
+!
+!
+! --------------------------------------------------------------
+!
+ SUBROUTINE Rxxx13 (Energy, Data, Error, Eemin, Eemax, Kmin, Kmax, Ndat)
+!
+! *** Purpose -- Read data file for Energy, Data, and Errors
+! *** (angular distribution ASCII data)
+!
use samxxx_common_m
use namfil_common_m
use aaaodf_common_m
use ffnnnn_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
DIMENSION Energy(*), Data(*), Error(*)
-C
+!
DIMENSION Aa(8), Bb(8)
COMMON /Dataaa/ Ksect, Kener, Kch, Mmdata, Ieordr, Iprcnt
-C
-C
+!
+!
Mx = Nangle + 1
IF (Mx.GT.8) Mx = 8
Kjm = Ndat*Nangle
NN = Nangle
IF (Nangle.GT.7) NN = 7
-C
-C
+!
+!
IF (Ieordr.NE.1) THEN
-C *** here when data set is ordered high-E to low-E
+! *** here when data set is ordered high-E to low-E
K = Ndat
10 CONTINUE
READ (13,99999,END=40,ERR=40) (Aa(J),J=1,Mx)
@@ -445,17 +438,17 @@ C *** here when data set is ordered high-E to low-E
READ (13,99999,END=40,ERR=40) (Bb(J),J=1,Mx)
IF (Nangle.GT.7) READ (13,99999) (X,J=8,Nangle)
GO TO 10
-C
+!
20 CONTINUE
-C *** found a data point, so process it
+! *** found a data point, so process it
Energy(K) = Aa(1)
Kj = K
DO 30 J=1,NN
Data(Kj) = Aa(J+1)
Kj = Kj + Ndat
30 CONTINUE
- IF (Nangle.GT.7) READ (13,99999,END=40,ERR=40)
- * (Data(J),J=Kj,Kjm,Ndat)
+ IF (Nangle.GT.7) READ (13,99999,END=40,ERR=40) &
+ (Data(J),J=Kj,Kjm,Ndat)
READ (13,99999,END=40,ERR=40) X, (Error(J),J=K,Kjm,Ndat)
Kj = K
DO J=1,Nangle
@@ -465,15 +458,15 @@ C *** found a data point, so process it
K = K - 1
READ (13,99999,END=40,ERR=40) (Aa(J),J=1,Mx)
IF (Aa(1).GE.Eemin .AND. Aa(1).LE.Eemax) GO TO 20
-C
+!
40 CONTINUE
-C *** done reading data
+! *** done reading data
K = Ndat*Nangle
-C
-C
+!
+!
ELSE
-C
-C *** Here when data set is ordered low-E to high-E
+!
+! *** Here when data set is ordered low-E to high-E
K = 0
60 CONTINUE
READ (13,99999,END=90,ERR=90) (Aa(J),J=1,Mx)
@@ -482,9 +475,9 @@ C *** Here when data set is ordered low-E to high-E
READ (13,99999,END=90,ERR=90) (Bb(J),J=1,Mx)
IF (Nangle.GT.7) READ (13,99999) (X,J=8,Nangle)
GO TO 60
-C
+!
70 CONTINUE
-C *** found a data point, so process it
+! *** found a data point, so process it
K = K + 1
Energy(K) = Aa(1)
Kj = K
@@ -494,8 +487,8 @@ C *** found a data point, so process it
Data(Kj) = Aa(J+1)
Kj = Kj + Ndat
END DO
- IF (Nangle.GT.7) READ (13,99999,END=90,ERR=90)
- * (Data(J),J=Kj,Kjm,Ndat)
+ IF (Nangle.GT.7) READ (13,99999,END=90,ERR=90) &
+ (Data(J),J=Kj,Kjm,Ndat)
READ (13,99999,END=90,ERR=90) X, (Error(J),J=K,Kjm,Ndat)
Kj = K
DO J=1,Nangle
@@ -504,16 +497,16 @@ C *** found a data point, so process it
END DO
READ (13,99999,END=90,ERR=90) (Aa(J),J=1,Mx)
IF (Aa(1).GT.Eemin .AND. Aa(1).LE.Eemax) GO TO 70
-C
+!
90 CONTINUE
-C
+!
END IF
-C
-C
+!
+!
Kmin = 1
Kmax = Ndat
-C
-C *** compare whether some energies are out of order
+!
+! *** compare whether some energies are out of order
Ksame = 0
DO K=2,Ndat
IF (Energy(K).LE.Energy(K-1)) THEN
@@ -521,41 +514,41 @@ C *** compare whether some energies are out of order
Esame = Energy(K)
END IF
END DO
-C
+!
IF (Ksame.NE.0) THEN
WRITE (6,99998) Ksame, Esame
-99998 FORMAT (' Check data file -- ', I5, ' energies are out of order.',
- * /, ' In particular look at Energy =', F20.10)
+99998 FORMAT (' Check data file -- ', I5, ' energies are out of order.', &
+ /, ' In particular look at Energy =', F20.10)
STOP '[STOP in Rxxx13 in odf/modf1.f]'
END IF
-C
+!
CLOSE (UNIT=13)
RETURN
-C
-C
+!
+!
99999 FORMAT (8F10.1)
- END
-C
-C
-C --------------------------------------------------------------
-C
+ END SUBROUTINE Rxxx13
+!
+!
+! --------------------------------------------------------------
+!
SUBROUTINE Chck13 (Emin, Emax, Ndat, Nsize)
-C
-C *** Purpose -- Decide how many points (Ndat) are in this data set
-C
+!
+! *** Purpose -- Decide how many points (Ndat) are in this data set
+!
IMPLICIT DOUBLE PRECISION (a-h,o-z)
DIMENSION Aa(3,3)
COMMON /Dataaa/ Ksect, Kener, Kch, Mmdata, Ieordr, Iprcnt
-C
+!
Nthree = 3
IF (Mmdata.EQ.1) Nthree = 1
IF (Mmdata.EQ.2) Nthree = 1
-C
+!
En1 = 0.0d0
In = 1
K = Nsize
10 CONTINUE
-C
+!
IF (Mmdata.EQ.0) THEN
READ (13,99999,END=60,ERR=60) Aa
99999 FORMAT (3(E15.8, E15.8, F7.5))
@@ -566,8 +559,8 @@ C
READ (13,29999,END=60,ERR=60) (Aa(I,1),i=1,2)
29999 FORMAT (3E20.1)
END IF
-C
-C
+!
+!
IF (In.EQ.1) THEN
DO I=1,Nthree
En1 = Aa(1,I)
@@ -578,72 +571,72 @@ C
END DO
GO TO 10
END IF
-C
-C
+!
+!
IF (In.EQ.2) THEN
En2 = Aa(1,1)
Ieordr = 1
-C *** ie ordering is low-E to high-E
+! *** ie ordering is low-E to high-E
IF (En1.GT.En2) Ieordr = 2
-C *** ie high-E to low-E
+! *** ie high-E to low-E
In = 3
END IF
-C
-C *** Here In is 3
+!
+! *** Here In is 3
DO I=1,Nthree
IF (Aa(1,I).EQ.0.0D0) GO TO 60
IF (Aa(1,I).LT.Emin .OR. Aa(1,I).GT.Emax) GO TO 60
K = K - 1
END DO
GO TO 10
-C
+!
60 CONTINUE
Kmin = K + 1
Ndat = Nsize - Kmin + 1
CLOSE (UNIT=13)
RETURN
-C
- END
-C
-C
-C --------------------------------------------------------------
-C
- SUBROUTINE Read13 (Energy, Data, Error, Eemin, Eemax, Kmin,
- * Kmax, Oodfmu, Ndat)
-C
-C *** Purpose -- Read data file for Energy, Data, and Errors
-C
+!
+ END SUBROUTINE Chck13
+!
+!
+! --------------------------------------------------------------
+!
+ SUBROUTINE Read13 (Energy, Data, Error, Eemin, Eemax, Kmin, &
+ Kmax, Oodfmu, Ndat)
+!
+! *** Purpose -- Read data file for Energy, Data, and Errors
+!
use samxxx_common_m
use namfil_common_m
use aaaodf_common_m
use ffnnnn_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
DIMENSION Energy(*), Data(*), Error(*)
-C
+!
DIMENSION Aa(3,3)
COMMON /Dataaa/ Ksect, Kener, Kch, Mmdata, Ieordr, Iprcnt
-C
+!
IF (Oodfmu.EQ.0.0d0) STOP '[STOP in Read13 in modf1.f]'
-C
+!
IF (Mmdata.EQ.1 .OR. Mmdata.EQ.2) THEN
- CALL Rd13mm (Energy, Data, Error, Eemin, Eemax, Kmin, Kmax,
- * Oodfmu, Ndat)
+ CALL Rd13mm (Energy, Data, Error, Eemin, Eemax, Kmin, Kmax, &
+ Oodfmu, Ndat)
RETURN
END IF
-C
+!
Nthree = 3
-C
-C
+!
+!
IF (Ieordr.NE.1) THEN
-C *** Here when data set is ordered high-E to low-E
+! *** Here when data set is ordered high-E to low-E
In = 1
K = Ndat
10 CONTINUE
READ (13,99999,END=60,ERR=60) Aa
IF (In.EQ.2) GO TO 40
-C
+!
20 CONTINUE
-C *** Here for In not equal to 2
+! *** Here for In not equal to 2
DO I=1,Nthree
IF (Aa(1,I).LE.Eemax) THEN
In = 2
@@ -655,7 +648,7 @@ C *** Here for In not equal to 2
END IF
END DO
GO TO 10
-C
+!
40 CONTINUE
DO I=1,Nthree
IF (Aa(1,I).EQ.0.0d0) GO TO 60
@@ -667,20 +660,20 @@ C
K = K - 1
END DO
GO TO 10
-C
+!
60 CONTINUE
IF (K.LT.0) GO TO 170
Kmin = K + 1
Kmax = Ndat
-C
-C
+!
+!
ELSE
-C *** Here when data set is ordered low-E to high-E
+! *** Here when data set is ordered low-E to high-E
In = 1
K = 1
80 CONTINUE
READ (13,99999,END=130,ERR=130) Aa
-C
+!
IF (In.NE.2) THEN
90 CONTINUE
DO I=1,Nthree
@@ -696,7 +689,7 @@ C
GO TO 80
ELSE
110 CONTINUE
-C *** Here for IN = 2
+! *** Here for IN = 2
DO I=1,Nthree
IF (Aa(1,I).EQ.0.) GO TO 130
IF (Aa(1,I).GT.Eemax) GO TO 130
@@ -711,10 +704,10 @@ C *** Here for IN = 2
130 CONTINUE
Kmax = K - 1
Kmin = 1
-C
+!
END IF
-C
-C *** compare whether some energies are same -- compare only 5 neighbors...
+!
+! *** compare whether some energies are same -- compare only 5 neighbors...
140 Ksame = 0
IF (Kmin+5.GT.Kmax) RETURN
DO K=Kmin+5,Kmax
@@ -723,52 +716,52 @@ C *** compare whether some energies are same -- compare only 5 neighbors...
IF (Energy(K).EQ.Energy(J)) Esame = Energy(J)
END DO
END DO
-C
+!
IF (Ksame.NE.0) THEN
WRITE (6,99998) Esame
WRITE (21,99998) Esame
-99998 FORMAT (/, ' ### Check your DATa file -- Some energies (',
- * 1PE14.6, ') occur more than one time.')
+99998 FORMAT (/, ' ### Check your DATa file -- Some energies (', &
+ 1PE14.6, ') occur more than one time.')
STOP '[STOP in Read13 in modf1.f # 2]'
END IF
-C
+!
CLOSE (UNIT=13)
RETURN
-C
+!
170 CONTINUE
Ksize = Ndat - K
WRITE (6, 99997) Ndat, Ksize
99997 FORMAT (/' *** array size changes from ', I9, ' to ', I9, ' ***')
STOP '[STOP in Read13 in modf1.f # 3]'
-C
+!
99999 FORMAT (3(E15.8, E15.8, F7.5))
- END
-C
-C
-C --------------------------------------------------------------
-C
- SUBROUTINE Rd13mm (Energy, Data, Error, Eemin, Eemax, Kmin,
- * Kmax, Oodfmu, Ndat)
-C
-C *** Purpose -- Read data file for Energy, Data, and Errors
-C *** Style -- CSISRS or TWENTY Data, one point (three numbers) per line
-C
+ END SUBROUTINE Read13
+!
+!
+! --------------------------------------------------------------
+!
+ SUBROUTINE Rd13mm (Energy, Data, Error, Eemin, Eemax, Kmin, &
+ Kmax, Oodfmu, Ndat)
+!
+! *** Purpose -- Read data file for Energy, Data, and Errors
+! *** Style -- CSISRS or TWENTY Data, one point (three numbers) per line
+!
use samxxx_common_m
use namfil_common_m
use aaaodf_common_m
use ffnnnn_common_m
IMPLICIT DOUBLE PRECISION (a-h,o-z)
DIMENSION Energy(*), Data(*), Error(*)
-C
+!
DIMENSION Aa(3,1)
COMMON /Dataaa/ Ksect, Kener, Kch, Mmdata, Ieordr, Iprcnt
-C
+!
IF (Oodfmu.EQ.0.0) STOP '[STOP in Rd13mm in modf1.f]'
Nthree = 1
-C
-C
+!
+!
IF (Ieordr.NE.1) THEN
-C *** Here when data set is ordered high-E to low-E
+! *** Here when data set is ordered high-E to low-E
In = 1
K = Ndat
10 CONTINUE
@@ -788,7 +781,7 @@ C *** Here when data set is ordered high-E to low-E
END DO
GO TO 10
ELSE
-C *** Here for IN=2
+! *** Here for IN=2
DO I=1,Nthree
IF (Aa(1,I).EQ.0.) GO TO 60
IF (Aa(1,I).LT.Eemin) GO TO 60
@@ -804,12 +797,12 @@ C *** Here for IN=2
60 CONTINUE
Kmin = K + 1
Kmax = Ndat
-C
-C
+!
+!
ELSE
-C
-C
-C *** Here when data set is ordered low-E to high-E
+!
+!
+! *** Here when data set is ordered low-E to high-E
IN = 1
K = 1
80 CONTINUE
@@ -846,8 +839,8 @@ C *** Here when data set is ordered low-E to high-E
Kmax = K - 1
Kmin = 1
END IF
-C
-C *** compare whether some energies are same -- compare only 5 neighbors...
+!
+! *** compare whether some energies are same -- compare only 5 neighbors...
Ksame = 0
IF (Kmin+5.GT.Kmax) THEN
DO K=Kmin+5,Kmax
@@ -858,18 +851,20 @@ C *** compare whether some energies are same -- compare only 5 neighbors...
END IF
END DO
END DO
-C
+!
IF (Ksame.NE.0) THEN
WRITE (6,99998) Esame
-99998 FORMAT (/, ' ### Check your DATa file -- Some energies (',
- * 1PE14.6, ') occur more than one time.')
+99998 FORMAT (/, ' ### Check your DATa file -- Some energies (', &
+ 1PE14.6, ') occur more than one time.')
STOP '[STOP in Rd13mm in modf1.f # 2]'
END IF
END IF
-C
+!
CLOSE (UNIT=13)
RETURN
-C
+!
99999 FORMAT (3E11.7)
29999 FORMAT (3E20.7)
- END
+ END SUBROUTINE Rd13mm
+
+end module modf1_m
diff --git a/sammy/src/odf/modf4.f b/sammy/src/odf/modf4.f
deleted file mode 100755
index 475e0250d25ad44a35cac0cb91330501937e438e..0000000000000000000000000000000000000000
--- a/sammy/src/odf/modf4.f
+++ /dev/null
@@ -1,110 +0,0 @@
-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
diff --git a/sammy/src/odf/modf4.f90 b/sammy/src/odf/modf4.f90
new file mode 100755
index 0000000000000000000000000000000000000000..b6af1a9023210122ef9c2734d7593885be38710f
--- /dev/null
+++ b/sammy/src/odf/modf4.f90
@@ -0,0 +1,112 @@
+module modf4_m
+implicit none
+
+contains
+ !!
+ !! Read File 3 data. It is assumed
+ !! that the file name is already set and reaction is the the positve value of
+ !! Ksodf.
+ !!
+ !! The purpose of the routine is to cound the number of energy points in the
+ !! desired Tab1 record that are between Emin and Emax.
+ !!
+ !! @param Emin the lower energy of the desired energy range
+ !! @param Emax the upper energy of the desired energy range
+ !! @param Ndat on output the number of points between Emin and Emax
+ !! @param Nmax on output the total number of points
+ !! @param Ksodf the negative value of the reaction
+ !! @param Matdat the desired material
+ !! @param reader the object used to read the ENDF data
+ !!
+ SUBROUTINE GetNumFile3Points (Emin, Emax, Ndat, Nmax, Ksodf, Matdat, reader)
+ use EndfData_m
+ use Tab1_M
+ use, intrinsic :: ISO_C_BINDING
+ IMPLICIT DOUBLE PRECISION (a-h,o-z)
+ type(EndfData)::reader
+ type(Tab1)::tab1Data
+ real(C_DOUBLE)::x(1),y(1)
+ real(kind=8)::Emin, Emax
+ integer::Ndat, Nmax, Ksodf, Matdat, mt
+ integer::Kountr,I
+
+!
+! *** Find location in ENDF file
+ Mt = -Ksodf
+ call reader%setMat(Matdat)
+ call reader%getTab1ByMt(tab1Data, Mt)
+ if (.not.C_ASSOCIATED(tab1Data%instance_ptr)) then
+ STOP 'Reaction not found in File 3 in endf file in GetNumFile3Points'
+ end if
+!
+! *** Read energies
+ Kountr = 0
+ Nmax = tab1Data%getPoints()
+ DO I=1,Nmax
+ call tab1Data%getValue(I, x, y)
+ IF (x(1).GE.Emin .AND. x(1).LE.Emax) Kountr = Kountr + 1
+ END DO
+ ndat = Kountr
+ END SUBROUTINE GetNumFile3Points
+
+ !!
+ !!
+ !! Read File 3 data. It is assumed that GetNumFile3Points 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 negative value of Ksodf
+ !!
+ !! Energy points between Emin and Emax are read into Energy.
+ !! Data points between Emin and Emax are read into Data, Error is calculated
+ !! as 0.01 * Data.
+ !!
+ !! @param Energy energy grid for points between Emin and Emax
+ !! @param Data data points for points between Emin and Emax
+ !! @param Vardat uncertainty on the data
+ !! @param Oodfmu factor with which to multiply energy (after check for range)
+ !! @param Kmin set to 1
+ !! @param Kmax number of points storead in Energy
+ !! @param Ndat same as Kmax
+ !! @param Ksodf the negative value of the reaction
+ !! @param reader the object used to read the ENDF data
+ !!
+ SUBROUTINE SetFromFile3Data (Energy, Data, Error, Emin, Emax, Oodfmu, &
+ Kmin, Kmax, Ndat, Ksodf, reader)
+ use EndfData_m
+ use Tab1_M
+ use, intrinsic :: ISO_C_BINDING
+ IMPLICIT DOUBLE PRECISION (a-h,o-z)
+ type(EndfData)::reader
+ real(kind=8)::Energy(*), Data(*), Error(*)
+ real(kind=8)::Emin, Emax, Oodfmu
+ integer::Kmin, Kmax, Ndat, mt
+ type(Tab1)::tab1Data
+ real(C_DOUBLE)::x(1),y(1)
+ real(kind=8)::Zero, Small, Tenth
+ integer::I,K2, ksodf
+ DATA Zero /0.0d0/, Small /0.001d0/, Tenth /0.10d0/
+!
+ Mt = -Ksodf
+ call reader%getTab1ByMt(tab1Data, Mt)
+ if (.not.C_ASSOCIATED(tab1Data%instance_ptr)) then
+ STOP 'Reaction not found in File 3 in endf file in SetFromFile3Data'
+ end if
+
+ K2 = 0
+ DO I=1,tab1Data%getPoints()
+ call tab1Data%getValue(I, x, y)
+ IF (x(1).GE.Emin .AND. x(1).LE.Emax) THEN
+ K2 = K2 + 1
+ Energy(K2) = x(1)*Oodfmu
+ Data(K2) = y(1)
+ Error(K2) = y(1)*Tenth
+ IF (y(1).EQ.Zero) Error(K2) = Small
+ END IF
+ END DO
+ 10 CONTINUE
+ Ndat = K2
+ Kmin = 1
+ Kmax = Ndat
+ RETURN
+ END SUBROUTINE SetFromFile3Data
+
+ end module modf4_m
\ No newline at end of file
diff --git a/sammy/src/ref/mcon.F b/sammy/src/ref/mcon.F
index 995844faf68f00d394909bb0e4c9e56dbad6e4ef..2708283934e6627d0a1d8334fad5f5881170646a 100644
--- a/sammy/src/ref/mcon.F
+++ b/sammy/src/ref/mcon.F
@@ -18,6 +18,7 @@ C These are here to replace the common block
use mssccc_common_m
use zzzzz_common_m
use EndfData_common_m
+ use Samdat_0_M
C this is not a common block, this contains functions
use mold4_m
IMPLICIT DOUBLE PRECISION (A-h,o-z)
diff --git a/sammy/src/sam/msam.F b/sammy/src/sam/msam.F
index 6f002252fba53f981600e7f580d9dc2764fc824e..602134bd4721930bc2018ab44aeeb35dda212ecf 100755
--- a/sammy/src/sam/msam.F
+++ b/sammy/src/sam/msam.F
@@ -17,6 +17,12 @@ C
use MultScatPars_common_m
use ExpPars_common_m
use ssm_m
+ use Samdat_0_M
+ use Samodf_0_m
+ use Sammas_0_m
+ use mmas3_m
+ use mmas1_m
+ use mmas6_m
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C This is the main routine for the SAMMY program
diff --git a/sammy/src/sammy/CMakeLists.txt b/sammy/src/sammy/CMakeLists.txt
index 503470e7553c6f593e3bf1dcf45dea544e777781..8eae11683ba0c47d0e0dbdccbeddd82a79f23f83 100644
--- a/sammy/src/sammy/CMakeLists.txt
+++ b/sammy/src/sammy/CMakeLists.txt
@@ -72,9 +72,9 @@ APPEND_SET(SAMMY_SOURCES
../cro/mnrm1.f
../cro/mnrm2.f
- ../dat/mdat0.f
+ ../dat/mdat0.f90
../dat/mdat1.f
- ../dat/mdat2.f
+ ../dat/mdat2.f90
../dat/mdat3.f
../dat/mdat4.f
../dat/mdat5.f
@@ -83,7 +83,7 @@ APPEND_SET(SAMMY_SOURCES
../dat/mdat8.f
../dat/mdat9.f
../dat/mdata.f
- ../dat/mdatb.f
+ ../dat/mdatb.f90
../dbd/mdbd0.f
../dbd/mdbd1.f
@@ -218,13 +218,13 @@ APPEND_SET(SAMMY_SOURCES
../lru/mlru2.f
../lru/mlru3.f
- ../mas/mmas0.f
- ../mas/mmas1.f
+ ../mas/mmas0.f90
+ ../mas/mmas1.f90
../mas/mmas2.f
- ../mas/mmas3.f
+ ../mas/mmas3.f90
../mas/mmas4.f
../mas/mmas5.f
- ../mas/mmas6.f
+ ../mas/mmas6.f90
../mas/mmas7.f
../mas/mmas9.f
../mas/mmasa.f
@@ -320,11 +320,11 @@ APPEND_SET(SAMMY_SOURCES
../ntg/mntg9.f
../ntg/mntga.f
- ../odf/modf0.f
- ../odf/modf1.f
+ ../odf/modf0.f90
+ ../odf/modf1.f90
../odf/modf2.f
../odf/modf3.f
- ../odf/modf4.f
+ ../odf/modf4.f90
../odf/modfio.F
../old/mold0.f