From 38fcfcb9803ebeea520f00dcd5737beacf5127fe Mon Sep 17 00:00:00 2001
From: Wiarda <wiardada@ornl.gov>
Date: Thu, 4 Jun 2020 10:54:43 -0400
Subject: [PATCH] Move code into a different file so that the compile warning
goes away (the offending code is now in a different compile unit). Also
ensure that data are nt copied if not needed in mnpv9, in case this gets
optimized to a memcopy and then fails.
---
sammy/src/int/mint0.f | 233 ---------------------------------
sammy/src/int/mint0a.f | 233 +++++++++++++++++++++++++++++++++
sammy/src/npv/mnpv9.f | 13 +-
sammy/src/sammy/CMakeLists.txt | 1 +
4 files changed, 241 insertions(+), 239 deletions(-)
create mode 100644 sammy/src/int/mint0a.f
diff --git a/sammy/src/int/mint0.f b/sammy/src/int/mint0.f
index e02ccf716..70df30c96 100644
--- a/sammy/src/int/mint0.f
+++ b/sammy/src/int/mint0.f
@@ -121,236 +121,3 @@ C
C
RETURN
END
-C
-C
-C --------------------------------------------------------------
-C
- SUBROUTINE Intermediate (A, Iv, I_Iiuif)
- use oops_common_m
- use fixedi_m
- use ifwrit_m
- use exploc_common_m
- use samxxx_common_m
- use array_sizes_common_m
- use oopsch_common_m
- use abro_common_m
- use cbro_common_m
- use lbro_common_m
- use hhhhhh_common_m
- use EndfData_common_m
- use mint2_m
- use AllocateFunctions_m
- use SammyGridAccess_M
- IMPLICIT DOUBLE PRECISION (a-h,o-z)
- type(SammyGridAccess)::gridAccess
- integer,allocatable,dimension(:)::I_Jjjder, I_Jjjpar
- type(GridData)::grid
- DIMENSION A(-Msize:Msize), I_Iiuif(*)
-C
-C *** Here there is broadening (or something!) to take care of yet, so
-C *** prepare to write what we have at this stage
-C - - - - - - - - - - - - - >
- if ( expData%getLength().ge.2) then
- call expData%getGrid(grid, 2)
- else
- call expData%getGrid(grid, 1)
- end if
- call grid%setRowOffset(Ndatmn-1)
-
- call gridAccess%initialize()
- call gridAccess%setParameters(numcro, ktzero)
- call gridAccess%setToAuxGrid(expData)
-C
-C *** Read the cross sections etc
- Jgbmax = 0
- Kkkdat = 0
- CALL Read_Cross_Sections (Jgbmax, Kkkdat)
-C
- IF (Debug) THEN
-C *** Write the cross sections and partial derivatives into LPT file
-C
- IF (Jwwwww.GT.9 .OR. Jwwwww.LT.1)
- * STOP '[STOP in Intermediate in int/mint0.f]'
- IF (Jwwwww.EQ.5 .OR. Jwwwww.EQ.6) THEN
- Kwwwww = Jwwwww - 4
- ELSE
- Kwwwww = Jwwwww
- END IF
-C
- call grid%setRowOffset(Kmsave)
- CALL Outthr (Kwwwww, I_Ixciso , gridAccess, A(Iwsigx), Nnnsig,
- * Niniso, Jgbmax)
- IF (Kpart.NE.0 .AND. Ksolve.NE.2) THEN
- IF (Ndasig.GT.0) THEN
- Nanb = Nnnsig*Ndasig
- call allocate_integer_data(I_Jjjder, Nanb)
- call allocate_integer_data(I_Jjjpar, Nanb)
- CALL Out_Deriv (I_Ixciso , A(Iwdasi), gridAccess,I_Iiuif,
- * I_Jjjder , I_Jjjpar, Nnnsig, Ndasig, Nanb, 1, Jgbmax,
- * 0)
- END IF
- IF (Ndbsig.GT.0) THEN
- Nanb = Nnnsig*Ndbsig
- call allocate_integer_data(I_Jjjder, Nanb)
- call allocate_integer_data(I_Jjjpar, Nanb)
- CALL Out_Deriv (I_Ixciso , A_Iwdbsi , gridAccess,I_Iiuif,
- * I_Jjjder, I_Jjjpar, Nnnsig, Ndbsig, Nanb, Niniso,
- * Jgbmax, 1)
- END IF
- END IF
- IF (Jwwwww.EQ.5 .OR. Jwwwww.EQ.6) THEN
- CALL Outthr (Kwwwww, I_Ixciso , gridAccess, A(Iwsigs), 1,
- * Kiniso, Jgbmax)
- IF (Ksolve.NE.2 .AND. Kpart.NE.0) THEN
- IF (Ndasig.GT.0) THEN
- Nanb = Ndasig
- call allocate_integer_data(I_Jjjder, Nanb)
- call allocate_integer_data(I_Jjjpar, Nanb)
- CALL Out_Deriv (I_Ixciso , A_Iwdass , gridAccess,
- * I_Iiuif,
- * I_Jjjder, I_Jjjpar, 1, Ndasig, Nanb, 1, Jgbmax,0)
- END IF
- IF (Ndbsig.GT.0) THEN
- Nanb = Ndbsig
- call allocate_integer_data(I_Jjjder, Nanb)
- call allocate_integer_data(I_Jjjpar, Nanb)
- CALL Out_Deriv (I_Ixciso , A_Iwdbss , gridAccess,
- * I_Iiuif,
- * I_Jjjder, I_Jjjpar, 1, Ndbsig, Nanb, Kiniso,
- * Jgbmax, 1)
- END IF
- END IF
- END IF
- END IF
- if (allocated(I_Jjjder)) deallocate(I_Jjjder)
- if (allocated(I_Jjjpar)) deallocate(I_Jjjpar)
- call grid%setRowOffset(0)
- call gridAccess%destroy()
-C - - - - - - - - - - - - - >
-C
-C *** four ***
-C - - - - - - - - - - - - - <
- IF (Kplotu.NE.0) THEN
- Idum = Idimen (Ndatb, 1, 'Ndatb, 1')
- CALL Plotun (A(Iwsigx), A(Idum), Ndatb,
- * Nnnsig*Niniso, Kplotu)
- I = Idimen (Idum, -1, 'Idum, -1')
- END IF
-C - - - - - - - - - - - - - >
- CALL Run (Segnam)
-C *** end here if there's more broadening etc to do yet
- RETURN
- END
-C
-C
-C --------------------------------------------------------------
-C
- SUBROUTINE Finished (A, Nblmax, I_Iiuif)
-C
-C *** Here there is no (more) broadening, so results are ready to write
-C *** directly
-C
- use oops_common_m
- use fixedi_m
- use ifwrit_m
- use exploc_common_m
- use samxxx_common_m
- use array_sizes_common_m
- use oopsch_common_m
- use abro_common_m
- use cbro_common_m
- use lbro_common_m
- use hhhhhh_common_m
- use mint2_m
- use AllocateFunctions_m
- use EndfData_common_m
- use SammyGridAccess_M
- IMPLICIT DOUBLE PRECISION (a-h,o-z)
- integer,allocatable,dimension(:)::I_Jjjder, I_Jjjpar
- type(SammyGridAccess)::gridAccess
- DIMENSION A(-Msize:Msize), I_Iiuif(*)
-C
- Nnn= Ndat
- N = Ndat
- call gridAccess%initialize()
- call gridAccess%setParameters(numcro, ktzero)
- call gridAccess%setToExpGrid(expData)
-C
-c
-c *********************************
- Ith = Iwsigx
-c *** why is this needed here now?
-c *********************************
- IF (Ktheor.NE.0) CALL Outthr (7, I_Ixciso , gridAccess, A(Ith),
- * Nnnsig, 1, Nnn)
-C
- IF (Kpart.NE.0 .AND. (Ksolve.NE.2 .OR. Kgenpd.NE.0)) THEN
- IF (Ndasig.GT.0) THEN
- Nanb = Nnnsig*Ndasig
- call allocate_integer_data(I_Jjjder, Nanb)
- call allocate_integer_data(I_Jjjpar, Nanb)
- CALL Out_Deriv (I_Ixciso , A(Iwdasi), gridAccess, I_Iiuif,
- * I_Jjjder, I_Jjjpar, Nnnsig, Ndasig, Nanb, 1, Ndat, 0)
- END IF
- IF (Ndbsig.GT.0) THEN
- Nanb = Nnnsig*Ndbsig
- call allocate_integer_data(I_Jjjder, Nanb)
- call allocate_integer_data(I_Jjjpar, Nanb)
- CALL Out_Deriv (I_Ixciso , A_Iwdbsi , gridAccess, I_Iiuif,
- * I_Jjjder, I_Jjjpar, Nnnsig, Ndbsig, Nanb, 1, Ndat, 1)
- END IF
- END IF
- if (allocated(I_Jjjder)) deallocate(I_Jjjder)
- if (allocated(I_Jjjpar)) deallocate(I_Jjjpar)
-C
-C *** Complete the plot file
-C *** Here do final touches to put properly broadened theoretical
-C *** cross sections into proper files, etc
-C
- Id = Iwsigx
- IF (Kascii.EQ.1) CALL Wascii (A(Id), Ndat)
-C
- IF (Kgenpd.EQ.1) THEN
-C *** seven ***
-C - - - - - - - - - - - - - <
- Idd = Idimen (Ndat, 1, 'Ndat, 1')
- Ide = Idimen (Nfpall, 1, 'Nfpall, 1')
- Ivarda = Idimen (Ndat, 1, 'Ndat, 1')
- CALL Pdwrit (A(Idd), A(Ivarda), A(Iwdasi), A(Ide), I_Iiuif)
- I = Idimen (Idd, -1, 'Idd, -1')
-C - - - - - - - - - - - - - >
- CALL RUN ('samnpv')
-C
- ELSE
- IF (Kodf.NE.0) THEN
-C
- IF (Iterat.EQ.0) THEN
-C *** six ***
- N = (Ndat+1)
-C - - - - - - - - - - - - - - - - - - - - - - - - - <
- Idum = Idimen (N, 1, 'N, 1')
- N = (Nblmax+1)
- Iblock = Idimen (n, 1, 'n, 1')
- CALL Thodf (A(Id), A(Idum),
- * A(Iblock), Nblmax)
-C *** Routine Thodf writes the ORELA-Data-Formt file to be
-C *** used for plotting
- I = Idimen (Idum, -1, 'Idum, -1')
-C - - - - - - - - - - - - - - - - - - - - - - - - - >
- END IF
- END IF
-C
- IF (Kartgd.EQ.1) THEN
- CALL Run ('samend')
- ELSE IF (Kywywy.EQ.1) THEN
- CALL Run ('samywy')
- ELSE IF (Kwywyw.EQ.1) THEN
- CALL Run ('samwyw')
- ELSE
- CALL Run ('samsqu')
- END IF
-C
- END IF
- call gridAccess%destroy()
- RETURN
- END
diff --git a/sammy/src/int/mint0a.f b/sammy/src/int/mint0a.f
new file mode 100644
index 000000000..bab1aeaa3
--- /dev/null
+++ b/sammy/src/int/mint0a.f
@@ -0,0 +1,233 @@
+C
+C
+C --------------------------------------------------------------
+C
+ SUBROUTINE Intermediate (A, Iv, I_Iiuif)
+ use oops_common_m
+ use fixedi_m
+ use ifwrit_m
+ use exploc_common_m
+ use samxxx_common_m
+ use array_sizes_common_m
+ use oopsch_common_m
+ use abro_common_m
+ use cbro_common_m
+ use lbro_common_m
+ use hhhhhh_common_m
+ use EndfData_common_m
+ use mint2_m
+ use AllocateFunctions_m
+ use SammyGridAccess_M
+ IMPLICIT DOUBLE PRECISION (a-h,o-z)
+ type(SammyGridAccess)::gridAccess
+ integer,allocatable,dimension(:)::I_Jjjder, I_Jjjpar
+ type(GridData)::grid
+ DIMENSION A(-Msize:Msize), I_Iiuif(*)
+C
+C *** Here there is broadening (or something!) to take care of yet, so
+C *** prepare to write what we have at this stage
+C - - - - - - - - - - - - - >
+ if ( expData%getLength().ge.2) then
+ call expData%getGrid(grid, 2)
+ else
+ call expData%getGrid(grid, 1)
+ end if
+ call grid%setRowOffset(Ndatmn-1)
+
+ call gridAccess%initialize()
+ call gridAccess%setParameters(numcro, ktzero)
+ call gridAccess%setToAuxGrid(expData)
+C
+C *** Read the cross sections etc
+ Jgbmax = 0
+ Kkkdat = 0
+ CALL Read_Cross_Sections (Jgbmax, Kkkdat)
+C
+ IF (Debug) THEN
+C *** Write the cross sections and partial derivatives into LPT file
+C
+ IF (Jwwwww.GT.9 .OR. Jwwwww.LT.1)
+ * STOP '[STOP in Intermediate in int/mint0.f]'
+ IF (Jwwwww.EQ.5 .OR. Jwwwww.EQ.6) THEN
+ Kwwwww = Jwwwww - 4
+ ELSE
+ Kwwwww = Jwwwww
+ END IF
+C
+ call grid%setRowOffset(Kmsave)
+ CALL Outthr (Kwwwww, I_Ixciso , gridAccess, A(Iwsigx), Nnnsig,
+ * Niniso, Jgbmax)
+ IF (Kpart.NE.0 .AND. Ksolve.NE.2) THEN
+ IF (Ndasig.GT.0) THEN
+ Nanb = Nnnsig*Ndasig
+ call allocate_integer_data(I_Jjjder, Nanb)
+ call allocate_integer_data(I_Jjjpar, Nanb)
+ CALL Out_Deriv (I_Ixciso , A(Iwdasi), gridAccess,I_Iiuif,
+ * I_Jjjder , I_Jjjpar, Nnnsig, Ndasig, Nanb, 1, Jgbmax,
+ * 0)
+ END IF
+ IF (Ndbsig.GT.0) THEN
+ Nanb = Nnnsig*Ndbsig
+ call allocate_integer_data(I_Jjjder, Nanb)
+ call allocate_integer_data(I_Jjjpar, Nanb)
+ CALL Out_Deriv (I_Ixciso , A_Iwdbsi , gridAccess,I_Iiuif,
+ * I_Jjjder, I_Jjjpar, Nnnsig, Ndbsig, Nanb, Niniso,
+ * Jgbmax, 1)
+ END IF
+ END IF
+ IF (Jwwwww.EQ.5 .OR. Jwwwww.EQ.6) THEN
+ CALL Outthr (Kwwwww, I_Ixciso , gridAccess, A(Iwsigs), 1,
+ * Kiniso, Jgbmax)
+ IF (Ksolve.NE.2 .AND. Kpart.NE.0) THEN
+ IF (Ndasig.GT.0) THEN
+ Nanb = Ndasig
+ call allocate_integer_data(I_Jjjder, Nanb)
+ call allocate_integer_data(I_Jjjpar, Nanb)
+ CALL Out_Deriv (I_Ixciso , A_Iwdass , gridAccess,
+ * I_Iiuif,
+ * I_Jjjder, I_Jjjpar, 1, Ndasig, Nanb, 1, Jgbmax,0)
+ END IF
+ IF (Ndbsig.GT.0) THEN
+ Nanb = Ndbsig
+ call allocate_integer_data(I_Jjjder, Nanb)
+ call allocate_integer_data(I_Jjjpar, Nanb)
+ CALL Out_Deriv (I_Ixciso , A_Iwdbss , gridAccess,
+ * I_Iiuif,
+ * I_Jjjder, I_Jjjpar, 1, Ndbsig, Nanb, Kiniso,
+ * Jgbmax, 1)
+ END IF
+ END IF
+ END IF
+ END IF
+ if (allocated(I_Jjjder)) deallocate(I_Jjjder)
+ if (allocated(I_Jjjpar)) deallocate(I_Jjjpar)
+ call grid%setRowOffset(0)
+ call gridAccess%destroy()
+C - - - - - - - - - - - - - >
+C
+C *** four ***
+C - - - - - - - - - - - - - <
+ IF (Kplotu.NE.0) THEN
+ Idum = Idimen (Ndatb, 1, 'Ndatb, 1')
+ CALL Plotun (A(Iwsigx), A(Idum), Ndatb,
+ * Nnnsig*Niniso, Kplotu)
+ I = Idimen (Idum, -1, 'Idum, -1')
+ END IF
+C - - - - - - - - - - - - - >
+ CALL Run (Segnam)
+C *** end here if there's more broadening etc to do yet
+ RETURN
+ END
+C
+C
+C --------------------------------------------------------------
+C
+ SUBROUTINE Finished (A, Nblmax, I_Iiuif)
+C
+C *** Here there is no (more) broadening, so results are ready to write
+C *** directly
+C
+ use oops_common_m
+ use fixedi_m
+ use ifwrit_m
+ use exploc_common_m
+ use samxxx_common_m
+ use array_sizes_common_m
+ use oopsch_common_m
+ use abro_common_m
+ use cbro_common_m
+ use lbro_common_m
+ use hhhhhh_common_m
+ use mint2_m
+ use AllocateFunctions_m
+ use EndfData_common_m
+ use SammyGridAccess_M
+ IMPLICIT DOUBLE PRECISION (a-h,o-z)
+ integer,allocatable,dimension(:)::I_Jjjder, I_Jjjpar
+ type(SammyGridAccess)::gridAccess
+ DIMENSION A(-Msize:Msize), I_Iiuif(*)
+C
+ Nnn= Ndat
+ N = Ndat
+ call gridAccess%initialize()
+ call gridAccess%setParameters(numcro, ktzero)
+ call gridAccess%setToExpGrid(expData)
+C
+c
+c *********************************
+ Ith = Iwsigx
+c *** why is this needed here now?
+c *********************************
+ IF (Ktheor.NE.0) CALL Outthr (7, I_Ixciso , gridAccess, A(Ith),
+ * Nnnsig, 1, Nnn)
+C
+ IF (Kpart.NE.0 .AND. (Ksolve.NE.2 .OR. Kgenpd.NE.0)) THEN
+ IF (Ndasig.GT.0) THEN
+ Nanb = Nnnsig*Ndasig
+ call allocate_integer_data(I_Jjjder, Nanb)
+ call allocate_integer_data(I_Jjjpar, Nanb)
+ CALL Out_Deriv (I_Ixciso , A(Iwdasi), gridAccess, I_Iiuif,
+ * I_Jjjder, I_Jjjpar, Nnnsig, Ndasig, Nanb, 1, Ndat, 0)
+ END IF
+ IF (Ndbsig.GT.0) THEN
+ Nanb = Nnnsig*Ndbsig
+ call allocate_integer_data(I_Jjjder, Nanb)
+ call allocate_integer_data(I_Jjjpar, Nanb)
+ CALL Out_Deriv (I_Ixciso , A_Iwdbsi , gridAccess, I_Iiuif,
+ * I_Jjjder, I_Jjjpar, Nnnsig, Ndbsig, Nanb, 1, Ndat, 1)
+ END IF
+ END IF
+ if (allocated(I_Jjjder)) deallocate(I_Jjjder)
+ if (allocated(I_Jjjpar)) deallocate(I_Jjjpar)
+C
+C *** Complete the plot file
+C *** Here do final touches to put properly broadened theoretical
+C *** cross sections into proper files, etc
+C
+ Id = Iwsigx
+ IF (Kascii.EQ.1) CALL Wascii (A(Id), Ndat)
+C
+ IF (Kgenpd.EQ.1) THEN
+C *** seven ***
+C - - - - - - - - - - - - - <
+ Idd = Idimen (Ndat, 1, 'Ndat, 1')
+ Ide = Idimen (Nfpall, 1, 'Nfpall, 1')
+ Ivarda = Idimen (Ndat, 1, 'Ndat, 1')
+ CALL Pdwrit (A(Idd), A(Ivarda), A(Iwdasi), A(Ide), I_Iiuif)
+ I = Idimen (Idd, -1, 'Idd, -1')
+C - - - - - - - - - - - - - >
+ CALL RUN ('samnpv')
+C
+ ELSE
+ IF (Kodf.NE.0) THEN
+C
+ IF (Iterat.EQ.0) THEN
+C *** six ***
+ N = (Ndat+1)
+C - - - - - - - - - - - - - - - - - - - - - - - - - <
+ Idum = Idimen (N, 1, 'N, 1')
+ N = (Nblmax+1)
+ Iblock = Idimen (n, 1, 'n, 1')
+ CALL Thodf (A(Id), A(Idum),
+ * A(Iblock), Nblmax)
+C *** Routine Thodf writes the ORELA-Data-Formt file to be
+C *** used for plotting
+ I = Idimen (Idum, -1, 'Idum, -1')
+C - - - - - - - - - - - - - - - - - - - - - - - - - >
+ END IF
+ END IF
+C
+ IF (Kartgd.EQ.1) THEN
+ CALL Run ('samend')
+ ELSE IF (Kywywy.EQ.1) THEN
+ CALL Run ('samywy')
+ ELSE IF (Kwywyw.EQ.1) THEN
+ CALL Run ('samwyw')
+ ELSE
+ CALL Run ('samsqu')
+ END IF
+C
+ END IF
+ call gridAccess%destroy()
+ RETURN
+ END
diff --git a/sammy/src/npv/mnpv9.f b/sammy/src/npv/mnpv9.f
index c48ae2350..b4f2e7556 100644
--- a/sammy/src/npv/mnpv9.f
+++ b/sammy/src/npv/mnpv9.f
@@ -66,12 +66,13 @@ C
C *** Copy Wsigxx into Th and Wd?sig into Gx
C A(Iwsigx) -> A(Ith)
C ( A(Iwdasi), A_Iwdbsi ) -> A_Igx
- N = Kdat*Numcro
- write(0,*)" ?? ",Ith,Iwsigx,"-",N
- DO I=1,N
- A(Ith + I -1) = A(Iwsigx + I -1)
- END DO
- CALL Reorg ( A_Igx, A(Iwdasi), A_Iwdbsi , Kdat)
+ if (Ith.ne.Iwsigx) then
+ N = Kdat*Numcro
+ DO I=1,N
+ A(Ith + I -1) = A(Iwsigx + I -1)
+ END DO
+ CALL Reorg ( A_Igx, A(Iwdasi), A_Iwdbsi , Kdat)
+ end if
C
C
IF (Ksolve.NE.2 .OR. Nfpall.GT.Nvpall) THEN
diff --git a/sammy/src/sammy/CMakeLists.txt b/sammy/src/sammy/CMakeLists.txt
index 57863795b..087351eac 100644
--- a/sammy/src/sammy/CMakeLists.txt
+++ b/sammy/src/sammy/CMakeLists.txt
@@ -200,6 +200,7 @@ APPEND_SET(SAMMY_SOURCES
../inp/SpinGroupDataPostProcessing_M.f90
../int/mint0.f
+ ../int/mint0a.f
../int/mint1.f
../int/mint2.f90
../int/mint3.f
--
GitLab