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
|
*DECK EDIDEL
SUBROUTINE EDIDEL(IPRINT,NGCOND,NMERGE,IGR,SCATTS,INGSCT,IFGSCT,
> IPOSCT,XSCAT,DELSCT)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Scattering delta sigma calculation.
*
*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
* IPRINT print level (=1 to print delta sigmas).
* NGCOND number of condensed groups.
* NMERGE number of merged regions.
* IGR current group treated.
* SCATTS new scattering matrix.
*
*Parameters: scratch
* INGSCT number of scattering groups (old).
* IFGSCT first old scattering group.
* IPOSCT position of region in scattering matrix.
* XSCAT new scattering matrix.
* DELSCT scattering delta sigma.
*
*-----------------------------------------------------------------------
*
*----
* SUBROUTINE ARGUMENTS
*----
INTEGER IPRINT,NGCOND,NMERGE,IGR,INGSCT(NMERGE),
> IFGSCT(NMERGE),IPOSCT(NMERGE)
REAL SCATTS(NMERGE,NGCOND,NGCOND),XSCAT(NMERGE*NGCOND),
> DELSCT(NGCOND)
*----
* LOCAL VARIABLES
*----
PARAMETER (IUNOUT=6)
*----
* COMPUTE DELTA SIGMA BY MATERIAL FOR ALL GROUPS
*----
DO 100 IREG=1,NMERGE
JLASTG=IFGSCT(IREG)
JFRSTG=JLASTG-INGSCT(IREG)+1
JPOSCT=IPOSCT(IREG)+INGSCT(IREG)
IF(IPRINT.GE.1) THEN
WRITE(IUNOUT,6000) IREG,NGCOND
ENDIF
DO 110 JGR=1,NGCOND
IF( (JGR.LT.JFRSTG) .OR. (JGR.GT.JLASTG) ) THEN
DELSCT(JGR)=SCATTS(IREG,IGR,JGR)
ELSE
JPOSCT=JPOSCT-1
DELSCT(JGR)=SCATTS(IREG,IGR,JGR)-XSCAT(JPOSCT)
ENDIF
110 CONTINUE
100 CONTINUE
WRITE(IUNOUT,6001) (DELSCT(JGR),JGR=1,NGCOND)
*----
* FORMAT
*----
6000 FORMAT(/' REGION=',I5,10X,'NUMBER OF GROUPS ',I10)
6001 FORMAT(1P,7(3X,E15.7))
RETURN
END
|
