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
173
174
175
176
|
*DECK APXCAL
SUBROUTINE APXCAL(IMPX,IPAPX,IPDEPL,IPEDIT,HEQUI)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Store the results of an elementary calculation in the Apex file
*
*Copyright:
* Copyright (C) 2025 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
* IMPX print parameter.
* IPAPX pointer to the Apex file.
* IPDEPL pointer to the burnup object (L_BURNUP signature).
* IPEDIT pointer to the edition object (L_EDIT signature).
* HEQUI keyword of SPH-factor set in the Apex file.
*
*-----------------------------------------------------------------------
*
USE GANLIB
USE hdf5_wrap
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPAPX,IPDEPL,IPEDIT,IPSPH
INTEGER IMPX
CHARACTER(LEN=80) HEQUI
*----
* LOCAL VARIABLES
*----
PARAMETER (NSTATE=40)
INTEGER IPAR(NSTATE)
REAL BIRRAD(2)
INTEGER RANK,TYPE,NBYTE,DIMSR(5)
CHARACTER RECNAM*80,RECNAM2*80,CDIRO*12,HSMG*131
*----
* ALLOCATABLE ARRAYS
*----
REAL, ALLOCATABLE, DIMENSION(:) :: VOLMIL,WORK1
REAL, ALLOCATABLE, DIMENSION(:,:) :: FLXMIL,RVAL0
*
CALL LCMGTC(IPEDIT,'LAST-EDIT',12,CDIRO)
CALL LCMSIX(IPEDIT,CDIRO,1)
CALL LCMLEN(IPEDIT,'STATE-VECTOR',ILONG,ITYLCM)
IF(ILONG.NE.0) THEN
CALL LCMGET(IPEDIT,'STATE-VECTOR',IPAR)
NBISO=IPAR(2)
NED=IPAR(13)
NPRC=IPAR(19)
NDFI=IPAR(20)
ELSE
NBISO=0
NDFI=0
ENDIF
CALL LCMSIX(IPEDIT,'MACROLIB',1)
CALL LCMGET(IPEDIT,'STATE-VECTOR',IPAR)
NG=IPAR(1)
NMIL=IPAR(2)
NL=IPAR(3)
IF(IPAR(4).GT.1) CALL XABORT('APXCAL: CANNOT PROCESS MULTIPLE FI'
1 //'SSION SPECTRA.')
NED=IPAR(5)
ITRANC=IPAR(6)
NPRC=IPAR(7)
NALBP=IPAR(8)
IDF=IPAR(12)
CALL LCMLEN(IPEDIT,'SPH',ILEN,ITYLCM)
IF(ILEN.NE.0) THEN
IPSPH=LCMGID(IPEDIT,'SPH')
CALL LCMGET(IPSPH,'STATE-VECTOR',IPAR)
IMC=IPAR(6)
ELSE
IMC=0
ENDIF
CALL hdf5_info(IPAPX,"/NCALS",RANK,TYPE,NBYTE,DIMSR)
IF(RANK.EQ.99) THEN
NCALS=0
ELSE
CALL hdf5_read_data(IPAPX,"/NCALS",NCALS)
ENDIF
ICAL=NCALS+1
CALL hdf5_write_data(IPAPX,"/NCALS",ICAL)
CALL LCMSIX(IPEDIT,' ',2)
WRITE(RECNAM,'(4Hcalc,I8,1H/)') ICAL
IF(IMPX.GT.0) WRITE(6,'(/19H APXCAL: NEW GROUP ,A)') TRIM(RECNAM)
CALL hdf5_create_group(IPAPX,RECNAM)
CALL hdf5_create_group(IPAPX,TRIM(RECNAM)//"miscellaneous/")
*----
* RECOVER THE FLUX NORMALIZATION FACTOR.
*----
IF(C_ASSOCIATED(IPDEPL)) THEN
CALL LCMGET(IPDEPL,'BURNUP-IRRAD',BIRRAD)
BURN=BIRRAD(1)
CALL LCMLEN(IPDEPL,'FLUX-NORM',ILONG,ITYLCM)
IF(ILONG.EQ.0) THEN
WRITE(HSMG,'(40HAPXCAL: THE ''FLUX-NORM'' RECORD IS NOT SE,
1 20HT FOR BURNUP STEP AT,E12.5,14H MW-DAY/TONNE.)') BURN
CALL XABORT(HSMG)
ENDIF
CALL LCMGET(IPDEPL,'FLUX-NORM',FNORM)
IF(IMPX.GT.0) WRITE(6,100) FNORM,BURN
ELSE
FNORM=1.0
IF(IMPX.GT.0) WRITE(6,110)
ENDIF
*----
* RECOVER THE CROSS SECTIONS.
*----
NISO=0
CALL hdf5_info(IPAPX,"/explicit/ISONAME",RANK,TYPE,NBYTE,DIMSR)
IF(RANK.NE.99) NISO=DIMSR(1)
NMAC=0
CALL hdf5_info(IPAPX,"/explicit/MACNAME",RANK,TYPE,NBYTE,DIMSR)
IF(RANK.NE.99) NMAC=DIMSR(1)
NREA=0
CALL hdf5_info(IPAPX,"/explicit/REANAME",RANK,TYPE,NBYTE,DIMSR)
IF(RANK.NE.99) NREA=DIMSR(1)
ALLOCATE(VOLMIL(NMIL),FLXMIL(NMIL,NG))
CALL APXCA2(IPAPX,IPEDIT,NREA,NISO,NMAC,NED,NPRC,NG,NL,ITRANC,
1 NALBP,IMC,NMIL,NBISO,ICAL,IMPX,FNORM,NMILNR,NISFS,NISPS,VOLMIL,
2 FLXMIL)
*----
* RECOVER DISCONTINUITY FACTOR INFORMATION.
*----
IF((IDF.EQ.2).OR.(IDF.EQ.3).OR.(NALBP.GT.0)) THEN
CALL APXIDF(IPAPX,IPEDIT,NG,NMIL,ICAL,IDF,NALBP,FNORM,VOLMIL,
1 FLXMIL)
ENDIF
*----
* RECOVER THE FISSION YIELDS.
*----
IF((ICAL.EQ.1).AND.(NISFS*NISPS.GT.0)) THEN
CALL APXGEY(IPAPX,IPEDIT,NISO,NG,NMIL,NBISO,NDFI,NISFS,NISPS)
ENDIF
*----
* RECOVER SPH FACTOR INFORMATION.
*----
CALL LCMSIX(IPEDIT,'MACROLIB',1)
CALL LCMLEN(IPEDIT,'SPH',ILEN,ITYLCM)
CALL LCMSIX(IPEDIT,' ',2)
CALL LCMSIX(IPEDIT,' ',2)
IF(ILEN.NE.0) THEN
IF(HEQUI.EQ.' ') HEQUI='default'
ALLOCATE(WORK1(NG),RVAL0(NG,NMIL))
CALL SAPSPH(IPEDIT,NG,NMIL,1,NG,RVAL0)
IF(NMIL.EQ.1) THEN
WORK1(:NG)=RVAL0(:NG,1)
WRITE(RECNAM,'(4Hcalc,I8,14H/xs/MEDIA_SPH/)') ICAL
CALL hdf5_create_group(IPAPX,TRIM(RECNAM))
WRITE(RECNAM2,'(A,A)') TRIM(RECNAM),TRIM(HEQUI)
CALL hdf5_write_data(IPAPX,TRIM(RECNAM2),WORK1)
ELSE
DO IBM=1,NMIL
WORK1(:NG)=RVAL0(:NG,IBM)
WRITE(RECNAM,'(4Hcalc,I8,3H/xs,I8,11H/MEDIA_SPH/)') ICAL,IBM
CALL hdf5_create_group(IPAPX,TRIM(RECNAM))
WRITE(RECNAM2,'(A,A)') TRIM(RECNAM),TRIM(HEQUI)
CALL hdf5_write_data(IPAPX,TRIM(RECNAM2),WORK1)
ENDDO
ENDIF
DEALLOCATE(RVAL0,WORK1)
ENDIF
DEALLOCATE(FLXMIL,VOLMIL)
RETURN
*
100 FORMAT(45H APXCAL: NORMALIZE THE FLUX WITH THE FACTOR =,1P,E12.5,
1 26H TAKEN FROM BURNUP STEP AT,E12.5,14H MW-DAY/TONNE.)
110 FORMAT(36H APXCAL: THE FLUX IS NOT NORMALIZED.)
END
|
