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
|
*DECK RESHID
SUBROUTINE RESHID(IPMAP,IPMTX,NX,NZ,LX,LZ,MIX,NFUEL,IMPX)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Update material index, it will store the negative fuel mixtures.
*
*Copyright:
* Copyright (C) 2007 Ecole Polytechnique de Montreal.
*
*Author(s):
* V. Descotes
*
*Parameters: input/output
* IPMAP pointer to fuel-map information.
* IPMTX pointer to matex information.
* NX number of elements along x-axis in fuel map.
* NZ number of elements along z-axis in fuel map.
* LX number of elements along x-axis in geometry.
* LZ number of elements along z-axis in geometry.
* MIX renumbered index over the fuel-map geometry.
* NFUEL number of fuel types.
* IMPX printing index (=0 for no print).
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPMAP,IPMTX
INTEGER NX,NZ,LX,LZ,MIX(NX*NZ),NFUEL,IMPX
*----
* LOCAL VARIABLES
*----
PARAMETER(IOUT=6)
INTEGER ISPLTY(1),NCODE(6)
REAL MTXSIDE,MAPSIDE
TYPE(C_PTR) JPMAP
*----
* ALLOCATABLE ARRAYS
*----
INTEGER, ALLOCATABLE, DIMENSION(:) :: IMAT,ISPLTX,ISPLTZ,INDX,
1 FTOT,DPP,MX
REAL, ALLOCATABLE, DIMENSION(:) :: MAPZZ,GEOZZ
*----
* SCRATCH STORAGE ALLOCATION
*----
ALLOCATE(ISPLTX(LX),ISPLTZ(LZ),INDX(LX*LZ),FTOT(NFUEL))
ALLOCATE(MAPZZ(NZ+1),GEOZZ(LZ+1))
*----
* RECOVER GEOMETRY AND FUELMAP INFORMATION
*----
CALL LCMGET(IPMTX,'SIDE',MTXSIDE)
CALL LCMGET(IPMTX,'MESHZ',GEOZZ)
JPMAP=LCMGID(IPMAP,'GEOMAP')
CALL LCMGET(JPMAP,'IHEX',IHEX)
CALL LCMGET(JPMAP,'SIDE',MAPSIDE)
CALL LCMGET(JPMAP,'MESHZ',MAPZZ)
ISPLTL=0
CALL LCMLEN(JPMAP,'SPLITL',ILONG,ITYLCM)
IF(ILONG.NE.0) CALL LCMGET(JPMAP,'SPLITL',ISPLTL)
*----
* UNFOLD GEOMETRY IF HEXAGONAL IN LOZENGES
*----
IF((ISPLTL.GT.0).AND.(IHEX.NE.9)) THEN
MAXPTS=LX*LZ
ALLOCATE(DPP(MAXPTS),MX(NX*NZ))
DO 10 I=1,NX*NZ
MX(I)=MIX(I)
10 CONTINUE
NXOLD=NX
CALL BIVALL(MAXPTS,IHEX,NXOLD,NX,DPP)
DO 30 KZ=1,NZ
DO 20 KX=1,NX
KEL=DPP(KX)+(KZ-1)*NXOLD
INDX(KX+(KZ-1)*NX)=MX(KEL)
20 CONTINUE
30 CONTINUE
DEALLOCATE(DPP,MX)
IHEX=9
ELSE
INDX(:NX*NZ)=MIX(:NX*NZ)
ENDIF
*----
* FUELMAP INFORMATION SPLITTING
*----
NY=1
ITYPE=9
ISPLTX(:NX)=1
ISPLTY(:NY)=1
IZ=1
DO KM=1,NZ
ISPLTZ(KM)=0
DO JZ=IZ,LZ
IF(GEOZZ(JZ+1).LE.MAPZZ(KM+1)) THEN
ISPLTZ(KM)=ISPLTZ(KM)+1
ELSE
IZ=JZ
EXIT
ENDIF
ENDDO
ENDDO
MAXPTS=LX*LZ
LX1=LX
LY1=1
LZ1=LZ
CALL SPLIT0 (MAXPTS,ITYPE,NCODE,NX,NY,NZ,ISPLTX,ISPLTY,ISPLTZ,
1 0,ISPLTL,NMBLK,LX1,LY1,LZ1,MAPSIDE,XXX,YYY,ZZZ,INDX,.FALSE.,
2 IMPX)
IF(ISPLTL.GT.0) MAPSIDE=MAPSIDE/REAL(ISPLTL)
IF(ABS(MAPSIDE-MTXSIDE).GT.1.0E-6) CALL XABORT('RESHID: INVALID '
1 //'SIDE.')
* CHECK TOTAL NUMBER
ITOT=0
DO 40 IEL=1,LX*LZ
IF(INDX(IEL).NE.0)ITOT=ITOT+1
40 CONTINUE
NTOT=0
CALL LCMGET(IPMTX,'FTOT',FTOT)
DO 50 IFUEL=1,NFUEL
NTOT=NTOT+FTOT(IFUEL)
50 CONTINUE
IF(ITOT.NE.NTOT) THEN
WRITE(IOUT,'(/15H @RESHID: ITOT=,I8,6H NTOT=,I8)') ITOT,NTOT
CALL XABORT('@RESHID: FOUND DIFFERENT TOTAL NUMBER OF FUEL MI'
1 //'XTURES IN FUEL-MAP AND MATEX.')
ENDIF
* STORE NEGATIVE FUEL MIXTURES
CALL LCMLEN(IPMTX,'MAT',LENGT,ITYP)
ALLOCATE(IMAT(LENGT))
IMAT(:LENGT)=0
CALL LCMGET(IPMTX,'MAT',IMAT)
DO 60 IEL=1,LX*LZ
IF(INDX(IEL).NE.0)IMAT(IEL)=-INDX(IEL)
60 CONTINUE
CALL LCMPUT(IPMTX,'MAT',LENGT,1,IMAT)
*----
* SCRATCH STORAGE DEALLOCATION
*----
DEALLOCATE(IMAT,GEOZZ,MAPZZ,FTOT,INDX,ISPLTZ,ISPLTX)
RETURN
END
|
