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
|
*DECK RESCEL
SUBROUTINE RESCEL(IPMAP,NCH,NK,ALCH)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Compute fuel bundle burnups from the age pattern ALCH between
* begin-of-cyle burnups BINI and end-of-cycle burnups BFIN
*
*Copyright:
* Copyright (C) 2002 Ecole Polytechnique de Montreal
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version
*
*Author(s):
* routine partly recovered from OPTEX-4 (coef3e)
*
*Parameters: input
* IPMAP address of the MAP linked list or xsm file
* NCH number of channels
* NK number of bundles per channel
* ALCH integer representing channel age.
*
*Parameters: output
* IPMAP address of the MAP linked list or xsm file
*
*Reference:
* J. Tajmouati, "Optimisation de la gestion du combustible enrichi d'un
* reacteur CANDU avec prise en compte des parametres locaux", These
* Ph. D., Ecole Polytechnique de Montreal (1993). Voir Eq. (4.7).
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPMAP
INTEGER NCH,NK,ALCH(NCH)
REAL, ALLOCATABLE, DIMENSION(:) :: F
REAL, ALLOCATABLE, DIMENSION(:,:) :: WINT,BINI,BFIN
*----
* LOCAL VARIABLES
*----
INTEGER I,J,ILONG,ITYP
*----
* SCRATCH STORAGE ALLOCATION
* BINI initial burnup map
* BFIN final burnup map
* WINT instantaneous burnup
* F age values in real
*----
ALLOCATE(WINT(NCH,NK),BINI(NCH,NK),BFIN(NCH,NK),F(NCH))
*
* RECOVER FUEL BURNUPS
CALL LCMLEN(IPMAP,'BURN-BEG',ILONG,ITYP)
IF(ILONG.EQ.0) THEN
CALL XABORT('SHIFTB: INITIAL BURNUP REQUIRED')
ENDIF
CALL LCMGET(IPMAP,'BURN-BEG',BINI)
CALL LCMLEN(IPMAP,'BURN-END',ILONG,ITYP)
IF(ILONG.EQ.0) THEN
CALL XABORT('SHIFTB: FINAL BURNUP REQUIRED')
ENDIF
CALL LCMGET(IPMAP,'BURN-END',BFIN)
*
DO 10 I=1,NCH
F(I) = (FLOAT(ALCH(I)) - 0.5) / FLOAT(NCH)
IF( ALCH(I).EQ.0 ) F(I) = 0.0
DO 11 J=1,NK
WINT(I,J) = BINI(I,J) + F(I) * (BFIN(I,J) - BINI(I,J))
11 CONTINUE
10 CONTINUE
CALL LCMPUT(IPMAP,'BURN-INST',NCH*NK,2,WINT)
*----
* SCRATCH STORAGE DEALLOCATION
*----
DEALLOCATE(F,BFIN,BINI,WINT)
RETURN
END
|
