summaryrefslogtreecommitdiff
path: root/Donjon/src/LZCDRV.f
blob: 4f71429995f6bfa1b898d6c051e0a5fd8a2256fc (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
*DECK LZCDRV
      SUBROUTINE LZCDRV(IPDEV,IPMTX,IGEO,NMIX,NTOT,LIMIT,LNEW)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Read specifications for the liquid zone controllers from input file.
*
*Copyright:
* Copyright (C) 2007 Ecole Polytechnique de Montreal.
*
*Author(s): 
* D. Sekki
*
*Parameters: input/output
* IPDEV  pointer to device information.
* IPMTX  pointer to matex information.
* IGEO   index related to the reactor geometry.
* NMIX   old maximum number of material mixtures.
* NTOT   old total number of all mixtures.
* LIMIT  core limiting coordinates.
* LNEW   flag with respect to device object:
*        =.true. in create mode; =.false. in modification mode.
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      TYPE(C_PTR) IPDEV,IPMTX
      INTEGER NMIX,NTOT
      REAL LIMIT(6)
      LOGICAL LNEW
*----
*  LOCAL VARIABLES
*----
      PARAMETER(NSTATE=40,IOUT=6)
      CHARACTER TEXT*12
      INTEGER ISTATE(NSTATE)
      DOUBLE PRECISION DFLOT
      TYPE(C_PTR) JPDEV,KPDEV
      INTEGER, ALLOCATABLE, DIMENSION(:) :: MIX,MAT
*----
*  READ INPUT DATA
*----
      IMPX=1
      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
      IF(ITYP.NE.3)CALL XABORT('@LZCDRV: CHARACTER DATA EXPECTED(1).')
      IF(TEXT.NE.'EDIT')GOTO 10
*     PRINTING INDEX
      CALL REDGET(ITYP,IMPX,FLOT,TEXT,DFLOT)
      IF(ITYP.NE.1)CALL XABORT('@LZCDRV: INTEGER FOR EDIT EXPECTED.')
      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
      IF(ITYP.NE.3)CALL XABORT('@LZCDRV: CHARACTER DATA EXPECTED(2).')
   10 IF(TEXT.NE.'NUM-LZC')CALL XABORT('@LZCDRV: KEYWORD NUM-LZC EXP'
     1 //'ECTED.')
*     TOTAL NUMBER OF LZC
      CALL REDGET(ITYP,NLZC,FLOT,TEXT,DFLOT)
      IF(ITYP.NE.1)CALL XABORT('@LZCDRV: INTEGER TOTAL NUMBER OF LZC'
     1 //' EXPECTED.')
      IF(NLZC.LT.1)CALL XABORT('@LZCDRV: WRONG TOTAL NUMBER OF LZC <1')
*
      NTOT2=NTOT+NLZC*4
      ALLOCATE(MIX(NTOT2),MAT(NTOT))
      MIX(:NTOT2)=0
      MAT(:NTOT)=0
      CALL LCMGET(IPMTX,'MAT',MAT)
      DO 20 I=1,NTOT
      MIX(I)=MAT(I)
   20 CONTINUE
      DEALLOCATE(MAT)
*----
*  READ OPTION
*----
      IF(IMPX.GT.0)WRITE(IOUT,1000)NLZC
      JPDEV=LCMLID(IPDEV,'DEV_LZC',NLZC)
      K=0
   30 K=K+1
      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
      IF(TEXT.EQ.'LZC')THEN
        CALL REDGET(ITYP,ID,FLOT,TEXT,DFLOT)
        IF(ITYP.NE.1)CALL XABORT('@LZCDRV: INTEGER ID NUM'
     1   //'BER FOR THE CURRENT LZC EXPECTED.')
        IF(ID.NE.K)THEN
          WRITE(IOUT,*)'@LZCDRV: READ CURRENT LZC-ID #',ID
          WRITE(IOUT,*)'@LZCDRV: EXPECTED LZC-ID #',K
          CALL XABORT('@LZCDRV: WRONG INPUT OF ID NUMBER.')
        ENDIF
        IF(ID.GT.NLZC)THEN
          WRITE(IOUT,*)'@LZCDRV: READ CURRENT LZC-ID #',ID
          WRITE(IOUT,*)'@LZCDRV: GIVEN TOTAL NUMBER OF LZC:',NLZC
          CALL XABORT('@LZCDRV: WRONG INPUT OF LZC-ID NUMBER. GRE'
     1     //'ATER THAN THE TOTAL NUMBER OF LZC.')
        ENDIF
      ELSEIF((TEXT.EQ.'CREATE').OR.(TEXT.EQ.';'))THEN
        GOTO 40
      ELSE
        WRITE(IOUT,*)'@LZCDRV: INVALID KEYWORD ',TEXT
        CALL XABORT('@LZCDRV: KEYWORD OR ; EXPECTED.')
      ENDIF
      IF(IMPX.GT.1)WRITE(IOUT,1001)ID
      KPDEV=LCMDIL(JPDEV,ID)
*     READ INDIVIDUAL LZC DATA
      CALL LZCGET(KPDEV,NTOT,NMIX,NTOT2,MIX,ID,LIMIT,IMPX)
      GOTO 30
   40 IF(ID.NE.NLZC)THEN
        WRITE(IOUT,*)'@LZCDRV: GIVEN TOTAL NUMBER OF LZC ',NLZC
        WRITE(IOUT,*)'@LZCDRV: READ ONLY THE NUMBER OF LZC ',ID
        CALL XABORT('@LZCDRV: WRONG INPUT OF LZC DEVICES.')
      ENDIF
      IF(IMPX.GT.0)WRITE(IOUT,1002)ID
      IF(TEXT.EQ.';')GOTO 50
      LGRP=0
*     TOTAL NUMBER OF LZC-GROUPS
      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
      IF(TEXT.NE.'LZC-GR')CALL XABORT('@LZCDRV: KEYWORD LZC-GR EX'
     1 //'PECTED.')
      CALL REDGET(ITYP,LGRP,FLOT,TEXT,DFLOT)
      IF(ITYP.NE.1)CALL XABORT('@LZCDRV: INTEGER NUMBER OF LZC-GR'
     1 //'OUPS EXPECTED.')
      IF(LGRP.LT.1)CALL XABORT('@LZCDRV: WRONG NUMBER OF GROUPS <1')
*     CREATE LZC-GROUPS
      CALL LZCDGD(IPDEV,NLZC,LGRP,IMPX)
*----
*  STATE-VECTORS
*----
   50 ISTATE(:NSTATE)=0
      IF(LNEW)THEN
        ISTATE(1)=IGEO
        ISTATE(4)=NLZC
        ISTATE(5)=LGRP
      ELSE
*       UPDATE DEVICE
        CALL LCMGET(IPDEV,'STATE-VECTOR',ISTATE)
        ISTATE(4)=NLZC
        ISTATE(5)=LGRP
      ENDIF
      CALL LCMPUT(IPDEV,'STATE-VECTOR',NSTATE,1,ISTATE)
      IF(IMPX.GT.1)CALL LCMLIB(IPDEV)
*     UPDATE MATEX
      ISTATE(:NSTATE)=0
      CALL LCMGET(IPMTX,'STATE-VECTOR',ISTATE)
      ISTATE(2)=NMIX+NLZC*4
      ISTATE(5)=NTOT2
      CALL LCMPUT(IPMTX,'STATE-VECTOR',NSTATE,1,ISTATE)
      CALL LCMPUT(IPMTX,'MAT',NTOT2,1,MIX)
      DEALLOCATE(MIX)
      IF(IMPX.EQ.99)THEN
*       CHECK NEW COMPUTED VALUES
        WRITE(IOUT,*)'OLD VALUES: NMIX=',NMIX,' NTOT=',NTOT
        WRITE(IOUT,*)'NEW VALUES: NMIX=',ISTATE(2),' NTOT=',ISTATE(5)
      ENDIF
      IF(IMPX.GT.5)CALL LCMLIB(IPMTX)
      RETURN
*
 1000 FORMAT(/1X,'GIVEN TOTAL NUMBER OF LIQUID ZONE CONTROL',
     1 'LERS: ',I2//1X,'**  READING INPUT DATA FOR LZC  **')
 1001 FORMAT(/6X,'=>',2X,'LZC #',I2.2)
 1002 FORMAT(/1X,35('-')/1X,'READ TOTAL NUMBER OF LZC: ',I2)
      END