*DECK KINT02
      SUBROUTINE KINT02(MAXKN,SGD,IELEM,ICHX,IDIM,NREG,LL4,NBMIX,MAT,
     1 KN,VOL,F2,F3)
*
*-----------------------------------------------------------------------
*
*Purpose:
* multiplication of a matrix by a vector in mixed-dual finite element
* diffusion approximation (Cartesian geometry). Special version for
* Trivac.
*
*Copyright:
* Copyright (C) 2010 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
* MAXKN   dimension of array KN.
* SGD     mixture-ordered cross sections.
* IELEM   degree of the Lagrangian finite elements: =1 (linear);
*         =2 (parabolic); =3 (cubic); =4 (quartic).
* ICHX    type of discretization method:
*         =2: dual finite element approximations;
*         =3: nodal collocation method with full tensorial products;
*         =4: nodal collocation method with serendipity approximation.
* IDIM    number of dimensions.
* NREG    number of elements in Trivac.
* LL4     number of unknowns per group in Trivac.
* NBMIX   number of macro-mixtures.
* MAT     mixture index per region.
* KN      element-ordered unknown list.
* VOL     volume of regions.
* F2      vector to multiply.
*
*Parameters: output
* F3      result of the multiplication.
*
*-----------------------------------------------------------------------
*
*----
*  SUBROUTINE ARGUMENTS
*----
      INTEGER MAXKN,IELEM,ICHX,IDIM,NREG,LL4,NBMIX,MAT(NREG),KN(MAXKN)
      REAL SGD(NBMIX),VOL(NREG),F2(LL4),F3(LL4)
*----
*  LOCAL VARIABLES
*----
      INTEGER, DIMENSION(:), ALLOCATABLE :: IGAR
*
      IORD(J,K,L,LL,IEL,IW)=(IEL*L+K)*LL*IEL+(1+IEL*(IW-1))+J
*
      IORL(J,K,L,LL,IEL,IW)=
     1 1+LL*(L*(IEL*(IEL+1))/2-(L*(L-1)*(3*IEL-L+2))/6
     2 +K*(IEL-L)-(K*(K-1))/2)+(IEL-K-L)*(IW-1)+J
*----
*  SCRATCH STORAGE ALLOCATION
*----
      ALLOCATE(IGAR(NREG))
*
      IF(ICHX.EQ.2) THEN
*        DUAL FINITE ELEMENT METHOD.
         NUM1=0
         DO 30 K=1,NREG
         L=MAT(K)
         IF(L.EQ.0) GO TO 30
         VOL0=VOL(K)
         IF(VOL0.EQ.0.0) GO TO 20
         DO 10 K3=0,IELEM-1
         DO 10 K2=0,IELEM-1
         DO 10 K1=0,IELEM-1
         IND1=KN(NUM1+1)+(K3*IELEM+K2)*IELEM+K1
   10    F3(IND1)=F3(IND1)+VOL0*SGD(L)*F2(IND1)
   20    NUM1=NUM1+1+6*IELEM**2
   30    CONTINUE
      ELSE IF(ICHX.EQ.3) THEN
*        NODAL COLLOCATION METHOD WITH FULL TENSORIAL PRODUCTS.
         LNUN=0
         DO 40 K=1,NREG
         IF(MAT(K).EQ.0) GO TO 40
         LNUN=LNUN+1
         IGAR(K)=LNUN
   40    CONTINUE
*
         DO 70 K=1,NREG
         L=MAT(K)
         IF(L.EQ.0) GO TO 70
         VOL0=VOL(K)
         IF(VOL0.EQ.0.0) GO TO 70
         DO 60 I3=0,IELEM-1
         DO 60 I2=0,IELEM-1
         DO 50 I1=0,IELEM-1
         INX1=IORD(I1,I2,I3,LNUN,IELEM,IGAR(K))
   50    F3(INX1)=F3(INX1)+VOL0*SGD(L)*F2(INX1)
         IF((IDIM.EQ.1).AND.(I2.EQ.0)) GO TO 70
         IF((IDIM.EQ.2).AND.(I2.EQ.IELEM-1)) GO TO 70
   60    CONTINUE
   70    CONTINUE
      ELSE IF(ICHX.EQ.4) THEN
*        NODAL COLLOCATION METHOD WITH SERENDIPITY APPROXIMATION.
         LNUN=0
         DO 80 K=1,NREG
         IF(MAT(K).EQ.0) GO TO 80
         LNUN=LNUN+1
         IGAR(K)=LNUN
   80    CONTINUE
*
         DO 110 K=1,NREG
         L=MAT(K)
         IF(L.EQ.0) GO TO 110
         VOL0=VOL(K)
         IF(VOL0.EQ.0.0) GO TO 110
         DO 100 I3=0,IELEM-1
         DO 100 I2=0,IELEM-1-I3
         DO 90 I1=0,IELEM-1-I2-I3
         INX1=IORL(I1,I2,I3,LNUN,IELEM,IGAR(K))
   90    F3(INX1)=F3(INX1)+VOL0*SGD(L)*F2(INX1)
         IF((IDIM.EQ.1).AND.(I2.EQ.0)) GO TO 110
         IF((IDIM.EQ.2).AND.(I2.EQ.IELEM-1)) GO TO 110
  100    CONTINUE
  110    CONTINUE
      ENDIF
*----
*  SCRATCH STORAGE DEALLOCATION
*----
      DEALLOCATE(IGAR)
      RETURN
      END
