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/LZCDGD.f | 156 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 156 insertions(+)
 create mode 100644 Donjon/src/LZCDGD.f

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

diff --git a/Donjon/src/LZCDGD.f b/Donjon/src/LZCDGD.f
new file mode 100644
index 0000000..be3f70e
--- /dev/null
+++ b/Donjon/src/LZCDGD.f
@@ -0,0 +1,156 @@
+*DECK LZCDGD
+      SUBROUTINE LZCDGD(IPDEV,NLZC,LGRP,IMPX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Create the liquid-zone-controllers group directories on the device
+* data structure.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki
+*
+*Parameters: input
+* IPDEV  pointer to device information.
+* NLZC   total number of liquid zone controllers.
+* LGRP   total number of lzc-groups.
+* IMPX   printing index (=0 for no print).
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPDEV
+      INTEGER NLZC,LGRP,IMPX
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(IOUT=6)
+      CHARACTER TEXT*12
+      INTEGER LZCID(NLZC)
+      DOUBLE PRECISION DFLOT
+      TYPE(C_PTR) JPDEV,KPDEV
+*----
+*  CREATE GROUPS
+*----
+      JPDEV=LCMLID(IPDEV,'LZC_GROUP',LGRP)
+      IGRP=0
+      IF(IMPX.GT.0)WRITE(IOUT,1001)
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('@LZCDGD: KEYWORD GROUP-ID EXPECTED.')
+      IF(TEXT.NE.'GROUP-ID')CALL XABORT('@LZCDGD: KEYWORD GROUP-'
+     1 //'ID EXPECTED.')
+   10 IGRP=IGRP+1
+      CALL REDGET(ITYP,JGRP,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.1)CALL XABORT('@LZCDGD: INTEGER GROUP-ID NUMBER'
+     1 //' EXPECTED.')
+      IF(JGRP.NE.IGRP)THEN
+        WRITE(IOUT,*)'@LZCDGD: READ GROUP-ID NUMBER #',JGRP
+        WRITE(IOUT,*)'@LZCDGD: EXPECTED GROUP-ID NUMBER #',IGRP
+        CALL XABORT('@LZCDGD: WRONG GROUP-ID NUMBER.')
+      ENDIF
+      IF(JGRP.GT.LGRP)THEN
+        WRITE(IOUT,*)'@LZCDGD: GIVEN TOTAL NUMBER OF GROUPS ',LGRP
+        WRITE(IOUT,*)'@LZCDGD: READ GROUP-ID NUMBER #',JGRP
+        CALL XABORT('@LZCDGD: WRONG GROUP-ID NUMBER.')
+      ENDIF
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('@LZCDGD: KEYWORD EXPECTED.')
+*----
+*  OPTION ALL
+*----
+      IF(TEXT.EQ.'ALL')THEN
+        KPDEV=LCMDIL(JPDEV,IGRP)
+        DO 30 ID=1,NLZC
+        LZCID(ID)=ID
+   30   CONTINUE
+        CALL LCMPUT(KPDEV,'GROUP-ID',1,1,IGRP)
+        CALL LCMPUT(KPDEV,'NUM-LZC',1,1,NLZC)
+        CALL LCMPUT(KPDEV,'LZC-ID',NLZC,1,LZCID)
+*
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@LZCDGD: WRONG INPUT DATA.')
+        IF(TEXT.EQ.';')THEN
+          IF(IGRP.EQ.LGRP)THEN
+            NDG=NLZC
+            GOTO 100
+          ENDIF
+          WRITE(IOUT,*)'@LZCDGD: GIVEN TOTAL NUMBER OF GROUPS ',LGRP
+          WRITE(IOUT,*)'@LZCDGD: CREATED ONLY NUMBER OF GROUPS ',IGRP
+          CALL XABORT('@LZCDGD: WRONG NUMBER OF GROUPS.')
+        ELSEIF(TEXT.EQ.'GROUP-ID')THEN
+          IF(IMPX.GT.0)WRITE(IOUT,1000)IGRP,NLZC
+          GOTO 10
+        ELSE
+          CALL XABORT('@LZCDGD: WRONG KEYWORD '//TEXT)
+        ENDIF
+*----
+*  OPTION LZC-ID
+*----
+      ELSEIF(TEXT.EQ.'LZC-ID')THEN
+        NDG=0
+        LZCID(:NLZC)=0
+        KPDEV=LCMDIL(JPDEV,IGRP)
+*
+   50   CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.EQ.3)THEN
+          IF(TEXT.EQ.';')THEN
+            IF(IGRP.EQ.LGRP)GOTO 100
+            WRITE(IOUT,*)'@LZCDGD: GIVEN TOTAL NUMBER OF GROUPS ',LGRP
+            WRITE(IOUT,*)'@LZCDGD: CREATED ONLY NUMBER OF GROUPS ',IGRP
+            CALL XABORT('@LZCDGD: WRONG NUMBER OF GROUPS.')
+          ELSEIF(TEXT.EQ.'GROUP-ID')THEN
+            IF(IMPX.GT.0)WRITE(IOUT,1000)IGRP,NDG
+            GOTO 10
+          ELSE
+            CALL XABORT('@LZCDGD: WRONG KEYWORD '//TEXT)
+          ENDIF
+*----
+*  LZC-ID NUMBERS
+*----
+        ELSEIF(ITYP.EQ.1)THEN
+          ID=NITMA
+          IF((ID.GT.NLZC).OR.(ID.LE.0))THEN
+            WRITE(IOUT,*)'@LZCDGD: FOR THE GROUP #',IGRP
+            WRITE(IOUT,*)'@LZCDGD: READ LZC-ID #',ID
+            CALL XABORT('@LZCDGD: WRONG LZC-ID NUMBER.')
+          ENDIF
+          DO I=1,NLZC
+            IF(ID.EQ.LZCID(I))THEN
+              WRITE(IOUT,*)'@LZCDGD: FOR THE GROUP #',IGRP
+              WRITE(IOUT,*)'@LZCDGD: REPEATED LZC-ID #',ID
+              CALL XABORT('@LZCDGD: WRONG LZC-ID NUMBER.')
+            ENDIF
+          ENDDO
+*
+          NDG=NDG+1
+          IF(NDG.GT.NLZC)THEN
+            WRITE(IOUT,*)'@LZCDGD: FOR THE GROUP #',IGRP
+            WRITE(IOUT,*)'@LZCDGD: WRONG TOTAL NUMBER OF LZC ',NDG
+            CALL XABORT('@LZCDGD: INVALID INPUT OF LZC-DEVICES.')
+          ENDIF
+          LZCID(NDG)=ID
+          CALL LCMPUT(KPDEV,'GROUP-ID',1,1,IGRP)
+          CALL LCMPUT(KPDEV,'NUM-LZC',1,1,NDG)
+          CALL LCMPUT(KPDEV,'LZC-ID',NDG,1,LZCID)
+        ELSE
+          CALL XABORT('@LZCDGD: WRONG INPUT DATA.')
+        ENDIF
+        GOTO 50
+      ELSE
+        CALL XABORT('@LZCDGD: WRONG KEYWORD '//TEXT)
+      ENDIF
+  100 IF(IMPX.GT.0)WRITE(IOUT,1000)IGRP,NDG
+      IF(IMPX.GT.0)WRITE(IOUT,1002)LGRP
+      RETURN
+*
+ 1000 FORMAT(/1X,'CREATED A GROUP #',I2.2,
+     1        4X,'INCLUDES TOTAL NUMBER OF LZC:',1X,I2)
+ 1001 FORMAT(/1X,'**  CREATING GROUPS FOR LZC-DEVICES  **')
+ 1002 FORMAT(/1X,39('-')/1X,'TOTAL NUMBER OF GROUPS CREATED:',I2)
+      END
-- 
cgit v1.2.3