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 XDRLXS
SUBROUTINE XDRLXS(IPLIB ,IGS ,IPRINT,NPROC ,NAMDXS,IORD ,
> NGROUP,XSREC )
*
*-----------------------------------------------------------------------
*
*Purpose:
* Get/save Legendre-independent cross section data from/on IPLIB.
*
*Copyright:
* Copyright (C) 2002 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
* IPLIB pointer to the internal library.
* IGS get or save flag:
* >0 save;
* <0 get.
* IPRINT Print level (cross sections printed if IPRINT>99).
* NPROC number of Legendre-independent terms to process.
* NAMDXS names of cross sections to process.
* IORD cross section order:
* =1 constant;
* =2 linear;
* =3 quadratic.
* NGROUP number of energy groups.
*
*Parameters: input/output
* XSREC cross section records for IRPROC=1,NPROC.
*
*-----------------------------------------------------------------------
*
USE GANLIB
IMPLICIT NONE
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPLIB
INTEGER IGS,IPRINT,NPROC,IORD,NGROUP
REAL XSREC(NGROUP,NPROC)
CHARACTER NAMDXS(NPROC)*8,NORD*4
*----
* LOCAL VARIABLES
*----
INTEGER IOUT
PARAMETER (IOUT=6)
INTEGER IXSR,IG,JG,ILENG,ITYLCM
*
IF(IORD.EQ.1) THEN
NORD=' '
ELSE IF(IORD.EQ.2) THEN
NORD=' LIN'
ELSE IF(IORD.EQ.3) THEN
NORD=' QUA'
ENDIF
IF(NPROC.LE.0) THEN
CALL XABORT('XDRLXS: ZERO OR NEGATIVE VALUE OF NPROC')
ENDIF
*
IF(IGS.GT.0) THEN
*----
* SAVE LOCAL DEFAULT XS IF REQUIRED
*----
! CALL LCMLEN(IPLIB,'H-FACTOR',ILENG,ITYLCM)
! IF(ILENG.NE.0) CALL LCMDEL(IPLIB,'H-FACTOR')
DO 100 IXSR=1,NPROC
*----
* FIND IF XS NOT ALL 0.0
*----
IF(NAMDXS(IXSR).EQ.'H-FACTOR') GO TO 115
DO 110 IG=1,NGROUP
IF(XSREC(IG,IXSR).NE.0.0) GO TO 115
110 CONTINUE
GO TO 100
*----
* SAVE IF XS NOT ALL 0.0
*----
115 CALL LCMPUT(IPLIB,NAMDXS(IXSR)//NORD,NGROUP,2,XSREC(1,IXSR))
100 CONTINUE
ELSE
*----
* GET LOCAL DEFAULT XS IF REQUIRED
*----
DO 200 IXSR=1,NPROC
XSREC(:NGROUP,IXSR)=0.0
CALL LCMLEN(IPLIB,NAMDXS(IXSR)//NORD,ILENG,ITYLCM)
IF(ILENG.GT.0) THEN
CALL LCMGET(IPLIB,NAMDXS(IXSR)//NORD,XSREC(1,IXSR))
ENDIF
200 CONTINUE
ENDIF
IF(IPRINT .GE. 100) THEN
*----
* Print XS
*----
DO IXSR=1,NPROC
DO IG=1,NGROUP
IF(XSREC(IG,IXSR).NE.0.0) THEN
WRITE(IOUT,6000) NAMDXS(IXSR)//NORD
WRITE(IOUT,6010) (XSREC(JG,IXSR),JG=1,NGROUP)
GO TO 210
ENDIF
ENDDO
210 CONTINUE
ENDDO
ENDIF
RETURN
*----
* Formats
*----
6000 FORMAT(/' CROSS SECTION TYPE = ',A12)
6010 FORMAT(1P,5E16.7)
END
|
