summaryrefslogtreecommitdiff
path: root/Donjon/src/RESBRN.f
blob: aaedbe1f1d900e2643cd9c6b73957d87f4b1bd68 (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
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
*DECK RESBRN
      SUBROUTINE RESBRN(IPMAP,NCH,NB,NCOMB,NX,NY,NZ,LRSCH,IMPX)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Initialize the axial shape and compute the first burnup limits per
* bundle for every channel (used for the time-average model).
*
*Copyright:
* Copyright (C) 2007 Ecole Polytechnique de Montreal
*
*Author(s): 
*  D. Sekki, I. Trancart
*
*Parameters: input
* IPMAP   pointer to fuel-map information.
* NCH     number of reactor channels.
* NB      number of fuel bundles per channel.
* NCOMB   number of combustion zones.
* 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.
* LRSCH   flag for the refuelling scheme of channels:
*          =.true. it was read from the input file;
*          =.false. otherwise.
* IMPX    printing index (=0 for no print).
*
*----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      TYPE(C_PTR) IPMAP
      INTEGER NCH,NB,NCOMB,NX,NY,NZ,IMPX
      LOGICAL LRSCH
*----
*  LOCAL VARIABLES
*----
      PARAMETER(IOUT=6)
      INTEGER IVECT(NCOMB,NB),NSCH(NCH),IZONE(NCH),MIX(NX*NY*NZ),
     1 NAMX(NX),NAMY(NY),RSCH(NX,NY),AGLIM,CHR(NB)
      REAL BVAL(NCOMB),DELT(NB),B0(NB),B1(NB),SHAP(NCH,NB),
     1 BURN0(NCH,NB),BURN1(NCH,NB)
      CHARACTER TEXT*12,CHANY*2,FORM1*14,FORM2*14,SHU*3
      LOGICAL LAXSH
*----
*  RECOVER INFORMATION
*----
      CALL LCMLEN(IPMAP,'REF-SCHEME',LENG1,ITYP)
      CALL LCMLEN(IPMAP,'BURN-AVG',LENG2,ITYP)
      IF((LENG1.EQ.0).OR.(LENG2.EQ.0))GOTO 100
      CALL LCMLEN(IPMAP,'AX-SHAPE',LENG3,ITYP)
      IF(LENG3.EQ.0) THEN
*       INITIAL FLAT AXIAL-SHAPE
        IF(IMPX.GT.0)WRITE(IOUT,1000)
        SHAP(:NCH,:NB)=1.0/NB
        CALL LCMPUT(IPMAP,'AX-SHAPE',NCH*NB,2,SHAP)
      ELSE
        CALL LCMGET(IPMAP,'AX-SHAPE',SHAP)
      ENDIF
      CALL LCMGET(IPMAP,'REF-VECTOR',IVECT)
      CALL LCMGET(IPMAP,'REF-SCHEME',NSCH)
      CALL LCMGET(IPMAP,'BURN-AVG',BVAL)
      CALL LCMGET(IPMAP,'B-ZONE',IZONE)
      CALL LCMGET(IPMAP,'BMIX',MIX)
      BURN0(:NCH,:NB)=0.0
      BURN1(:NCH,:NB)=0.0
      LAXSH=.FALSE.
      IF(IMPX.GT.2)WRITE(IOUT,1004)
*----
*  COMPUTE FIRST BURNUP LIMITS
*----
      ICH=0
      DO 70 IEL=1,NX*NY
      IF(MIX(IEL).EQ.0) GOTO 70
      ICH=ICH+1
      IBSH=ABS(NSCH(ICH))
      SHU=' NO'
      DO IB=1,NB
      DELT(IB)=IBSH*BVAL(IZONE(ICH))*SHAP(ICH,IB)
      B0(IB)=0.
      B1(IB)=0.
*     Axial Shuffling detection
      IF(IVECT(IZONE(ICH),IB).GT.IB)THEN
        LAXSH=.TRUE.
        SHU='YES'
      ENDIF
      ENDDO
*     Burnup attribution with axial Shuffling
      IF(LAXSH)THEN 
        AGLIM=INT(NB/IBSH)+1
        CHR(:NB)=AGLIM
*       Two loops on bundle cycles (IA) and number of bundles (IB)
        DO 45 IA=0,AGLIM-1
        DO 40 IB=1,NB
*       Index ordering
        IF (NSCH(ICH).LT.0) THEN
          KK=NB-IB+1
          KV=NB-IVECT(IZONE(ICH),IB)+1
        ELSE
          KK=IB
          KV=IVECT(IZONE(ICH),IB)
        ENDIF
*       New fuel
        IF(IVECT(IZONE(ICH),IB).EQ.0)THEN
            CHR(IB)=0
            B0(KK)=0.
            B1(KK)=DELT(KK)
        ELSE 
*         Compute new burnup if previous bundle cycle done
          IF(CHR(IVECT(IZONE(ICH),IB)).EQ.(IA-1))THEN
            CHR(IB)=IA
            B0(KK)=B1(KV)
            B1(KK)=DELT(KK)+B1(KV)
          ENDIF
        ENDIF
   40   CONTINUE
   45   CONTINUE
*     Burnup attribution without axial Shuffling 
*     One loop on number of bundles (IB)
      ELSE
*       NEGATIVE DIRECTION
        IF(NSCH(ICH).LT.0)THEN
          DO 50 IB=1,NB
          KK=NB-IB+1
          KA=NB-IVECT(IZONE(ICH),IB)+1
          IF(IVECT(IZONE(ICH),IB).LE.0)THEN
            B0(KK)=0.
          ELSE
            B0(KK)=B1(KA)
          ENDIF
          B1(KK)=B0(KK)+DELT(KK)
   50     CONTINUE
*       POSITIVE DIRECTION
        ELSE
          DO 60 IB=1,NB
          IF(IVECT(IZONE(ICH),IB).LE.0)THEN
            B0(IB)=0.
          ELSE
            B0(IB)=B1(IVECT(IZONE(ICH),IB))
          ENDIF
          B1(IB)=B0(IB)+DELT(IB)
   60     CONTINUE
        ENDIF
      ENDIF
      DO IB=1,NB
        BURN0(ICH,IB)=B0(IB)
        BURN1(ICH,IB)=B1(IB)
      ENDDO
      IF(IMPX.GE.3) THEN
*       CHECK BURNUP LIMITS
        WRITE(TEXT,'(A9,I3.3)')'CHANNEL #',ICH
        WRITE(IOUT,1001)TEXT,NSCH(ICH),IZONE(ICH),SHU
        WRITE(IOUT,1002)'B0',(B0(IB),IB=1,NB)
        WRITE(IOUT,1002)'B1',(B1(IB),IB=1,NB)
      ENDIF
*     Reset shuffling for next channel
      LAXSH=.FALSE.
   70 CONTINUE
      CALL LCMPUT(IPMAP,'BURN-BEG',NB*NCH,2,BURN0)
      CALL LCMPUT(IPMAP,'BURN-END',NB*NCH,2,BURN1)
      IF((.NOT.LRSCH).OR.(IMPX.LT.2))GOTO 100
*----
*  PRINT CHANNELS REFUELLING SCHEMES
*----
      WRITE(FORM1,'(A4,I2,A8)')'(A4,',NX,'(A3,1X))'
      WRITE(FORM2,'(A4,I2,A8)')'(A2,',NX,'(I3,1X))'
      CALL LCMGET(IPMAP,'XNAME',NAMX)
      CALL LCMGET(IPMAP,'YNAME',NAMY)
      RSCH(:NX,:NY)=0
      WRITE(IOUT,1003)
      IEL=0
      ICH=0
      DO 85 J=1,NY
      DO 80 I=1,NX
      IEL=IEL+1
      IF(MIX(IEL).EQ.0) GOTO 80
      ICH=ICH+1
      RSCH(I,J)=NSCH(ICH)
   80 CONTINUE
   85 CONTINUE
      WRITE(IOUT,FORM1)' ',(NAMX(I),I=1,NX)
      WRITE(IOUT,*)' '
      DO 90 J=1,NY
      WRITE(CHANY,'(A2)') (NAMY(J))
      IF(INDEX(CHANY,'-').EQ.1) GOTO 90
      WRITE(IOUT,FORM2)CHANY,(RSCH(I,J),I=1,NX)
   90 CONTINUE
  100 RETURN
*
 1000 FORMAT(/1X,'INITIALIZING THE FLAT AXIAL POWER-SHAPE'/
     1 1X,'COMPUTING THE FIRST BURNUP LIMITS PER EACH CHANNEL'/)
 1001 FORMAT(/10X,
     1 A12,10X,'REFUELLING SCHEME:',I3,10X,'ZONE-INDEX:',I3,10X,
     2 'SHUFFLING: ',A3)
 1002 FORMAT(A3,12(F8.1,1X))
 1003 FORMAT(//20X,'** CHANNELS REFUELLING SCHEMES **'/)
 1004 FORMAT(/20X,'** FIRST BURNUP LIMITS PER EACH CHANNEL **'/)
      END