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
|
*DECK SPHEMB
SUBROUTINE SPHEMB(IPLIB,IPCPO,NGRP,NMIX,MIXUPD,IMPX)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Build embedded macrolib and recover depletion data from the
* multicompo.
*
*Copyright:
* Copyright (C) 2008 Ecole Polytechnique de Montreal
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version
*
*Author(s): A. Hebert, R. Chambon
*
*Parameters: input/output
* IPLIB address of the microlib LCM object.
* IPCPO address of the multicompo object.
* NGRP number of energy groups.
* NMIX maximum number of material mixtures in the microlib.
* MIXUPD tag for mixture which will be updated.
* IMPX print parameter (equal to zero for no print).
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPLIB,IPCPO
INTEGER NGRP,NMIX
INTEGER MIXUPD(NMIX)
*----
* LOCAL VARIABLES
*----
PARAMETER (NSTATE=40,IOUT=6)
CHARACTER HSMG*131
INTEGER ISTATE(NSTATE),IST1(NSTATE),IST2(NSTATE)
REAL TMPDAY(3)
LOGICAL, ALLOCATABLE, DIMENSION(:) :: MASK,MASKL
INTEGER, POINTER, DIMENSION(:) :: ISONA,ISOMI
REAL, POINTER, DIMENSION(:) :: DENIS
TYPE(C_PTR) ISONA_PTR,ISOMI_PTR,DENIS_PTR
*----
* RECOVER THE DEPLETION CHAIN
*----
CALL LCMLEN(IPLIB,'DEPL-CHAIN',ILENG1,ITYLCM)
CALL LCMLEN(IPCPO,'DEPL-CHAIN',ILENG2,ITYLCM)
IF((ILENG1.NE.0).AND.(ILENG2.NE.0)) THEN
CALL LCMSIX(IPCPO,'DEPL-CHAIN',1)
CALL LCMGET(IPCPO,'STATE-VECTOR',IST1)
CALL LCMSIX(IPCPO,' ',2)
CALL LCMSIX(IPLIB,'DEPL-CHAIN',1)
CALL LCMGET(IPLIB,'STATE-VECTOR',IST2)
CALL LCMSIX(IPLIB,' ',2)
DO 100 I=1,NSTATE
IF(IST1(I).NE.IST2(I)) THEN
WRITE(HSMG,'(40HSPHEMB: INVALID STATE-VECTOR COMPONENT (,I2,
1 36H) FOR DEPL-CHAIN DATA IN MULTICOMPO ,1H.)') I
CALL XABORT(HSMG)
ENDIF
100 CONTINUE
ELSE IF((ILENG1.EQ.0).AND.(ILENG2.NE.0)) THEN
CALL LCMSIX(IPCPO,'DEPL-CHAIN',1)
CALL LCMSIX(IPLIB,'DEPL-CHAIN',1)
CALL LCMEQU(IPCPO,IPLIB)
CALL LCMSIX(IPLIB,' ',2)
CALL LCMSIX(IPCPO,' ',2)
ENDIF
*----
* COMPUTE THE MACROSCOPIC X-SECTIONS
*----
CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
MAXMIX=ISTATE(1)
IF(MAXMIX.NE.NMIX) CALL XABORT('SPHEMB: INVALID NMIX.')
NBISO=ISTATE(2)
ALLOCATE(MASK(MAXMIX),MASKL(NGRP))
CALL LCMGPD(IPLIB,'ISOTOPESUSED',ISONA_PTR)
CALL LCMGPD(IPLIB,'ISOTOPESMIX',ISOMI_PTR)
CALL LCMGPD(IPLIB,'ISOTOPESDENS',DENIS_PTR)
CALL C_F_POINTER(ISONA_PTR,ISONA,(/ NBISO /))
CALL C_F_POINTER(ISOMI_PTR,ISOMI,(/ NBISO /))
CALL C_F_POINTER(DENIS_PTR,DENIS,(/ NBISO /))
MASK(:MAXMIX)=.FALSE.
MASKL(:NGRP)=.TRUE.
DO 110 ISOT=1,NBISO
IBM=ISOMI(ISOT)
IF(IBM.GT.0) THEN
IF(MIXUPD(IBM).NE.0) MASK(IBM)=.TRUE.
ENDIF
110 CONTINUE
ITSTMP=0
TMPDAY(1)=0.0
TMPDAY(2)=0.0
TMPDAY(3)=0.0
CALL LIBMIX(IPLIB,MAXMIX,NGRP,NBISO,ISONA,ISOMI,DENIS,MASK,MASKL,
1 ITSTMP,TMPDAY)
DEALLOCATE(MASKL,MASK)
*----
* RECOVER GENERAL INFORMATION FROM MICROLIB
*----
B2=0.0
CALL LCMLEN(IPLIB,'K-EFFECTIVE',ILENG,ITYLCM)
IF(ILENG.EQ.1) THEN
CALL LCMGET(IPLIB,'K-EFFECTIVE',FLOTT)
CALL LCMSIX(IPLIB,'MACROLIB',1)
CALL LCMPUT(IPLIB,'K-EFFECTIVE',1,2,FLOTT)
CALL LCMSIX(IPLIB,' ',2)
IF(IMPX.GT.1) THEN
WRITE(6,'(22H SPHCPO: K-EFFECTIVE =,1P,E13.6)') FLOTT
ENDIF
ENDIF
CALL LCMLEN(IPLIB,'K-INFINITY',ILENG,ITYLCM)
IF(ILENG.EQ.1) THEN
CALL LCMGET(IPLIB,'K-INFINITY',FLOTT)
CALL LCMSIX(IPLIB,'MACROLIB',1)
CALL LCMPUT(IPLIB,'K-INFINITY',1,2,FLOTT)
CALL LCMSIX(IPLIB,' ',2)
IF(IMPX.GT.1) THEN
WRITE(6,'(21H SPHCPO: K-INFINITY =,1P,E13.6)') FLOTT
ENDIF
ENDIF
CALL LCMLEN(IPLIB,'B2 B1HOM',ILENG,ITYLCM)
IF(ILENG.EQ.1) THEN
CALL LCMGET(IPLIB,'B2 B1HOM',B2)
CALL LCMSIX(IPLIB,'MACROLIB',1)
CALL LCMPUT(IPLIB,'B2 B1HOM',1,2,B2)
CALL LCMSIX(IPLIB,' ',2)
IF(IMPX.GT.1) THEN
WRITE(6,'(13H SPHCPO: B2 =,1P,E14.6)') B2
ENDIF
ENDIF
RETURN
END
|
