summaryrefslogtreecommitdiff
path: root/Donjon/src/SIMPOS.f
blob: b01d1f077acac0c466bb86b16403505e59b28b58 (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
*DECK SIMPOS
      SUBROUTINE SIMPOS(LX,LY,NCH,NB,HCYC,HOLD,HHX,IHY,ZONE,INFMIX,
     > NIS,CYCLE,NAME,BURNUP,FMIX,RFOLLO,ONAME,OBURNU,OFMIX,OFOLLO)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Set the correspondance between assembly indices during refuelling.
*
*Copyright:
* Copyright (C) 2013 Ecole Polytechnique de Montreal
*
*Author(s): 
* A. Hebert
*
*Parameters: input/output
* LX      number of assemblies along the X axis.
* LY      number of assemblies along the Y axis.
* NCH     number of assemblies or number of quart-of-assemblies.
* NB      number of axial burnup subdivisions in an assembly.
* HCYC    name of cycle.
* HOLD    name of previous cycle.
* HHX     naval battle indices along X axis.
* IHY     naval battle indices along Y axis.
* ZONE    default assembly or quart-of-assembly names as defined in
*         the fuel map.
* INFMIX  assembly types as defined in the fuel map.
* NIS     number of particularized isotopes.
* CYCLE   shuffling matrix for refuelling as provided by the plant
*         operator. The name "|" is reserved for empty locations. 
* NAME    names of each assembly or of each quart-of assembly during
*         a refuelling cycle. All quart-of-assembly belonging to the
*         same assembly have the same name.
* BURNUP  burnups during a refuelling cycle. A value of -999.0 means
*         a non-initialized value.
* FMIX    assembly mixtures after refuelling.
* RFOLLO  number densities of the particularized isotopes after
*         refuelling.
* ONAME   names of each assembly or of each quart-of assembly during
*         a previous refuelling cycle.
* OBURNU  burnups during a previous refuelling cycle.
* OFMIX   assembly types in a previous refuelling cycle.
* OFOLLO  number densities of the particularized isotopes at the end
*         of a previous refuelling cycle.
*
*-----------------------------------------------------------------------
*
*----
*  SUBROUTINE ARGUMENTS
*----
      INTEGER LX,LY,NCH,NB,IHY(LY),INFMIX(NCH,NB),NIS,FMIX(NCH,NB),
     > OFMIX(NCH,NB)
      CHARACTER HCYC*12,HOLD*12,HHX(LX)*1,ZONE(NCH)*4,CYCLE(LX,LY)*4,
     > NAME(NCH)*12,ONAME(NCH)*12
      REAL BURNUP(NCH,NB),RFOLLO(NCH,NB,NIS),OBURNU(NCH,NB),
     > OFOLLO(NCH,NB,NIS)
*----
*  LOCAL VARIABLES
*----
      CHARACTER TEXT4*4,TEXT1*1,HSMG*131
      CHARACTER(LEN=4), ALLOCATABLE, DIMENSION(:) :: ZONE2
*----
*  SCRATCH STORAGE ALLOCATION
*----
      ALLOCATE(ZONE2(NCH))
*
      MAXINF=0
      DO 10 ICH=1,NCH
      MAXINF=MAX(MAXINF,MAXVAL(INFMIX(ICH,:NB)))
      ZONE2(ICH)=ZONE(ICH)
   10 CONTINUE
      DO ICH=1,NCH
        TEXT4=ZONE(ICH)
        READ(TEXT4,'(A1,I2)') TEXT1,INTG2
        INDX=0
        DO IX=1,LX
          IF(TEXT1.EQ.HHX(IX)) INDX=IX
        ENDDO
        IF(INDX.EQ.0) CALL XABORT('@SIMPOS: UNABLE TO FIND INDX.')
        INDY=0
        DO IY=1,LY
          IF(INTG2.EQ.IHY(IY)) INDY=IY
        ENDDO
        IF(INDY.EQ.0) CALL XABORT('@SIMPOS: UNABLE TO FIND INDY.')
        TEXT4=CYCLE(INDX,INDY)
        IF((TEXT4.EQ.'|').OR.(TEXT4.EQ.'-').OR.(TEXT4.EQ.'-|-')) THEN
          WRITE(HSMG,'(16H@SIMPOS: CHANNEL,I4,21H REFERS TO LOCATION (,
     >    I4,1H,,I4,37H) WHICH IS OUTSIDE THE CORE AT CYCLE ,A12,1H.)')
     >    ICH,INDX,INDY,HCYC
          CALL XABORT(HSMG)
        ELSE IF(TEXT4.EQ.'SPC') THEN
          DO IB=1,NB
            BURNUP(ICH,IB)=-999.0
            FMIX(ICH,IB)=INFMIX(ICH,IB)
            DO ISO=1,NIS
              RFOLLO(ICH,IB,ISO)=0.0
            ENDDO
          ENDDO
          WRITE(NAME(ICH),'(A3,1H/,A8)') TEXT4(:3),HCYC(:8)
        ELSE IF(TEXT4.EQ.'NEW') THEN
          DO IB=1,NB
            BURNUP(ICH,IB)=0.0
            FMIX(ICH,IB)=INFMIX(ICH,IB)
            DO ISO=1,NIS
              RFOLLO(ICH,IB,ISO)=0.0
            ENDDO
          ENDDO
          WRITE(NAME(ICH),'(A3,1H/,A8)') TEXT4(:3),HCYC(:8)
        ELSE IF(TEXT4(4:).EQ.'@') THEN
          READ(TEXT4,'(I3,1X)') NITMA
          IF(NITMA.GT.MAXINF) CALL XABORT('@SIMPOS: MAXINF OVERFLOW.')
          DO IB=1,NB
            BURNUP(ICH,IB)=0.0
            FMIX(ICH,IB)=INFMIX(ICH,IB)
            IF(INFMIX(ICH,IB).NE.0) FMIX(ICH,IB)=NITMA
            DO ISO=1,NIS
              RFOLLO(ICH,IB,ISO)=0.0
            ENDDO
          ENDDO
          WRITE(NAME(ICH),'(A3,1H/,A8)') 'NEW',HCYC(:8)
        ELSE
          IF(HOLD.EQ.' ') CALL XABORT('@SIMPOS: NO PREVIOUS CYCLE.')
          IOLD=0
          DO ICH2=1,NCH
            IF(ZONE2(ICH2).EQ.TEXT4) THEN
              IOLD=ICH2
              ZONE2(ICH2)=' '
              GO TO 20
            ENDIF
          ENDDO
          WRITE(HSMG,'(33H@SIMPOS: UNABLE TO FIND ASSEMBLY ,A4,
     >    25HIN THE FUEL MAP AT CYCLE ,A12,1H.)') TEXT4,HCYC
          CALL XABORT(HSMG)
   20     DO IB=1,NB
            BURNUP(ICH,IB)=OBURNU(IOLD,IB)
            FMIX(ICH,IB)=OFMIX(IOLD,IB)
            DO ISO=1,NIS
              RFOLLO(ICH,IB,ISO)=OFOLLO(IOLD,IB,ISO)
            ENDDO
          ENDDO
          NAME(ICH)=ONAME(IOLD)
        ENDIF
      ENDDO
*----
*  SCRATCH STORAGE DEALLOCATION
*----
      DEALLOCATE(ZONE2)
      RETURN
      END