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
|
*DECK CPONED
SUBROUTINE CPONED(NPROC ,MINLEG,MAXLEG,ILEAKS ,NED ,HVECT ,
> IVECT ,INDPRO)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Set up INDPRO for cross section to read on IPLIB.
*
*Copyright:
* Copyright (C) 2007 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): G. Marleau
*
*Parameters: input
* NPROC number of terms to process.
* MINLEG mimimum Legendre order to process for scattering.
* MAXLEG maximum Legendre order to process for scattering.
* ILEAKS leakage calculation: = 1 STRD; = 2 STRDX, STRDY and STRDZ.
* NED number of extra vector edits.
* HVECT names of the extra vector edits.
*
*Parameters: output
* IVECT pointer to additional xs possible.
* INDPRO vector for cross section to process:
* = 0 do not process;
* > 0 process.
*
*-----------------------------------------------------------------------
*
IMPLICIT NONE
*----
* SUBROUTINE ARGUMENTS
*----
INTEGER NPROC ,MINLEG,MAXLEG,ILEAKS,NED,IVECT(NED),
> INDPRO(NPROC)
CHARACTER HVECT(NED)*8
*----
* LOCAL PARAMETERS
* NDPROC = NUMBER OF DEFAULT CROSS SECTIONS = 20
* NAMDXS = NAME OF NDPROC DEFAULT XS
* SCATTERING CROSS SECTIONS START AT NDPROC+1 WITH
* NAME NAMSCT='SIGS'//NAMLEG AND NAMSCT='SCAT'//NAMLEG
* WITH NAMLEG DEFINED BY
* WRITE(NAMLEG ,'(I2.2)') ILEG
* FOR ILEG=0 TO NDPROC-NPROC-1
*----
INTEGER NDPROC,IOUT,NEDOTH,IED,IXSR
PARAMETER (NDPROC=20,IOUT=6)
CHARACTER NAMDXS(NDPROC)*6
SAVE NAMDXS
DATA NAMDXS /'NTOT0 ','TRANC ','NUSIGF','NFTOT ','CHI ',
> 'NU ','NG ','NHEAT ','N2N ','N3N ',
> 'N4N ','NP ','NA ','GOLD ','ABS ',
> 'NWT0 ','STRD ','STRD X','STRD Y','STRD Z'/
*----
* SCAN FOR ADDITIONAL AND STANDARD CROSS SECTIONS TO BE SAVED
*----
IVECT(:NED)=0
INDPRO(:NPROC)=0
NEDOTH=NED
DO 100 IED=1,NED
IF(HVECT(IED).EQ.' ') THEN
NEDOTH=NEDOTH-1
ELSE
DO 110 IXSR=1,NDPROC
IF(HVECT(IED)(:6).EQ.NAMDXS(IXSR)) THEN
NEDOTH=NEDOTH-1
INDPRO(IXSR)=1
IF(HVECT(IED).EQ.'NFTOT') GO TO 115
IVECT(IED)=IXSR
GO TO 115
ENDIF
110 CONTINUE
115 CONTINUE
ENDIF
100 CONTINUE
IF(NEDOTH.GE.1) THEN
WRITE(IOUT,9000)
DO 120 IED=1,NED
IF(IVECT(IED).EQ.0.AND.
> HVECT(IED).NE.'NFTOT'.AND.HVECT(IED).NE.' ') THEN
WRITE(IOUT,9001) HVECT(IED)
ENDIF
120 CONTINUE
WRITE(IOUT,9002)
ENDIF
DO 130 IXSR=1,7
INDPRO(IXSR)=1
130 CONTINUE
INDPRO(16)=1
IF(ILEAKS.EQ.1) THEN
INDPRO(17)=1
ELSE IF(ILEAKS.EQ.2) THEN
INDPRO(18)=1
INDPRO(19)=1
INDPRO(20)=1
ENDIF
DO 140 IXSR=NDPROC+MINLEG+1,NDPROC+MAXLEG+1
INDPRO(IXSR)=1
140 CONTINUE
RETURN
*----
* FORMAT
*----
9000 FORMAT(' CPONED: ************ WARNING ************')
9001 FORMAT(' CROSS-SECTION TYPE NOT RECOVERED : ',A8)
9002 FORMAT(' *****************************************')
END
|
