summaryrefslogtreecommitdiff
path: root/Donjon/src/NCRMAP.f
blob: 3ad7bb610abbe21878af188cf9bb4d2bde692f34 (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
*DECK NCRMAP
      SUBROUTINE NCRMAP(IPMAP,NPARM,HPARM,NCH,NB,IBTYP,HNAVAL,IMPX,
     1 BURN0,BURN1,WPAR,LPARM)
*
*-----------------------------------------------------------------------
*
*Purpose:
* recover global parameter values from the fuel-map object.
*
*Copyright:
* Copyright (C) 2007 Ecole Polytechnique de Montreal.
*
*Author(s): 
* D. Sekki, R. Chambon
*
*Parameters: input
* IPMAP   pointer to the fuel-map information.
* NPARM   number of expected global parameters to be recovered from
*         the fuel-map (burnup not included).
* HPARM   names of these global parameters.
* NCH     number of reactor channels.
* NB      number of fuel bundles per channel.
* IBTYP   type of burnup interpolation:
*         =0 not provided; =1 time-average; =2 instantaneous;
*         =3 derivative with respect to a single exit burnup.
* HNAVAL  identification name corresponding to the basic naval-
*         coordinate position of a neighbour assembly.
* IMPX    printing index (=0 for no print).
*
*Parameters: output
* BURN0   contains either low burnup integration limits or
*         instantaneous burnups per fuel bundle.
* BURN1   upper burnup integration limits per fuel bundle.
* WPAR    values of the other global parameters in each bundle.
* LPARM   existence flag for each expected global parameters.
*
*-----------------------------------------------------------------------
*
      USE GANLIB
      IMPLICIT NONE
*----
*  SUBROUTINE ARGUMENTS
*----
      TYPE(C_PTR) IPMAP
      INTEGER NPARM,NCH,NB,IBTYP,IMPX
      REAL BURN0(NCH,NB),BURN1(NCH,NB),WPAR(NCH,NB,NPARM)
      LOGICAL LPARM(NPARM+1)
      CHARACTER HPARM(NPARM+1)*(*),HNAVAL*4
*----
*  LOCAL VARIABLES
*----
      INTEGER, PARAMETER::IOUT=6
      INTEGER, PARAMETER::NSTATE=40
      INTEGER  ISTATE(NSTATE)
      INTEGER IB, ICH, IICH, ILONG, ITYLCM, ITYPEP, JPARM
      REAL VARTMP
      CHARACTER HSMG*131
      TYPE(C_PTR) JPMAP,KPMAP
*----
*  ALLOCATABLE ARRAYS
*----
      REAL, ALLOCATABLE, DIMENSION(:,:) :: BURNB
      CHARACTER(LEN=4), ALLOCATABLE, DIMENSION(:) :: HSZONE
*----
*  SCRATCH STORAGE ALLOCATION
*----
      ALLOCATE(BURNB(NCH,NB))
*----
*  TIME-AVERAGE BURNUP
*----
      BURN0(:NCH,:NB)=0.0
      BURN1(:NCH,:NB)=0.0
      WPAR(:NCH,:NB,:NPARM)=0.0
      LPARM(:NPARM+1)=.FALSE.
      IF(IBTYP.EQ.0) THEN
         CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
         IBTYP=ISTATE(5)
      ENDIF
      IF((IBTYP.EQ.0).AND.(HNAVAL.NE.' '))THEN
*       USE THE BURNUP OF A NEIGHBOUR ASSEMBLY
        IF(ISTATE(13).EQ.0)CALL XABORT('@NCRMAP: MISSING'
     1   //' S-ZONE VALUES IN FUEL MAP.')
        ALLOCATE(HSZONE(NCH))
        CALL LCMGTC(IPMAP,'S-ZONE',4,NCH,HSZONE)
        IICH=0
        DO ICH=1,NCH
          IF(HSZONE(ICH).EQ.HNAVAL) THEN
            IICH=ICH
            GO TO 20
          ENDIF
        ENDDO
        WRITE(HSMG,'(24H@NCRMAP: UNABLE TO FIND ,A,16H IN RECORD S-ZON,
     1  2HE.)') HNAVAL
        CALL XABORT(HSMG)
   20   DEALLOCATE(HSZONE)
        CALL LCMLEN(IPMAP,'BURN-INST',ILONG,ITYLCM)
        IF(ILONG.EQ.0)CALL XABORT('@NCRMAP: MISSING'
     1   //' BURN-INST VALUES IN FUEL MAP.')
        CALL LCMGET(IPMAP,'BURN-INST',BURNB)
        DO ICH=1,NCH
          DO IB=1,NB
            BURN0(ICH,IB)=BURNB(IICH,IB)
          ENDDO
        ENDDO
      ELSE IF((IBTYP.EQ.1).OR.(IBTYP.EQ.3))THEN
*       LOW BURNUP LIMITS
        CALL LCMLEN(IPMAP,'BURN-BEG',ILONG,ITYLCM)
        IF(ILONG.EQ.0)CALL XABORT('@NCRMAP: MISSING'
     1   //' BURN0 VALUES IN FUEL MAP.')
        CALL LCMGET(IPMAP,'BURN-BEG',BURN0)
*       UPPER BURNUP LIMITS
        CALL LCMLEN(IPMAP,'BURN-END',ILONG,ITYLCM)
        IF(ILONG.EQ.0)CALL XABORT('@NCRMAP: MISSING'
     1   //' BURN1 VALUES IN FUEL MAP.')
        CALL LCMGET(IPMAP,'BURN-END',BURN1)
        IF(IMPX.GT.0)WRITE(IOUT,1000)
        LPARM(NPARM+1)=.TRUE.
*----
*  INSTANTANEOUS BURNUP
*----
      ELSEIF(IBTYP.EQ.2)THEN
        CALL LCMLEN(IPMAP,'BURN-INST',ILONG,ITYLCM)
        IF(ILONG.EQ.0)CALL XABORT('@NCRMAP: MISSING'
     1   //' BURN-INST VALUES IN FUEL MAP.')
        CALL LCMGET(IPMAP,'BURN-INST',BURNB)
        DO ICH=1,NCH
          DO IB=1,NB
            BURN0(ICH,IB)=BURNB(ICH,IB)
            BURN1(ICH,IB)=BURNB(ICH,IB)
          ENDDO
        ENDDO
        IF(IMPX.GT.0)WRITE(IOUT,1001)
        LPARM(NPARM+1)=.TRUE.
      ELSEIF(IBTYP.NE.0)THEN
        CALL XABORT('@NCRMAP: INVALID BURNUP INTERPOLATION OPTION '
     1  //'IBTYP IN FUEL MAP.')
      ENDIF
*----
*  RECOVER OTHER PARAMETERS
*----
      IF(NPARM.GT.0) THEN
        JPMAP=LCMGID(IPMAP,'PARAM')
        DO 30 JPARM=1,NPARM
          KPMAP=LCMGIL(JPMAP,JPARM)
          CALL LCMGTC(KPMAP,'PARKEY',12,HPARM(JPARM))
          CALL LCMGET(KPMAP,'P-TYPE',ITYPEP)
          LPARM(JPARM)=.TRUE.
*       Global parameter
          IF(ITYPEP.EQ.1) THEN
            CALL LCMLEN(KPMAP,'P-VALUE',ILONG,ITYLCM)
            IF(ILONG.NE.1) THEN
              WRITE(HSMG,'(37H@NCRMAP: P-VALUE LENGTH OF PARAMETER ,A,
     1        12H IS EQUAL TO,I6,13H (MUST BE 1).)') HPARM(JPARM),ILONG
              CALL XABORT(HSMG)
            ENDIF
            CALL LCMGET(KPMAP,'P-VALUE',VARTMP)
            WPAR(:NCH,:NB,JPARM)=VARTMP
*       Local parameter
          ELSEIF (ITYPEP.EQ.2) THEN
            CALL LCMGET(KPMAP,'P-VALUE',WPAR(1,1,JPARM))
          ENDIF
   30   CONTINUE
      ENDIF
*----
*  SCRATCH STORAGE DEALLOCATION
*----
      DEALLOCATE(BURNB)
      RETURN
*
 1000 FORMAT(/1X,'** PERFORMING THE TIME-AVERAGE',
     1 1X,'INTEGRATION OVER THE FUEL LATTICE **'/)
 1001 FORMAT(/1X,'** PERFORMING THE INSTANTANEOU',
     1'S INTERPOLATION OVER THE FUEL LATTICE **'/)
      END