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
|
*DECK EDIENE
SUBROUTINE EDIENE(NGROUP,NGCR ,NGCOND,NTENER,
> IGCR ,EGCR ,IGCOND,ENERGY,ENERV )
*
*-----------------------------------------------------------------------
*
*Purpose:
* Evaluate energy limits for condensation.
*
*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/output
* NGROUP number of energy groups.
* NGCR number of condensed groups read on input.
* NGCOND number of condensed groups read on EDI.
* NTENER number of energy found on library.
* IGCR new group limits.
* EGCR new energy limits.
* IGCOND old group limits.
* ENERGY energy/lethargy/average energy.
* ENERV average group energy.
*
*-----------------------------------------------------------------------
*
IMPLICIT NONE
*----
* SUBROUTINE ARGUMENTS
*----
INTEGER NGROUP,NGCR,NGCOND,NTENER
INTEGER IGCR(NGROUP+1),IGCOND(NGROUP+1)
REAL EGCR(NGROUP+1),ENERGY(2*NGROUP+1),ENERV(NGROUP)
*----
* LOCAL VARIABLES
*----
INTEGER IOUT
CHARACTER NAMSBR*6
PARAMETER (IOUT=6,NAMSBR='EDIENE')
INTEGER IGC,KDGRP,IGRP,JGRP,IGLIM
*----
* FIND IF NEW ENERGY OR GROUP SPECIFICATIONS FROM INPUT
*----
IF(NGCR .GT. 0) THEN
IGC=0
IF(EGCR(1) .NE. 0.0) THEN
IF(NTENER .EQ. 0) CALL XABORT(NAMSBR//
> ': CONDENSATION NOT PERMITTED - NO GROUP STRUCTURE')
KDGRP=1
DO 100 IGRP=1,NGROUP+1
IF(EGCR(IGRP) .LT. ENERGY(NGROUP+1)) THEN
KDGRP=NGROUP
IGC=IGC+1
IGCOND(IGC)=KDGRP
ELSE IF(EGCR(IGRP) .LT. ENERGY(KDGRP)) THEN
DO 110 JGRP=KDGRP,NGROUP
IF(EGCR(IGRP) .GE. ENERGY(JGRP+1)) THEN
KDGRP=JGRP
IGC=IGC+1
IGCOND(IGC)=KDGRP
GO TO 115
ENDIF
110 CONTINUE
115 CONTINUE
ENDIF
IF(KDGRP .EQ. NGROUP) GO TO 105
100 CONTINUE
105 CONTINUE
ELSE
DO 120 IGRP=1,NGROUP+1
IGCOND(IGRP)=IGCR(IGRP)
IF(IGCR(IGRP) .EQ. NGROUP) THEN
IGC=IGRP
GO TO 125
ENDIF
120 CONTINUE
125 CONTINUE
ENDIF
NGCOND=IGC
ENDIF
IF(NTENER .GT. 0) THEN
*----
* FIND ENERGY LIMITS, LETHARGY AND AVERAGE ENERGY
*----
DO 130 IGRP=1,NGROUP
ENERV(IGRP)=SQRT(ENERGY(IGRP)*ENERGY(IGRP+1))
130 CONTINUE
DO 140 IGC=1,NGCOND
IGLIM=IGCOND(IGC)+1
ENERGY(IGC+1)=ENERGY(IGLIM)
140 CONTINUE
IGLIM=NGCOND+1
IF(ENERGY(IGLIM) .EQ. 0.0) ENERGY(IGLIM)=1.0E-5
DO 150 IGC=1,NGCOND
IGLIM=IGLIM+1
ENERGY(IGLIM)=LOG(ENERGY(IGC)/ENERGY(IGC+1))
150 CONTINUE
ENDIF
RETURN
END
|
