summaryrefslogtreecommitdiff
path: root/Trivac/src/TRIASH.f
blob: 0433dc2762cec7088504f5d488c6c55d70d99d0d (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
*DECK TRIASH
      SUBROUTINE TRIASH(IELEM,NBMIX,LL4F,NBLOS,MAT,SIDE,ZZ,FRZ,SGD,KN,
     > IPERT,VEC)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Assembly of a diagonal system matrix corresponding to a single cross
* section type (Thomas-Raviart-Schneider dual cases). Note: vector VEC
* should be initialized by the calling program.
*
*Copyright:
* Copyright (C) 2006 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): A. Hebert
*
*Parameters: input
* IELEM   degree of the Lagrangian finite elements.
* NBMIX   maximum number of material mixtures.
* LL4F    total number of flux unknowns per group.
* NBLOS   number of lozenges per direction, taking into account
*         mesh-splitting.
* MAT     mixture index assigned to each element.
* SIDE    side of an hexagon.
* ZZ      Z-directed mesh spacings.
* FRZ     volume fractions for the axial SYME boundary condition.
* SGD     cross section per material mixture.
* KN      ADI permutation indices for the volumes.
* IPERT   mixture permutation index.
*
*Parameters: output
* VEC     diagonal system matrix.
*
*-----------------------------------------------------------------------
*
*----
*  SUBROUTINE ARGUMENTS
*----
      PARAMETER(MAXIEL=3)
      INTEGER IELEM,NBMIX,LL4F,NBLOS,MAT(3,NBLOS),KN(NBLOS,3),
     1 IPERT(NBLOS)
      REAL SIDE,ZZ(3,NBLOS),FRZ(NBLOS),SGD(NBMIX),VEC(LL4F)
*----
*  LOCAL VARIABLES
*----
      DOUBLE PRECISION TTTT,VOL0,SIG
*
      TTTT=0.5D0*SQRT(3.D00)*SIDE*SIDE
      NUM=0
      DO 20 KEL=1,NBLOS
      IF(IPERT(KEL).EQ.0) GO TO 20
      IBM=MAT(1,IPERT(KEL))
      IF(IBM.EQ.0) GO TO 20
      NUM=NUM+1
      VOL0=TTTT*ZZ(1,IPERT(KEL))*FRZ(KEL)
      SIG=SGD(IBM)
      DO 12 K3=0,IELEM-1
      DO 11 K2=0,IELEM-1
      DO 10 K1=0,IELEM-1
      JND1=(NUM-1)*IELEM**3+K3*IELEM**2+K2*IELEM+K1+1
      JND2=(KN(NUM,1)-1)*IELEM**3+K3*IELEM**2+K2*IELEM+K1+1
      JND3=(KN(NUM,2)-1)*IELEM**3+K3*IELEM**2+K2*IELEM+K1+1
      VEC(JND1)=VEC(JND1)+REAL(VOL0*SIG)
      VEC(JND2)=VEC(JND2)+REAL(VOL0*SIG)
      VEC(JND3)=VEC(JND3)+REAL(VOL0*SIG)
   10 CONTINUE
   11 CONTINUE
   12 CONTINUE
   20 CONTINUE
      RETURN
      END