summaryrefslogtreecommitdiff
path: root/Dragon/src/MCGDS1.f
blob: 5d4cb70868ac6fbbb4aa7e8a7713af708e75fa89 (plain)
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
*DECK MCGDS1
      SUBROUTINE MCGDS1(SUBDS2,SUBDSP,SUBDSC,N,NMU,NGEFF,WEITF,HTF,ZMU,
     1                  WZMU,NOM,NZON,NLONG,NFI,NDIM,LC,M,KM,IM,MCU,
     2                  DIAGF,DIAGQ,CF,CQ,PREV,NEXT,SIGAL,XSW,WORK)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Calculation of the contributions in preconditionning matrices 
* of a 2D-track.
*
*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
* SUBDS2  ACA coefficients summation subroutine.
* SUBDSP  ACA coefficients position subroutine.
* SUBDSC  ACA coefficients calculation subroutine.
* N       number of elements in the current track.
* NMU     order of the polar quadrature set.
* NGEFF   number of energy groups to process.
* NFI     total number of volumes and surfaces.
* NDIM    number of dimensions in the geometry.
* NLONG   total number of cells with unknowns quantities.
* M       number of material mixtures.
* LC      dimension of vector MCU.
* NZON    index-number of the mixture type assigned to each volume.
* WEITF   track weight.
* NOM     integer tracking elements.
* HTF     real tracking elements.
* ZMU     polar quadrature set.
* WZMU    polar quadrature set.
* KM      used in CDD acceleration.
* IM      used in CDD acceleration.
* MCU     used in CDD acceleration.
* SIGAL   albedos and total cross sections array.
* XSW     scattering cross sections array.
*
*Parameters: input/output
* CQ      undefined.
* CF      undefined.
* DIAGQ   undefined.
* DIAGF   undefined.
*
*Parameters: scratch
* PREV    undefined.
* NEXT    undefined.
* WORK    undefined.
*
*-----------------------------------------------------------------------
*
      IMPLICIT NONE
*----
*  SUBROUTINE ARGUMENTS
*----
      INTEGER NLONG,NFI,NDIM,LC,NGEFF,M,N,NMU,NOM(N),NZON(NFI),
     1 KM(NLONG),IM(NLONG),MCU(LC),PREV(N),NEXT(N)
      DOUBLE PRECISION WEITF,HTF(N)
      REAL ZMU(NMU),WZMU(NMU),DIAGQ(NLONG,NGEFF),CQ(LC,NGEFF),
     1 SIGAL(-6:M,NGEFF),XSW(0:M,NGEFF)
      DOUBLE PRECISION DIAGF(NLONG,NGEFF),CF(LC,NGEFF),WORK(N,3)
      EXTERNAL SUBDS2,SUBDSP,SUBDSC
*----
*  LOCAL VARIABLES
*----
      INTEGER IMU,I,II
      REAL ZMUI
      DOUBLE PRECISION W
      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: HG
*----
*  POSITION OF COEFFICIENTS FOR THIS TRACK IN ACA MATRICES
*----
*          MCGDSP: non cyclic tracking
*          MOCDSP: cyclic tracking
      CALL SUBDSP(N,NFI,NLONG,LC,NZON,NOM,KM,MCU,IM,PREV,NEXT,HTF)
*----
*  CALCULATION OF COEFFICIENTS
*----
      IF (NDIM.EQ.3) THEN
*     3D calculation -> no loop over a polar angle   
         DO II=1,NGEFF
*                MCGDS2: non cyclic tracking
*                MOCDS2: cyclic tracking
            CALL SUBDS2(SUBDSC,LC,M,N,HTF,NOM,NZON,SIGAL(0,II),
     1           XSW(0,II),WEITF,NFI,DIAGF(1,II),DIAGQ(1,II),
     2           CF(1,II),CQ(1,II),PREV,NEXT,WORK(1,1),WORK(1,2),
     3           WORK(1,3))
         ENDDO
      ELSE
*     2D calculation -> loop over the polar angle
         ALLOCATE(HG(N))
         DO IMU=1,NMU
            ZMUI=ZMU(IMU)
            W=WEITF*WZMU(IMU)
            DO I=1,N
               IF(NZON(NOM(I)).GE.0) THEN
                  HG(I)=HTF(I)*ZMUI
               ENDIF  
            ENDDO             
            DO II=1,NGEFF
               CALL SUBDS2(SUBDSC,LC,M,N,HG,NOM,NZON,SIGAL(0,II),
     1              XSW(0,II),W,NFI,DIAGF(1,II),DIAGQ(1,II),CF(1,II),
     2              CQ(1,II),PREV,NEXT,WORK(1,1),WORK(1,2),WORK(1,3))
            ENDDO
         ENDDO
         DEALLOCATE(HG)
      ENDIF
*
      RETURN
      END