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
124
125
126
127
128
129
130
131
132
133
134
|
*DECK MCGFLS
SUBROUTINE MCGFLS(IMPX,IPTRK,IPMACR,NUN,K,NREG,NLONG,M,NG,NGEFF,
1 LC,LFORW,PACA,NZON,KEYFLX,KEYCUR,NGIND,KPSYS,
2 NCONV,EPSI,MAXI,FIMEM,QFR)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Synthetic diffusion (ACA) flux 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): I. Suslov and R. Le Tellier
*
*Parameters: input
* IMPX print flag (equal to zero for no print).
* IPTRK pointer to the tracking (L_TRACK signature).
* IPMACR pointer to the macrolib LCM object.
* NUN number of unknowns per group.
* K number of volumes and outer surfaces.
* NREG number of volume regions.
* NLONG size of the corrective system.
* M number of material mixtures.
* NG number of groups.
* NGEFF number of groups to process.
* LC dimension of profiled matrices MCU and CQ.
* LFORW flag set to .false. to transpose the coefficient matrix.
* PACA type of preconditioner to solve the ACA corrective system.
* NZON index-number of the mixture type assigned to each volume.
* KEYFLX position of flux elements in FIMEM vector.
* KEYCUR position of current elements in FIMEM vector.
* NGIND index of the groups to process.
* KPSYS pointer to system groups.
* NCONV array of convergence flag for each group.
* EPSI stopping criterion for BICGSTAB in ACA resolution.
* MAXI maximum number of iterations allowed for BICGSTAB in ACA
* resolution.
* QFR input source vector.
*
*Parameters: input/output
* FIMEM unknown vector.
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) KPSYS(NGEFF),IPTRK,IPMACR
INTEGER IMPX,NUN,K,NREG,M,NG,NGEFF,LC,PACA,NZON(NLONG),
1 KEYFLX(NREG),KEYCUR(NLONG-NREG),NGIND(NGEFF),MAXI
REAL EPSI,FIMEM(NUN,NGEFF),QFR(NUN,NGEFF)
LOGICAL LFORW,NCONV(NGEFF)
*----
* LOCAL VARIABLES
*----
TYPE(C_PTR) JPSYS
INTEGER, TARGET, SAVE, DIMENSION(1) :: IDUMMY
REAL, TARGET, SAVE, DIMENSION(1) :: DUMMY
*----
* ALLOCATABLE ARRAYS
*----
TYPE(C_PTR) IM_PTR,MCU_PTR,JU_PTR,IM0_PTR,MCU0_PTR,IPERM_PTR,
1 DIAGF_PTR,CF_PTR,CQ_PTR,LUDF_PTR,LUCF_PTR,DIAGQ_PTR
INTEGER, POINTER, DIMENSION(:) :: IM,MCU,IPERM,JU,IM0,MCU0
REAL, POINTER, DIMENSION(:) :: DIAGQ,CQ,LUDF,LUCF,CF,DIAGF
*----
* INITIALIZE POINTERS
*----
JU=>IDUMMY
IM0=>IDUMMY
MCU0=>IDUMMY
LUDF=>DUMMY
LUCF=>DUMMY
CF=>DUMMY
DIAGF=>DUMMY
*
IF(K.LE.0) CALL XABORT('MCGFLS: INVALID VALUE OF K.')
M1=M+1
* recover connection matrices
CALL LCMGPD(IPTRK,'IM$MCCG',IM_PTR)
CALL LCMGPD(IPTRK,'MCU$MCCG',MCU_PTR)
CALL C_F_POINTER(IM_PTR,IM,(/ NLONG+1 /))
CALL C_F_POINTER(MCU_PTR,MCU,(/ LC /))
* recover permutation array
CALL LCMGPD(IPTRK,'PI$MCCG',IPERM_PTR)
CALL C_F_POINTER(IPERM_PTR,IPERM,(/ NLONG /))
IF(PACA.GE.2) THEN
CALL LCMGPD(IPTRK,'JU$MCCG',JU_PTR)
CALL C_F_POINTER(JU_PTR,JU,(/ NLONG /))
ENDIF
IF(PACA.EQ.3) THEN
CALL LCMLEN(IPTRK,'IM0$MCCG',LIM0,ITYLCM)
CALL LCMLEN(IPTRK,'MCU0$MCCG',LMCU0,ITYLCM)
CALL LCMGPD(IPTRK,'IM0$MCCG',IM0_PTR)
CALL LCMGPD(IPTRK,'MCU0$MCCG',MCU0_PTR)
CALL C_F_POINTER(IM0_PTR,IM0,(/ LIM0 /))
CALL C_F_POINTER(MCU0_PTR,MCU0,(/ LMCU0 /))
ELSE
LMCU0=0
ENDIF
DO II=1,NGEFF
IF(NCONV(II)) THEN
JPSYS=KPSYS(II)
CALL LCMGPD(JPSYS,'DIAGF$MCCG',DIAGF_PTR)
CALL LCMGPD(JPSYS,'CF$MCCG',CF_PTR)
CALL C_F_POINTER(DIAGF_PTR,DIAGF,(/ NLONG /))
CALL C_F_POINTER(CF_PTR,CF,(/ LC /))
IF(PACA.GE.2) THEN
CALL LCMGPD(JPSYS,'ILUDF$MCCG',LUDF_PTR)
CALL C_F_POINTER(LUDF_PTR,LUDF,(/ NLONG /))
IF(PACA.LT.4) THEN
CALL LCMGPD(JPSYS,'ILUCF$MCCG',LUCF_PTR)
CALL C_F_POINTER(LUCF_PTR,LUCF,(/ LC /))
ENDIF
ENDIF
CALL LCMGPD(JPSYS,'DIAGQ$MCCG',DIAGQ_PTR)
CALL LCMGPD(JPSYS,'CQ$MCCG',CQ_PTR)
CALL C_F_POINTER(DIAGQ_PTR,DIAGQ,(/ NLONG /))
CALL C_F_POINTER(CQ_PTR,CQ,(/ LC /))
CALL MCGCDD(IMPX,IPMACR,II,NG,NGEFF,NGIND,NCONV,M,NLONG,NUN,
1 NREG,LC,LFORW,PACA,NZON,KEYFLX,KEYCUR,IPERM,IM,MCU,JU,
2 EPSI,MAXI,FIMEM(1,II),QFR,DIAGQ,CQ,DIAGF,CF,LUDF,LUCF,
3 LMCU0,IM0,MCU0)
ENDIF
ENDDO
*
RETURN
END
|
