diff options
Diffstat (limited to 'Donjon/src/LZCDGD.f')
| -rw-r--r-- | Donjon/src/LZCDGD.f | 156 |
1 files changed, 156 insertions, 0 deletions
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
|