summaryrefslogtreecommitdiff
path: root/Donjon/src/RESPFM.f
blob: 17b48a47179a6b20d209a577693949b0e88917e1 (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
*DECK RESPFM
      SUBROUTINE RESPFM(IPMAP,IPMTX,NX,NY,NZ,LX,LY,LZ,NFUEL,IMPX,IGEO,
     > NCH,NB,NTOT)
*
*-----------------------------------------------------------------------
*
*Purpose:
* recover, check and store the fuel mixtures.
*
*Copyright:
* Copyright (C) 2007 Ecole Polytechnique de Montreal.
*
*Author(s): 
* D. Sekki
*
*Parameters: input/output
* IPMAP  pointer to fuel-map information.
* IPMTX  pointer to matex information.
* 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.
* LX     number of elements along x-axis in geometry.
* LY     number of elements along y-axis in geometry.
* LZ     number of elements along z-axis in geometry.
* NFUEL  number of fuel types.
* IMPX   printing index (=0 for no print).
* IGEO   type of geometry (=7 or =9)
*
*Parameters: output
* NCH    number of fuel channels.
* NB     number of fuel bundles per channel.
* NTOT   total number of fuel bundles.
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      TYPE(C_PTR) IPMAP,IPMTX
      INTEGER NX,NY,NZ,LX,LY,LZ,NFUEL,IMPX,IGEO,NCH,NB,NTOT
      TYPE(C_PTR) JPMAP,KPMAP
*----
*  LOCAL VARIABLES
*----
      PARAMETER(IOUT=6)
*----
*  ALLOCATABLE ARRAYS
*----
      INTEGER, ALLOCATABLE, DIMENSION(:) :: MIX,FMIX,FTOT,IFLMIX
*----
*  SCRATCH STORAGE ALLOCATION
*----
      ALLOCATE(MIX(NX*NY*NZ),FMIX(NFUEL),FTOT(NFUEL))
*----
*  COMPUTE NUMBER OF FUEL CHANNELS AND NUMBER OF FUEL BUNDLES
*----
      IF(IMPX.GT.2) WRITE(IOUT,*)'SETTING FUEL-MAP MIXTURES'
      IF((IGEO.NE.7).AND.(IGEO.NE.9))THEN
        CALL XABORT('@RESPFM: WRONG TYPE OF GEOMETRY, 3D-CARTESIAN OR '
     >  //'3D-HEXAGONAL GEOMETRY EXPECTED')
      ENDIF
      MIX(:NX*NY*NZ)=0
      CALL LCMGET(IPMAP,'MIX',MIX)
      NB=0
      DO IZ=1,NZ
        DO I=1,NX*NY
          IEL=(IZ-1)*NX*NY+I
          IF(MIX(IEL).NE.0) GOTO 10
        ENDDO
        CYCLE
   10   NB=NB+1
      ENDDO
      NCH=0
      DO I=1,NX*NY
        DO IZ=1,NZ
          IEL=(IZ-1)*NX*NY+I
          IF(MIX(IEL).NE.0) GOTO 20
        ENDDO
        CYCLE
   20   NCH=NCH+1
      ENDDO
      IF(IMPX.GT.0) WRITE(6,100) NCH,NB
      ALLOCATE(IFLMIX(NCH*NB))
*----
*  COMPUTE FLMIX AND FTOT
*----
      FMIX(:NFUEL)=0
      CALL LCMGET(IPMTX,'FMIX',FMIX)
      FTOT(:NFUEL)=0
      IFLMIX(:NCH*NB)=0
      NTOT=0
      IB=0
      DO 50 IZ=1,NZ
      DO I=1,NX*NY
         IEL=(IZ-1)*NX*NY+I
         IF(MIX(IEL).NE.0) GOTO 30
      ENDDO
      GO TO 50
   30 IB=IB+1
      IF(IB.GT.NB) CALL XABORT('@RESPFM: NB OVERFLOW.')
      ICH=0
      DO 40 I=1,NX*NY
      DO K=1,NZ
        IF(MIX((K-1)*NX*NY+I).NE.0) GOTO 35
      ENDDO
      GO TO 40
   35 IEL=(IZ-1)*NX*NY+I
      ICH=ICH+1
      IF(ICH.GT.NCH) CALL XABORT('@RESPFM: NCH OVERFLOW.')
      IFLMIX((IB-1)*NCH+ICH)=MIX(IEL)
      IF(MIX(IEL).EQ.0) GO TO 40
      DO IFUEL=1,NFUEL
        IF(MIX(IEL).EQ.FMIX(IFUEL))THEN
          FTOT(IFUEL)=FTOT(IFUEL)+1
          NTOT=NTOT+1
          IF(NTOT.GT.NCH*NB)THEN
            WRITE(IOUT,*)'@RESPFM: TOTAL NUMBER OF BUNDLES =',NCH*NB
            WRITE(IOUT,*)'@RESPFM: READ TOTAL FUEL MIXTURES ',NTOT
            CALL XABORT('@RESPFM: WRONG FUEL-MAP DEFINITION.')
          ENDIF
          GOTO 40
        ENDIF
      ENDDO
      WRITE(IOUT,*)'@RESPFM: READ FUEL MIXTURE NUMBER ',MIX(IEL)
      CALL XABORT('@RESPFM: WRONG FUEL MIXTURE NUMBER.')
   40 CONTINUE
   50 CONTINUE
      IF(IMPX.GT.0) WRITE(6,110) NTOT
*----
*  STORE FUEL MIXTURES
*----
      IF(IMPX.GT.2) WRITE(IOUT,*)'STORING FUEL MIXTURES'
*     FUEL DIRECTORIES
      CALL LCMSIX(IPMAP,' ',0)
      JPMAP=LCMLID(IPMAP,'FUEL',NFUEL)
      DO IFUEL=1,NFUEL
        KPMAP=LCMDIL(JPMAP,IFUEL)
        CALL LCMPUT(KPMAP,'MIX',1,1,FMIX(IFUEL))
        CALL LCMPUT(KPMAP,'TOT',1,1,FTOT(IFUEL))
      ENDDO
      CALL LCMPUT(IPMAP,'FLMIX',NCH*NB,1,IFLMIX)
      DEALLOCATE(IFLMIX)
*     RENUMBERING
      NMIX=0
      DO IEL=1,NX*NY*NZ
        IF(MIX(IEL).NE.0)THEN
          NMIX=NMIX+1
          MIX(IEL)=NMIX
        ENDIF
      ENDDO
      CALL LCMPUT(IPMAP,'BMIX',NX*NY*NZ,1,MIX)
*     UPDATE MATERIAL INDEX
      IF(IGEO.EQ.7)THEN
        CALL RESIND(IPMAP,IPMTX,NX,NY,NZ,LX,LY,LZ,MIX,NFUEL,IMPX)
      ELSE IF(IGEO.EQ.9)THEN
        CALL RESHID(IPMAP,IPMTX,NX,NZ,LX,LZ,MIX,NFUEL,IMPX)
      ENDIF
*----
*  SCRATCH STORAGE DEALLOCATION
*----
      DEALLOCATE(FTOT,FMIX,MIX)
      RETURN
*
  100 FORMAT(/33H RESPFM: NUMBER OF FUEL CHANNELS=,I5/9X,10HNUMBER OF ,
     > 25HFUEL BUNDLES PER CHANNEL=,I5)
  110 FORMAT(9X,29HTOTAL NUMBER OF FUEL BUNDLES=,I8)
      END