Initial commit from Polytechnique Montreal

1 files changed, 174 insertions, 0 deletions

diff --git a/Donjon/src/NCRMAP.f b/Donjon/src/NCRMAP.f
new file mode 100644
index 0000000..3ad7bb6
--- /dev/null
+++ b/Donjon/src/NCRMAP.f
@@ -0,0 +1,174 @@
+*DECK NCRMAP
+      SUBROUTINE NCRMAP(IPMAP,NPARM,HPARM,NCH,NB,IBTYP,HNAVAL,IMPX,
+     1 BURN0,BURN1,WPAR,LPARM)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* recover global parameter values from the fuel-map object.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki, R. Chambon
+*
+*Parameters: input
+* IPMAP   pointer to the fuel-map information.
+* NPARM   number of expected global parameters to be recovered from
+*         the fuel-map (burnup not included).
+* HPARM   names of these global parameters.
+* NCH     number of reactor channels.
+* NB      number of fuel bundles per channel.
+* IBTYP   type of burnup interpolation:
+*         =0 not provided; =1 time-average; =2 instantaneous;
+*         =3 derivative with respect to a single exit burnup.
+* HNAVAL  identification name corresponding to the basic naval-
+*         coordinate position of a neighbour assembly.
+* IMPX    printing index (=0 for no print).
+*
+*Parameters: output
+* BURN0   contains either low burnup integration limits or
+*         instantaneous burnups per fuel bundle.
+* BURN1   upper burnup integration limits per fuel bundle.
+* WPAR    values of the other global parameters in each bundle.
+* LPARM   existence flag for each expected global parameters.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAP
+      INTEGER NPARM,NCH,NB,IBTYP,IMPX
+      REAL BURN0(NCH,NB),BURN1(NCH,NB),WPAR(NCH,NB,NPARM)
+      LOGICAL LPARM(NPARM+1)
+      CHARACTER HPARM(NPARM+1)*(*),HNAVAL*4
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::NSTATE=40
+      INTEGER  ISTATE(NSTATE)
+      INTEGER IB, ICH, IICH, ILONG, ITYLCM, ITYPEP, JPARM
+      REAL VARTMP
+      CHARACTER HSMG*131
+      TYPE(C_PTR) JPMAP,KPMAP
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: BURNB
+      CHARACTER(LEN=4), ALLOCATABLE, DIMENSION(:) :: HSZONE
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(BURNB(NCH,NB))
+*----
+*  TIME-AVERAGE BURNUP
+*----
+      BURN0(:NCH,:NB)=0.0
+      BURN1(:NCH,:NB)=0.0
+      WPAR(:NCH,:NB,:NPARM)=0.0
+      LPARM(:NPARM+1)=.FALSE.
+      IF(IBTYP.EQ.0) THEN
+         CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+         IBTYP=ISTATE(5)
+      ENDIF
+      IF((IBTYP.EQ.0).AND.(HNAVAL.NE.' '))THEN
+*       USE THE BURNUP OF A NEIGHBOUR ASSEMBLY
+        IF(ISTATE(13).EQ.0)CALL XABORT('@NCRMAP: MISSING'
+     1   //' S-ZONE VALUES IN FUEL MAP.')
+        ALLOCATE(HSZONE(NCH))
+        CALL LCMGTC(IPMAP,'S-ZONE',4,NCH,HSZONE)
+        IICH=0
+        DO ICH=1,NCH
+          IF(HSZONE(ICH).EQ.HNAVAL) THEN
+            IICH=ICH
+            GO TO 20
+          ENDIF
+        ENDDO
+        WRITE(HSMG,'(24H@NCRMAP: UNABLE TO FIND ,A,16H IN RECORD S-ZON,
+     1  2HE.)') HNAVAL
+        CALL XABORT(HSMG)
+   20   DEALLOCATE(HSZONE)
+        CALL LCMLEN(IPMAP,'BURN-INST',ILONG,ITYLCM)
+        IF(ILONG.EQ.0)CALL XABORT('@NCRMAP: MISSING'
+     1   //' BURN-INST VALUES IN FUEL MAP.')
+        CALL LCMGET(IPMAP,'BURN-INST',BURNB)
+        DO ICH=1,NCH
+          DO IB=1,NB
+            BURN0(ICH,IB)=BURNB(IICH,IB)
+          ENDDO
+        ENDDO
+      ELSE IF((IBTYP.EQ.1).OR.(IBTYP.EQ.3))THEN
+*       LOW BURNUP LIMITS
+        CALL LCMLEN(IPMAP,'BURN-BEG',ILONG,ITYLCM)
+        IF(ILONG.EQ.0)CALL XABORT('@NCRMAP: MISSING'
+     1   //' BURN0 VALUES IN FUEL MAP.')
+        CALL LCMGET(IPMAP,'BURN-BEG',BURN0)
+*       UPPER BURNUP LIMITS
+        CALL LCMLEN(IPMAP,'BURN-END',ILONG,ITYLCM)
+        IF(ILONG.EQ.0)CALL XABORT('@NCRMAP: MISSING'
+     1   //' BURN1 VALUES IN FUEL MAP.')
+        CALL LCMGET(IPMAP,'BURN-END',BURN1)
+        IF(IMPX.GT.0)WRITE(IOUT,1000)
+        LPARM(NPARM+1)=.TRUE.
+*----
+*  INSTANTANEOUS BURNUP
+*----
+      ELSEIF(IBTYP.EQ.2)THEN
+        CALL LCMLEN(IPMAP,'BURN-INST',ILONG,ITYLCM)
+        IF(ILONG.EQ.0)CALL XABORT('@NCRMAP: MISSING'
+     1   //' BURN-INST VALUES IN FUEL MAP.')
+        CALL LCMGET(IPMAP,'BURN-INST',BURNB)
+        DO ICH=1,NCH
+          DO IB=1,NB
+            BURN0(ICH,IB)=BURNB(ICH,IB)
+            BURN1(ICH,IB)=BURNB(ICH,IB)
+          ENDDO
+        ENDDO
+        IF(IMPX.GT.0)WRITE(IOUT,1001)
+        LPARM(NPARM+1)=.TRUE.
+      ELSEIF(IBTYP.NE.0)THEN
+        CALL XABORT('@NCRMAP: INVALID BURNUP INTERPOLATION OPTION '
+     1  //'IBTYP IN FUEL MAP.')
+      ENDIF
+*----
+*  RECOVER OTHER PARAMETERS
+*----
+      IF(NPARM.GT.0) THEN
+        JPMAP=LCMGID(IPMAP,'PARAM')
+        DO 30 JPARM=1,NPARM
+          KPMAP=LCMGIL(JPMAP,JPARM)
+          CALL LCMGTC(KPMAP,'PARKEY',12,HPARM(JPARM))
+          CALL LCMGET(KPMAP,'P-TYPE',ITYPEP)
+          LPARM(JPARM)=.TRUE.
+*       Global parameter
+          IF(ITYPEP.EQ.1) THEN
+            CALL LCMLEN(KPMAP,'P-VALUE',ILONG,ITYLCM)
+            IF(ILONG.NE.1) THEN
+              WRITE(HSMG,'(37H@NCRMAP: P-VALUE LENGTH OF PARAMETER ,A,
+     1        12H IS EQUAL TO,I6,13H (MUST BE 1).)') HPARM(JPARM),ILONG
+              CALL XABORT(HSMG)
+            ENDIF
+            CALL LCMGET(KPMAP,'P-VALUE',VARTMP)
+            WPAR(:NCH,:NB,JPARM)=VARTMP
+*       Local parameter
+          ELSEIF (ITYPEP.EQ.2) THEN
+            CALL LCMGET(KPMAP,'P-VALUE',WPAR(1,1,JPARM))
+          ENDIF
+   30   CONTINUE
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(BURNB)
+      RETURN
+*
+ 1000 FORMAT(/1X,'** PERFORMING THE TIME-AVERAGE',
+     1 1X,'INTEGRATION OVER THE FUEL LATTICE **'/)
+ 1001 FORMAT(/1X,'** PERFORMING THE INSTANTANEOU',
+     1'S INTERPOLATION OVER THE FUEL LATTICE **'/)
+      END