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
|
*DECK TRFICF
SUBROUTINE TRFICF(KPSYS,IFTRAK,IPRNTF,NGEFF,NGIND,IDIR,NREGIO,
> NUNKNO,MATCOD,VOLUME,KEYFLX,FUNKNO,SUNKNO,
> TITRE)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Solve N-group transport equation for fluxes using the scattering
* modified collision probability matrix.
*
*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
* KPSYS pointer to the pij matrices (L_PIJ signature). KPSYS is
* an array of directories.
* IFTRAK not used.
* IPRNTF print selection for flux modules.
* NGEFF number of energy groups processed in parallel.
* NGIND energy group indices assign to the NGEFF set.
* IDIR directional collision probability flag:
* =0 for pij or wij;
* =k for pijk or wijk k=1,2,3.
* NREGIO number of regions considered.
* NUNKNO number of unknown in the system.
* MATCOD mixture code in region.
* VOLUME volume of region.
* KEYFLX flux elements in unknown system.
* SUNKNO source for system of unknown.
* TITRE title.
*
*Parameters: input/output
* FUNKNO unknown vector solved for.
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) KPSYS(NGEFF)
CHARACTER TITRE*72
INTEGER NGEFF,NGIND(NGEFF),IFTRAK,IPRNTF,IDIR,NREGIO,NUNKNO,
> MATCOD(NREGIO),KEYFLX(NREGIO)
REAL VOLUME(NREGIO),FUNKNO(NUNKNO,NGEFF),
> SUNKNO(NUNKNO,NGEFF)
*----
* LOCAL VARIABLES
*----
PARAMETER (IUNOUT=6)
CHARACTER CNS(0:3)*1,NAMLCM*12,NAMMY*12
INTEGER ILCMLN
LOGICAL EMPTY,LCM
SAVE CNS
*----
* ALLOCATABLE ARRAYS
*----
TYPE(C_PTR) CPMAT_PTR
REAL, POINTER, DIMENSION(:) :: CPMAT
*----
* DATA STATEMENTS
*----
DATA CNS /'-','1','2','3'/
*----
* RECOVER TRAFIC SPECIFIC PARAMETERS
*----
IF(IPRNTF.GT.2) WRITE(IUNOUT,'(//9H TRFICF: ,A72)') TITRE
CALL LCMINF(KPSYS(1),NAMLCM,NAMMY,EMPTY,ILONG,LCM)
IF(IFTRAK.LT.0) CALL XABORT('TRFICF: EXPECTING IFTRAK>=0')
IF(MATCOD(1).LT.0) CALL XABORT('TRFICF: EXPECTING MATCOD(1)>=0')
IF(VOLUME(1).LT.0.0) CALL XABORT('TRFICF: EXPECTING VOLUME(1)>=0')
*----
* MAIN LOOP OVER ENERGY GROUPS.
*----
IF(.NOT.LCM) THEN
ALLOCATE(CPMAT(NREGIO*NREGIO),STAT=IER)
IF(IER.NE.0) CALL XABORT('TRFICF: CANNOT ALLOCATE CPMAT.')
ENDIF
DO 60 II=1,NGEFF
IF(IPRNTF.GT.2) WRITE(IUNOUT,'(/25H TRFICF: PROCESSING GROUP,I5,
1 6H WITH ,A,1H.)') NGIND(II),'TRAFIC'
*----
* READ SCATTERING MODIFIED COLLISION PROBABILITIES
*----
CALL LCMLEN(KPSYS(II),'DRAGON'//CNS(IDIR)//'PCSCT',ILCMLN,ITYLCM)
IF((ILCMLN.GT.0).AND.LCM) THEN
CALL LCMGPD(KPSYS(II),'DRAGON'//CNS(IDIR)//'PCSCT',CPMAT_PTR)
CALL C_F_POINTER(CPMAT_PTR,CPMAT,(/ NREGIO*NREGIO /))
ELSE IF(ILCMLN.GT.0) THEN
CALL LCMGET(KPSYS(II),'DRAGON'//CNS(IDIR)//'PCSCT',CPMAT)
ELSE
CALL XABORT('TRFICF: RECORD DRAGON'//CNS(IDIR)//
> 'PCSCT ABSENT FROM LCM')
ENDIF
*----
* SOLVE TRANSPORT EQUATION
*----
JCPMAT=0
DO 30 I=1,NREGIO
FUNKNO(KEYFLX(I),II)=0.0
30 CONTINUE
DO 50 I=1,NREGIO
IPOS=KEYFLX(I)
DO 40 J=1,NREGIO
JPOS=KEYFLX(J)
JCPMAT=JCPMAT+1
FUNKNO(JPOS,II)=FUNKNO(JPOS,II)+SUNKNO(IPOS,II)*CPMAT(JCPMAT)
40 CONTINUE
50 CONTINUE
*----
* END OF LOOP OVER ENERGY GROUPS
*----
60 CONTINUE
IF(.NOT.LCM) DEALLOCATE(CPMAT)
RETURN
END
|
