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
|
*DECK PSPFCD
SUBROUTINE PSPFCD(IPFL,NGROUP,NUNKNO,IGR,ICOND,
> FLUXC,FLUXR)
*
*-----------------------------------------------------------------------
*
*Purpose:
* To condense flux for PSP.
*
*Copyright:
* Copyright (C) 2005 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
* IPFL pointer to the FLUX data structure.
* NGROUP number of groups.
* NUNKNO number of flux unknowns.
* IGR condensed group number.
* ICOND group limit for condensed group.
*
*Parameters: output
* FLUXC condensed flux.
* FLUXR multigroup flux read.
*
*-----------------------------------------------------------------------
*
USE GANLIB
IMPLICIT NONE
INTEGER IOUT
CHARACTER NAMSBR*6
PARAMETER (IOUT=6,NAMSBR='PSPFCD')
*----
* ROUTINE PARAMETERS
*----
TYPE(C_PTR) IPFL
INTEGER NGROUP,NUNKNO,IGR
INTEGER ICOND(NGROUP)
REAL FLUXC(NUNKNO),FLUXR(NUNKNO)
*----
* LOCAL PARAMETERS
*----
TYPE(C_PTR) JPFL
INTEGER IGC,IGD,IGF,IUN
*
FLUXC(:NUNKNO)=0.0
IGF=ICOND(IGR)
IF(IGR .EQ. 1) THEN
IGD=1
ELSE
IGD=ICOND(IGR-1)+1
ENDIF
JPFL=LCMGID(IPFL,'FLUX')
DO IGC=IGD,IGF
CALL LCMGDL(JPFL,IGC,FLUXR)
DO IUN=1,NUNKNO
FLUXC(IUN)=FLUXC(IUN)+FLUXR(IUN)
ENDDO
ENDDO
*----
* RETURN
*----
RETURN
END
|
