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
|
*DECK SCRTOC
SUBROUTINE SCRTOC(IPSAP)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Print the table of content of a Saphyb.
*
*Copyright:
* Copyright (C) 2012 Ecole Polytechnique de Montreal
*
*Author(s):
* A. Hebert
*
*Parameters: input
* IPSAP address of the multidimensional Saphyb object.
*
*-----------------------------------------------------------------------
*
USE GANLIB
IMPLICIT NONE
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPSAP
*----
* LOCAL VARIABLES
*----
INTEGER, PARAMETER::IOUT=6
INTEGER, PARAMETER::MAXLAM=20
INTEGER, PARAMETER::MAXPAR=50
INTEGER, PARAMETER::MAXVAL=200
INTEGER I, ILENG,ILONG, IPAR, ITYLCM,
& NADRX, NCALS, NGROUP, NISO, NISOTS, NLAM, NMAC, NMIL, NPAR,
& NPARL, NPRC, NREA, NSURFD
INTEGER DIMSAP(50),NVALUE(MAXPAR),VINTE(MAXVAL)
REAL VREAL(MAXVAL)
CHARACTER PARKEY(MAXPAR)*4,PARTYP(MAXPAR)*4,PARFMT(MAXPAR)*8,
1 VCHAR(MAXVAL)*12,RECNAM*12,NAMLAM(MAXLAM)*8
CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: TEXT8
CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: TEXT12
*----
* DIMSAP INFORMATION
*----
CALL LCMLEN(IPSAP,'DIMSAP',ILENG,ITYLCM)
IF(ILENG.EQ.0) CALL XABORT('SCRTOC: INVALID SAPHYB.')
CALL LCMGET(IPSAP,'DIMSAP',DIMSAP)
NLAM=DIMSAP(3) ! number of radioactive decay reactions
NREA=DIMSAP(4) ! number of neutron-induced reactions
NISO=DIMSAP(5) ! number of particularized isotopes
NMAC=DIMSAP(6) ! number of macroscopic sets
NMIL=DIMSAP(7) ! number of mixtures
NPAR=DIMSAP(8) ! number of global parameters
NPARL=DIMSAP(11) ! number of local variables
NADRX=DIMSAP(18) ! number of address sets
NCALS=DIMSAP(19) ! number of elementary calculations in the Saphyb
NGROUP=DIMSAP(20) ! number of energy groups
NPRC=DIMSAP(31) ! number of delayed neutron precursor groups
NISOTS=DIMSAP(32) ! maximum number of isotopes in output tables
WRITE(IOUT,'(/38H SCRTOC: table of content information:)')
WRITE(IOUT,'(42H number of radioactive decay reactions =,I3)')
1 NLAM
WRITE(IOUT,'(40H number of neutron-induced reactions =,I3)')
1 NREA
WRITE(IOUT,'(38H number of particularized isotopes =,I4)') NISO
WRITE(IOUT,'(31H number of macroscopic sets =,I2)') NMAC
WRITE(IOUT,'(23H number of mixtures =,I5)') NMIL
WRITE(IOUT,'(32H number of global parameters =,I4)') NPAR
WRITE(IOUT,'(30H number of local variables =,I4)') NPARL
WRITE(IOUT,'(27H number of address sets =,I4)') NADRX
WRITE(IOUT,'(27H number of calculations =,I7)') NCALS
WRITE(IOUT,'(28H number of energy groups =,I4)') NGROUP
WRITE(IOUT,'(31H number of precursor groups =,I4)') NPRC
WRITE(IOUT,'(48H maximum number of isotopes in output tables =,
1 I4/)') NISOTS
IF(NLAM.GT.0) THEN
CALL LCMSIX(IPSAP,'constphysiq',1)
IF(NLAM.GT.MAXLAM) CALL XABORT('SCRTOC: MAXLAM OVERFLOW')
CALL LCMGTC(IPSAP,'NOMLAM',8,NLAM,NAMLAM)
WRITE(IOUT,'(40H names of radioactive decay reactions:/
1 (5X,5A10))') (NAMLAM(I),I=1,NLAM)
CALL LCMSIX(IPSAP,' ',2)
ENDIF
CALL LCMSIX(IPSAP,'contenu',1)
IF(NREA.GT.0) THEN
ALLOCATE(TEXT12(NREA))
CALL LCMGTC(IPSAP,'NOMREA',12,NREA,TEXT12)
WRITE(IOUT,'(38H names of neutron-induced reactions:/
1 (5X,A12,2X,A12,2X,A12,2X,A12,2X,A12))') (TEXT12(I),I=1,NREA)
DEALLOCATE(TEXT12)
ENDIF
IF(NISO.GT.0) THEN
ALLOCATE(TEXT8(NISO))
CALL LCMGTC(IPSAP,'NOMISO',8,NISO,TEXT8)
WRITE(IOUT,'(36H names of particularized isotopes:/
1 (5X,A8,2X,A8,2X,A8,2X,A8,2X,A8))') (TEXT8(I),I=1,NISO)
DEALLOCATE(TEXT8)
ENDIF
IF(NMAC.GT.0) THEN
ALLOCATE(TEXT8(NMAC))
CALL LCMGTC(IPSAP,'NOMMAC',8,NMAC,TEXT8)
WRITE(IOUT,'(29H names of macroscopic sets:/
1 (5X,A8,2X,A8,2X,A8,2X,A8,2X,A8))') (TEXT8(I),I=1,NMAC)
DEALLOCATE(TEXT8)
ENDIF
CALL LCMSIX(IPSAP,' ',2)
CALL LCMSIX(IPSAP,'geom',1)
CALL LCMLEN(IPSAP,'outgeom',ILONG,ITYLCM)
IF(ILONG.NE.0) THEN
CALL LCMSIX(IPSAP,'outgeom',1)
CALL LCMLEN(IPSAP,'SURF',NSURFD,ITYLCM)
WRITE(IOUT,'(36H number of discontinuity factors =,I4/)')
1 NSURFD
CALL LCMSIX(IPSAP,' ',2)
ENDIF
CALL LCMSIX(IPSAP,' ',2)
*----
* GLOBAL PARAMETERS INFORMATION
*----
IF(NPAR.GT.MAXPAR) CALL XABORT('SCRTOC: MAXPAR OVERFLOW')
CALL LCMSIX(IPSAP,'paramdescrip',1)
CALL LCMGET(IPSAP,'NVALUE',NVALUE)
CALL LCMGTC(IPSAP,'PARKEY',4,NPAR,PARKEY)
CALL LCMGTC(IPSAP,'PARTYP',4,NPAR,PARTYP)
CALL LCMGTC(IPSAP,'PARFMT',8,NPAR,PARFMT)
CALL LCMSIX(IPSAP,' ',2)
CALL LCMSIX(IPSAP,'paramvaleurs',1)
DO IPAR=1,NPAR
WRITE(IOUT,'(25H SCRTOC: global parameter,A5,8H of type,A5,
1 1H:)') PARKEY(IPAR),PARTYP(IPAR)
IF(NVALUE(IPAR).GT.MAXVAL) CALL XABORT('SCRTOC: MAXVAL OVERF'
1 //'LOW')
WRITE(RECNAM,'(''pval'',I8)') IPAR
IF(PARFMT(IPAR).EQ.'ENTIER') THEN
CALL LCMGET(IPSAP,RECNAM,VINTE)
WRITE(IOUT,'(20H TABULATED POINTS=,1P,6I12/(20X,6I12))')
1 (VINTE(I),I=1,NVALUE(IPAR))
ELSE IF(PARFMT(IPAR).EQ.'FLOTTANT') THEN
CALL LCMGET(IPSAP,RECNAM,VREAL)
WRITE(IOUT,'(20H TABULATED POINTS=,1P,6E12.4/(20X,
1 6E12.4))') (VREAL(I),I=1,NVALUE(IPAR))
ELSE IF(PARFMT(IPAR).EQ.'CHAINE') THEN
CALL LCMGTC(IPSAP,RECNAM,12,NVALUE(IPAR),VCHAR)
WRITE(IOUT,'(20H TABULATED POINTS=,2X,6A12/(22X,6A12))')
1 (VCHAR(I),I=1,NVALUE(IPAR))
ENDIF
ENDDO
CALL LCMSIX(IPSAP,' ',2)
*----
* LOCAL VARIABLES INFORMATION
*----
IF(NPARL.GT.0) THEN
IF(NPARL.GT.MAXPAR) CALL XABORT('SCRTOC: MAXPAR OVERFLOW')
CALL LCMSIX(IPSAP,'varlocdescri',1)
CALL LCMGTC(IPSAP,'PARKEY',4,NPARL,PARKEY)
CALL LCMGTC(IPSAP,'PARTYP',4,NPARL,PARTYP)
CALL LCMGTC(IPSAP,'PARFMT',8,NPARL,PARFMT)
DO IPAR=1,NPARL
WRITE(IOUT,'(23H SCRTOC: local variable,A5,8H of type,A5,
1 11H and format,A9,1H:)') PARKEY(IPAR),PARTYP(IPAR),
2 PARFMT(IPAR)
ENDDO
CALL LCMSIX(IPSAP,' ',2)
ENDIF
WRITE(IOUT,'(/)')
RETURN
END
|
