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
|
*DECK COMGFF
SUBROUTINE COMGFF(MPCPO,IPEDI2,FNORM,NGFF)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Recover the group form factor information from an edition object.
*
*Copyright:
* Copyright (C) 2015 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
*
*Parameters: input/output
* MPCPO pointer to a microlib directory of the multicompo.
* IPEDI2 pointer to the edition object containing group form factor
* information (L_EDIT signature).
* FNORM flux normalization factor.
* NGFF number of form factors per energy group (set to -1 if not
* initialized).
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) MPCPO,IPEDI2
REAL FNORM
INTEGER NGFF
*----
* LOCAL PARAMETERS
*----
TYPE(C_PTR) JPEDI2,KPEDI2
PARAMETER (NSTATE=40)
INTEGER ISTATE(NSTATE)
CHARACTER TEXT12*12
*----
* ALLOCATABLE ARRAYS
*----
REAL, ALLOCATABLE, DIMENSION(:) :: VOLUME
REAL, ALLOCATABLE, DIMENSION(:,:) :: FLUX,HFACT,SIGF
*----
* RECOVER GFF INFO FROM THE ROOT OF THE EDITION OBJECT
*----
CALL LCMGTC(IPEDI2,'SIGNATURE',12,TEXT12)
IF(TEXT12.NE.'L_EDIT') THEN
CALL XABORT('COMGFF: SIGNATURE OF OBJECT IS '//TEXT12//
1 '. L_EDIT EXPECTED.')
ENDIF
CALL LCMGET(IPEDI2,'STATE-VECTOR',ISTATE)
IF(NGFF.EQ.-1) THEN
NGFF=ISTATE(1)
ELSE IF(NGFF.NE.ISTATE(1)) THEN
CALL XABORT('COMGFF: INVALID NUMBER OF FORM FACTORS IN EDITIO'
1 //'N OBJECT.')
ENDIF
IF(ISTATE(20).EQ.0) CALL XABORT('COMGFF: MISSING MACRO-GEOMETRY '
1 //'IN EDITION OBJECT.')
CALL LCMSIX(MPCPO,'MACROLIB',1)
CALL LCMSIX(MPCPO,'GFF',1)
*----
* RECOVER THE MACRO-GEOMETRY
*----
CALL LCMSIX(IPEDI2,'MACRO-GEOM',1)
CALL LCMSIX(MPCPO,'GFF-GEOM',1)
CALL LCMEQU(IPEDI2,MPCPO)
CALL LCMSIX(MPCPO,' ',2)
CALL LCMSIX(IPEDI2,' ',2)
*----
* RECOVER GFF INFO FROM THE LAST-EDIT DIRECTORY IN THE EDITION OBJECT
*----
CALL LCMGTC(IPEDI2,'LAST-EDIT',12,TEXT12)
CALL LCMSIX(IPEDI2,TEXT12,1)
CALL LCMSIX(IPEDI2,'MACROLIB',1)
CALL LCMGET(IPEDI2,'STATE-VECTOR',ISTATE)
NG=ISTATE(1)
ALLOCATE(VOLUME(NGFF),FLUX(NGFF,NG),HFACT(NGFF,NG),
1 SIGF(NGFF,NG))
IF(NGFF.NE.ISTATE(2)) THEN
CALL XABORT('COMGFF: INVALID NUMBER OF FORM FACTORS IN MAC'
1 //'ROLIB OF THE EDTION OBJECT.')
ENDIF
CALL LCMGET(IPEDI2,'VOLUME',VOLUME)
JPEDI2=LCMGID(IPEDI2,'GROUP')
DO IG=1,NG
KPEDI2=LCMGIL(JPEDI2,IG)
CALL LCMGET(KPEDI2,'FLUX-INTG',FLUX(1,IG))
DO IBM=1,NGFF
FLUX(IBM,IG)=FNORM*FLUX(IBM,IG)/VOLUME(IBM)
ENDDO
CALL LCMGET(KPEDI2,'H-FACTOR',HFACT(1,IG))
CALL LCMGET(KPEDI2,'NFTOT',SIGF(1,IG))
ENDDO
CALL LCMPUT(MPCPO,'VOLUME',NGFF,2,VOLUME)
CALL LCMPUT(MPCPO,'NWT0',NGFF*NG,2,FLUX)
CALL LCMPUT(MPCPO,'H-FACTOR',NGFF*NG,2,HFACT)
CALL LCMPUT(MPCPO,'NFTOT',NGFF*NG,2,SIGF)
DEALLOCATE(SIGF,HFACT,FLUX,VOLUME)
CALL LCMSIX(IPEDI2,' ',2)
CALL LCMSIX(IPEDI2,' ',2)
CALL LCMSIX(MPCPO,' ',2)
*----
* SET STATE-VECTOR INDEX FOR MICROLIB IN MULTICOMPO
*----
CALL LCMLEN(MPCPO,'STATE-VECTOR',ILONG,ITYLCM)
IF(ILONG.NE.0) THEN
CALL LCMGET(MPCPO,'STATE-VECTOR',ISTATE)
ISTATE(16)=NGFF
CALL LCMPUT(MPCPO,'STATE-VECTOR',NSTATE,1,ISTATE)
ENDIF
CALL LCMSIX(MPCPO,' ',2)
RETURN
END
|
