Initial commit from Polytechnique Montreal

1 files changed, 168 insertions, 0 deletions

diff --git a/Donjon/src/RESPFM.f b/Donjon/src/RESPFM.f
new file mode 100644
index 0000000..17b48a4
--- /dev/null
+++ b/Donjon/src/RESPFM.f
@@ -0,0 +1,168 @@
+*DECK RESPFM
+      SUBROUTINE RESPFM(IPMAP,IPMTX,NX,NY,NZ,LX,LY,LZ,NFUEL,IMPX,IGEO,
+     > NCH,NB,NTOT)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* recover, check and store the fuel mixtures.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki
+*
+*Parameters: input/output
+* IPMAP  pointer to fuel-map information.
+* IPMTX  pointer to matex information.
+* NX     number of elements along x-axis in fuel map.
+* NY     number of elements along y-axis in fuel map.
+* NZ     number of elements along z-axis in fuel map.
+* LX     number of elements along x-axis in geometry.
+* LY     number of elements along y-axis in geometry.
+* LZ     number of elements along z-axis in geometry.
+* NFUEL  number of fuel types.
+* IMPX   printing index (=0 for no print).
+* IGEO   type of geometry (=7 or =9)
+*
+*Parameters: output
+* NCH    number of fuel channels.
+* NB     number of fuel bundles per channel.
+* NTOT   total number of fuel bundles.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAP,IPMTX
+      INTEGER NX,NY,NZ,LX,LY,LZ,NFUEL,IMPX,IGEO,NCH,NB,NTOT
+      TYPE(C_PTR) JPMAP,KPMAP
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(IOUT=6)
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: MIX,FMIX,FTOT,IFLMIX
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(MIX(NX*NY*NZ),FMIX(NFUEL),FTOT(NFUEL))
+*----
+*  COMPUTE NUMBER OF FUEL CHANNELS AND NUMBER OF FUEL BUNDLES
+*----
+      IF(IMPX.GT.2) WRITE(IOUT,*)'SETTING FUEL-MAP MIXTURES'
+      IF((IGEO.NE.7).AND.(IGEO.NE.9))THEN
+        CALL XABORT('@RESPFM: WRONG TYPE OF GEOMETRY, 3D-CARTESIAN OR '
+     >  //'3D-HEXAGONAL GEOMETRY EXPECTED')
+      ENDIF
+      MIX(:NX*NY*NZ)=0
+      CALL LCMGET(IPMAP,'MIX',MIX)
+      NB=0
+      DO IZ=1,NZ
+        DO I=1,NX*NY
+          IEL=(IZ-1)*NX*NY+I
+          IF(MIX(IEL).NE.0) GOTO 10
+        ENDDO
+        CYCLE
+   10   NB=NB+1
+      ENDDO
+      NCH=0
+      DO I=1,NX*NY
+        DO IZ=1,NZ
+          IEL=(IZ-1)*NX*NY+I
+          IF(MIX(IEL).NE.0) GOTO 20
+        ENDDO
+        CYCLE
+   20   NCH=NCH+1
+      ENDDO
+      IF(IMPX.GT.0) WRITE(6,100) NCH,NB
+      ALLOCATE(IFLMIX(NCH*NB))
+*----
+*  COMPUTE FLMIX AND FTOT
+*----
+      FMIX(:NFUEL)=0
+      CALL LCMGET(IPMTX,'FMIX',FMIX)
+      FTOT(:NFUEL)=0
+      IFLMIX(:NCH*NB)=0
+      NTOT=0
+      IB=0
+      DO 50 IZ=1,NZ
+      DO I=1,NX*NY
+         IEL=(IZ-1)*NX*NY+I
+         IF(MIX(IEL).NE.0) GOTO 30
+      ENDDO
+      GO TO 50
+   30 IB=IB+1
+      IF(IB.GT.NB) CALL XABORT('@RESPFM: NB OVERFLOW.')
+      ICH=0
+      DO 40 I=1,NX*NY
+      DO K=1,NZ
+        IF(MIX((K-1)*NX*NY+I).NE.0) GOTO 35
+      ENDDO
+      GO TO 40
+   35 IEL=(IZ-1)*NX*NY+I
+      ICH=ICH+1
+      IF(ICH.GT.NCH) CALL XABORT('@RESPFM: NCH OVERFLOW.')
+      IFLMIX((IB-1)*NCH+ICH)=MIX(IEL)
+      IF(MIX(IEL).EQ.0) GO TO 40
+      DO IFUEL=1,NFUEL
+        IF(MIX(IEL).EQ.FMIX(IFUEL))THEN
+          FTOT(IFUEL)=FTOT(IFUEL)+1
+          NTOT=NTOT+1
+          IF(NTOT.GT.NCH*NB)THEN
+            WRITE(IOUT,*)'@RESPFM: TOTAL NUMBER OF BUNDLES =',NCH*NB
+            WRITE(IOUT,*)'@RESPFM: READ TOTAL FUEL MIXTURES ',NTOT
+            CALL XABORT('@RESPFM: WRONG FUEL-MAP DEFINITION.')
+          ENDIF
+          GOTO 40
+        ENDIF
+      ENDDO
+      WRITE(IOUT,*)'@RESPFM: READ FUEL MIXTURE NUMBER ',MIX(IEL)
+      CALL XABORT('@RESPFM: WRONG FUEL MIXTURE NUMBER.')
+   40 CONTINUE
+   50 CONTINUE
+      IF(IMPX.GT.0) WRITE(6,110) NTOT
+*----
+*  STORE FUEL MIXTURES
+*----
+      IF(IMPX.GT.2) WRITE(IOUT,*)'STORING FUEL MIXTURES'
+*     FUEL DIRECTORIES
+      CALL LCMSIX(IPMAP,' ',0)
+      JPMAP=LCMLID(IPMAP,'FUEL',NFUEL)
+      DO IFUEL=1,NFUEL
+        KPMAP=LCMDIL(JPMAP,IFUEL)
+        CALL LCMPUT(KPMAP,'MIX',1,1,FMIX(IFUEL))
+        CALL LCMPUT(KPMAP,'TOT',1,1,FTOT(IFUEL))
+      ENDDO
+      CALL LCMPUT(IPMAP,'FLMIX',NCH*NB,1,IFLMIX)
+      DEALLOCATE(IFLMIX)
+*     RENUMBERING
+      NMIX=0
+      DO IEL=1,NX*NY*NZ
+        IF(MIX(IEL).NE.0)THEN
+          NMIX=NMIX+1
+          MIX(IEL)=NMIX
+        ENDIF
+      ENDDO
+      CALL LCMPUT(IPMAP,'BMIX',NX*NY*NZ,1,MIX)
+*     UPDATE MATERIAL INDEX
+      IF(IGEO.EQ.7)THEN
+        CALL RESIND(IPMAP,IPMTX,NX,NY,NZ,LX,LY,LZ,MIX,NFUEL,IMPX)
+      ELSE IF(IGEO.EQ.9)THEN
+        CALL RESHID(IPMAP,IPMTX,NX,NZ,LX,LZ,MIX,NFUEL,IMPX)
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(FTOT,FMIX,MIX)
+      RETURN
+*
+  100 FORMAT(/33H RESPFM: NUMBER OF FUEL CHANNELS=,I5/9X,10HNUMBER OF ,
+     > 25HFUEL BUNDLES PER CHANNEL=,I5)
+  110 FORMAT(9X,29HTOTAL NUMBER OF FUEL BUNDLES=,I8)
+      END