From 7dfcc480ba1e19bd3232349fc733caef94034292 Mon Sep 17 00:00:00 2001
From: stainer_t <thomas.stainer@oecd-nea.org>
Date: Mon, 8 Sep 2025 13:48:49 +0200
Subject: Initial commit from Polytechnique Montreal

---
 Donjon/src/CVRUSR.f | 144 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 144 insertions(+)
 create mode 100644 Donjon/src/CVRUSR.f

(limited to 'Donjon/src/CVRUSR.f')

diff --git a/Donjon/src/CVRUSR.f b/Donjon/src/CVRUSR.f
new file mode 100644
index 0000000..6405cc7
--- /dev/null
+++ b/Donjon/src/CVRUSR.f
@@ -0,0 +1,144 @@
+*DECK CVRUSR
+      SUBROUTINE CVRUSR(IPMAP,NCH,NB,NFUEL,NX,NY,NZ,NVOID,NAMXV,NAMYV,
+     1 NPARM,PNAME,PVALUE,VCOOL,LCOOL,IMPX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Modify channels data according to the user-defined voiding pattern.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki
+*
+*Parameters: input/output
+* IPMAP   pointer to fuel-map information.
+* NCH     number of reactor channels.
+* NB      number of fuel bundles per channel.
+* NFUEL   number of fuel types.
+* 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.
+* NVOID   total number of voided channels.
+* NAMXV   names of voided channels along x-axis.
+* NAMYV   names of voided channels along y-axis.
+* NPARM   total number of recorded parameters.
+* PNAME   recorded parameter name for the coolant density.
+* PVALUE  structure containing the coolant density values
+*         throughout the reactor core.
+* VCOOL   coolant density value for voided channels.
+* LCOOL   flag with respect to the coolant densities:
+*          =.true. to modify these values;
+*          =.false. coolant densities not provided.
+* IMPX    printing index (=0 for no print).
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAP
+      INTEGER NCH,NB,NFUEL,NX,NY,NZ,NVOID,NPARM,IMPX,NAMXV(NVOID),
+     1 NAMYV(NVOID)
+      REAL PVALUE(NCH,NB),VCOOL
+      CHARACTER PNAME*12
+      LOGICAL LCOOL
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(IOUT=6)
+      INTEGER MIX(NX*NY*NZ),FLMIX(NCH,NB),NAMX(NX),NAMY(NY),INAME(3)
+      CHARACTER TEXT*12,CHANX*2,CHANY*2
+      TYPE(C_PTR) JPMAP,KPMAP
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: CNANV
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(CNANV(NVOID))
+*----
+*  RECOVER INFORMATION
+*----
+      MIX(:NX*NY*NZ)=0
+      FLMIX(:NCH,NB)=0
+      NAMX(:NX)=0
+      NAMY(:NY)=0
+      CALL LCMGET(IPMAP,'BMIX',MIX)
+      CALL LCMGET(IPMAP,'FLMIX',FLMIX)
+*     CHANNEL NAMES
+      CALL LCMGET(IPMAP,'XNAME',NAMX)
+      CALL LCMGET(IPMAP,'YNAME',NAMY)
+      TEXT='USER-DEFINED'
+      IF(IMPX.GT.0)WRITE(IOUT,1000)TEXT,NVOID
+*----
+*  CHECK VOIDED CHANNELS
+*----
+      DO 20 IVD=1,NVOID
+      IEL=0
+      ICH=0
+      DO 15 J=1,NY
+      DO 10 I=1,NX
+        IEL=IEL+1
+        IF(MIX(IEL).EQ.0)GOTO 10
+        ICH=ICH+1
+        IF(NAMXV(IVD).NE.NAMX(I))GOTO 10
+        IF(NAMYV(IVD).NE.NAMY(J))GOTO 10
+        CNANV(IVD)=ICH
+        GOTO 20
+   10 CONTINUE
+   15 CONTINUE
+      WRITE(CHANX,'(A2)') (NAMXV(IVD))
+      WRITE(CHANY,'(A2)') (NAMYV(IVD))
+      WRITE(IOUT,1001)CHANY,CHANX
+      CALL XABORT('@CVRUSR: INVALID INPUT DATA.')
+   20 CONTINUE
+*----
+*  MODIFY CHANNEL DATA
+*----
+      ITOT=0
+      JPMAP=LCMGID(IPMAP,'FUEL')
+      DO IFUEL=1,NFUEL
+        KPMAP=LCMGIL(JPMAP,IFUEL)
+        CALL LCMGET(KPMAP,'MIX',MIXF)
+        CALL LCMGET(KPMAP,'MIX-VOID',MIXV)
+        DO IVD=1,NVOID
+          ICH=CNANV(IVD)
+          DO 30 IB=1,NB
+          IF(FLMIX(ICH,IB).NE.MIXF)GOTO 30
+          FLMIX(ICH,IB)=MIXV
+          IF(LCOOL) PVALUE(ICH,IB)=VCOOL
+          ITOT=ITOT+1
+   30     CONTINUE
+        ENDDO
+      ENDDO
+      IF(IMPX.GT.0)WRITE(IOUT,1002)ITOT
+      IF(IMPX.LT.2)GOTO 40
+*     PRINTING
+      CALL CVRPRN(IPMAP,NCH,NB,NX,NY,NZ,FLMIX,PVALUE,LCOOL,IMPX)
+*     STORE NEW DATA
+   40 CALL LCMPUT(IPMAP,'FLMIX',NCH*NB,1,FLMIX)
+      IF(.NOT.LCOOL)GOTO 50
+      JPMAP=LCMGID(IPMAP,'PARAM')
+      DO IPAR=1,NPARM
+        KPMAP=LCMGIL(JPMAP,IPAR)
+        CALL LCMGET(KPMAP,'P-NAME',INAME)
+        WRITE(TEXT,'(3A4)') (INAME(I),I=1,3)
+        IF(PNAME.EQ.TEXT)THEN
+          CALL LCMPUT(KPMAP,'P-VALUE',NCH*NB,2,PVALUE)
+          GOTO 50
+        ENDIF
+      ENDDO
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+   50 DEALLOCATE(CNANV)
+      RETURN
+*
+ 1000 FORMAT(/2X,'SELECTED VOIDING PATTERN',2X,'=>',2X,A20
+     1     //2X,'TOTAL NUMBER OF VOIDED CHANNELS =',1X,I3/)
+ 1001 FORMAT(/1X,'@CVRUSR: UNABLE TO FIND THE CHANN',
+     1 'EL NAME:',1X,A2,A2)
+ 1002 FORMAT(2X,'TOTAL NUMBER OF MODIFIED VALUES :',1X,I4/)
+      END
-- 
cgit v1.2.3