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
|
*DECK NEWMDV
SUBROUTINE NEWMDV(IPMTX,IPMAC,IPMAC2,IPDEV,NMIX,NGRP,NL,NDEL,LEAK,
1 NEL,LX,LY,LZ,XFAC,IMPX)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Update the material properties and store them in a new macrolib.
*
*Copyright:
* Copyright (C) 2007 Ecole Polytechnique de Montreal.
*
*Author(s):
* D. Sekki
*
*Parameters: input
* IPMTX pointer to matex information.
* IPMAC pointer to create mode macrolib.
* IPMAC2 pointer to read-only mode macrolib.
* IPDEV pointer to device information.
* NMIX maximum number of material mixtures.
* NGRP number of energy groups.
* NL number of legendre orders (=1 for isotropic scattering).
* NDEL number of precursor groups for delayed neutron.
* LEAK diffusion coefficient flag (=1: isotropic; =2: anisotropic).
* NEL total number of elements.
* LX number of elements along x-axis.
* LY number of elements along y-axis.
* LZ number of elements along z-axis.
* XFAC corrective factor for delta sigmas.
* IMPX printing index (=0 for no print).
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPMTX,IPMAC,IPMAC2,IPDEV
INTEGER NMIX,NGRP,NL,NDEL,LEAK,NEL,LX,LY,LZ
REAL XFAC
*----
* LOCAL VARIABLES
*----
PARAMETER(NSTATE=40,IOUT=6,EPSI=1.0E-4,MAXPRT=10)
INTEGER INDX(NEL),ISTATE(NSTATE),DMIX(2,MAXPRT),INAME(3)
REAL MESHX(LX+1),MESHY(LY+1),MESHZ(LZ+1),DPOS(6,MAXPRT),LEVEL
CHARACTER RNAME*12
TYPE(C_PTR) JPDEV,KPDEV
*----
* ALLOCATABLE ARRAYS
*----
INTEGER, ALLOCATABLE, DIMENSION(:) :: IJJ,NJJ
REAL, ALLOCATABLE, DIMENSION(:) :: TOT0,TOT1,ZNUS,CHI,SIGF,DIFX,
1 DIFY,DIFZ,HFAC,SCAT
*----
* SCRATCH STORAGE ALLOCATION
*----
ALLOCATE(IJJ(NMIX*NGRP*NL),NJJ(NMIX*NGRP*NL),TOT0(NMIX*NGRP),
1 TOT1(NMIX*NGRP),ZNUS(NMIX*NGRP*(NDEL+1)),CHI(NMIX*NGRP*(NDEL+1)),
2 SIGF(NMIX*NGRP),DIFX(NMIX*NGRP),DIFY(NMIX*NGRP),DIFZ(NMIX*NGRP),
3 HFAC(NMIX*NGRP),SCAT(NMIX*NL*NGRP*NGRP))
*----
* RECOVER EXISTING PROPERTIES
*----
CALL NEWMGT(IPMAC2,NMIX,NGRP,NL,NDEL,LEAK,TOT0,TOT1,ZNUS,CHI,SIGF,
1 DIFX,DIFY,DIFZ,HFAC,IJJ,NJJ,SCAT)
*----
* RECOVER MATEX INFORMATION
*----
MESHX(:LX+1)=0.0
MESHY(:LY+1)=0.0
MESHZ(:LZ+1)=0.0
CALL LCMGET(IPMTX,'MESHX',MESHX)
CALL LCMGET(IPMTX,'MESHY',MESHY)
CALL LCMGET(IPMTX,'MESHZ',MESHZ)
INDX(:NEL)=0
CALL LCMGET(IPMTX,'INDEX',INDX)
CALL LCMGET(IPDEV,'STATE-VECTOR',ISTATE)
IF(ISTATE(2).EQ.0)GOTO 30
*----
* UPDATE ROD PROPERTIES
*----
ITOT=0
NROD=ISTATE(2)
JPDEV=LCMGID(IPDEV,'DEV_ROD')
IF(IMPX.GT.0)WRITE(IOUT,1000)
DO 20 ID=1,NROD
KPDEV=LCMGIL(JPDEV,ID)
IF(IMPX.GT.5)CALL LCMLIB(KPDEV)
CALL LCMGET(KPDEV,'LEVEL',LEVEL)
IF(LEVEL.LT.EPSI)GOTO 20
CALL LCMGET(KPDEV,'ROD-NAME',INAME)
WRITE(RNAME,'(3A4)') (INAME(I),I=1,3)
CALL LCMGET(KPDEV,'ROD-PARTS',NPART)
IF(NPART.GT.MAXPRT) CALL XABORT('NEWMDV: MAXPRT OVERFLOW.')
CALL LCMGET(KPDEV,'ROD-POS',DPOS)
CALL LCMGET(KPDEV,'ROD-MIX',DMIX)
DO 10 IPART=1,NPART
IF(IMPX.GT.2)WRITE(IOUT,1001)ID,IPART,RNAME,LEVEL,DPOS(1,IPART)
CALL NEWMVF(INDX,DPOS(1,IPART),DMIX(1,IPART),NGRP,NL,NDEL,LEAK,
1 NEL,NMIX,LX,LY,LZ,MESHX,MESHY,MESHZ,TOT0,TOT1,ZNUS,CHI,SIGF,DIFX,
2 DIFY,DIFZ,HFAC,SCAT,XFAC,IMPX)
IF(IMPX.GT.2)WRITE(IOUT,1002)
10 CONTINUE
ITOT=ITOT+1
20 CONTINUE
IF(IMPX.GT.0)WRITE(IOUT,1003)ITOT
30 IF(ISTATE(4).EQ.0)GOTO 50
*----
* UPDATE LZC PROPERTIES
*----
ITOT=0
NLZC=ISTATE(4)
JPDEV=LCMGID(IPDEV,'DEV_LZC')
IF(IMPX.GT.0)WRITE(IOUT,1004)
DO 40 ID=1,NLZC
KPDEV=LCMGIL(JPDEV,ID)
IF(IMPX.GT.2)WRITE(IOUT,1005)ID
IF(IMPX.GT.5)CALL LCMLIB(KPDEV)
* EMPTY-PART
CALL LCMGET(KPDEV,'EMPTY-POS',DPOS)
CALL LCMGET(KPDEV,'EMPTY-MIX',DMIX)
IF(IMPX.GT.2)WRITE(IOUT,1006)DPOS
CALL NEWMVF(INDX,DPOS(1,1),DMIX(1,1),NGRP,NL,NDEL,LEAK,NEL,NMIX,
1 LX,LY,LZ,MESHX,MESHY,MESHZ,TOT0,TOT1,ZNUS,CHI,SIGF,DIFX,DIFY,
2 DIFZ,HFAC,SCAT,XFAC,IMPX)
* FULL-PART
CALL LCMGET(KPDEV,'FULL-POS',DPOS)
CALL LCMGET(KPDEV,'FULL-MIX',DMIX)
IF(IMPX.GT.2)WRITE(IOUT,1007)DPOS
CALL NEWMVF(INDX,DPOS(1,1),DMIX(1,1),NGRP,NL,NDEL,LEAK,NEL,NMIX,
1 LX,LY,LZ,MESHX,MESHY,MESHZ,TOT0,TOT1,ZNUS,CHI,SIGF,DIFX,DIFY,
2 DIFZ,HFAC,SCAT,XFAC,IMPX)
IF(IMPX.GT.2)WRITE(IOUT,1002)
ITOT=ITOT+1
40 CONTINUE
IF(IMPX.GT.0)WRITE(IOUT,1008)ITOT
*----
* STORE NEW PROPERTIES
*----
50 CALL NEWMPT(IPMAC,NMIX,NGRP,NL,NDEL,LEAK,TOT0,TOT1,ZNUS,CHI,SIGF,
1 DIFX,DIFY,DIFZ,HFAC,IJJ,NJJ,SCAT)
*----
* SCRATCH STORAGE DEALLOCATION
*----
DEALLOCATE(NJJ,IJJ,SCAT,HFAC,DIFZ,DIFY,DIFX,SIGF,CHI,ZNUS,TOT1,
1 TOT0)
RETURN
*
1000 FORMAT(/1X,'**',1X,'UPDATING PROPERTIES',
1 1X,'FOR ALL INSERTED RODS',1X,'**'/)
1001 FORMAT(
1 /5X,'=>',2X,'ROD-ID #',I3.3,' PART:',I4,5X,'ROD-NAME:',1X,A
2 /1X,'ROD INSERTION LEVEL =',F8.4
3 /1X,'CURRENT ROD POSITION :'
4 /1X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4
5 /1X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4)
1002 FORMAT(/1X,38('-')/)
1003 FORMAT(/1X,'TOTAL NUMBER OF TREATED RODS:',I3/)
*
1004 FORMAT(/1X,'**',1X,'UPDATING PROPERTIES',
1 1X,'FOR ALL LZC-DEVICES',1X,'**'/)
1005 FORMAT(/5X,'=>',2X,'LZC-ID #',I2.2)
1006 FORMAT(/1X,'EMPTY-PART POSITION :'
1 /1X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4
2 /1X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4)
1007 FORMAT(/1X,'FULL-PART POSITION :'
1 /1X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4
2 /1X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4)
1008 FORMAT(/1X,'TOTAL NUMBER OF TREATED LZC:',I2/)
END
|
