1 files changed, 77 insertions, 0 deletions
diff --git a/Dragon/src/MCGSIG.f b/Dragon/src/MCGSIG.f
new file mode 100644
index 0000000..9509841
--- /dev/null
+++ b/Dragon/src/MCGSIG.f
@@ -0,0 +1,77 @@
+*DECK MCGSIG
+      SUBROUTINE MCGSIG(IPTRK,NMAT,NGEFF,NALBP,KPSYS,SIGAL,LVOID)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Construct total cross sections and albedos array and check for void.
+*
+*Copyright:
+* Copyright (C) 2002 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): R. Le Tellier
+*
+*Parameters: input
+* IPTRK   pointer to the tracking (L_TRACK signature).
+* NMAT    number of mixtures.
+* NGEFF   effective number of energy groups.
+* NALBP   number of physical albedos.
+* KPSYS   pointer array for each group properties.
+*
+*Parameters: output
+* SIGAL   total cross sections and albedos array.
+* LVOID   void flag.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*---
+* SUBROUTINES ARGUMENTS
+*---
+      TYPE(C_PTR) IPTRK,KPSYS(NGEFF)
+      INTEGER NMAT,NGEFF,NALBP
+      REAL SIGAL(-6:NMAT,NGEFF)
+      LOGICAL LVOID
+*---
+* LOCAL VARIABLES
+*---
+      TYPE(C_PTR) JPSYS
+      INTEGER I,II,ISA,ICODE(6)
+      REAL ALBG(6),ALBEDO(6)
+      REAL, ALLOCATABLE, DIMENSION(:) :: ALBP
+*---
+* RECOVER ALBEDO INFORMATION FROM TRACKING
+*---
+      CALL LCMGET(IPTRK,'ICODE',ICODE)
+      CALL LCMGET(IPTRK,'ALBEDO',ALBG)
+*
+      LVOID=.FALSE.
+      ALLOCATE(ALBP(NALBP))
+      DO II=1,NGEFF
+         JPSYS=KPSYS(II)
+         DO ISA=1,6
+           ALBEDO(ISA)=ALBG(ISA)
+         ENDDO
+         IF(NALBP .GT. 0) THEN
+           CALL LCMGET(JPSYS,'ALBEDO',ALBP)
+           DO ISA=1,6
+             IF(ICODE(ISA).GT.0) ALBEDO(ISA)=ALBP(ICODE(ISA))
+           ENDDO
+         ENDIF
+         CALL LCMGET(JPSYS,'DRAGON-TXSC',SIGAL(0,II))
+         DO I=1,NMAT
+            IF (SIGAL(I,II).EQ.0.0) LVOID=.TRUE.
+         ENDDO
+         DO ISA=-6,-1
+            SIGAL(ISA,II)=ALBEDO(-ISA)
+         ENDDO
+      ENDDO
+      DEALLOCATE(ALBP)
+*
+      RETURN
+      END