*DECK OUTHOM
      SUBROUTINE OUTHOM(MAXNEL,IPGEOM,IMPX,NEL,IELEM,ICOL,HTRACK,MAT,
     1 NZS,IHOM)
*
*-----------------------------------------------------------------------
*
*Purpose:
* read an modify the merge indices.
*
*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): A. Hebert
*
*Parameters: input
* MAXNEL  maximum number of elements.
* IPGEOM  L_GEOM pointer to the geometry.
* IMPX    print parameter.
* NEL     total number of finite elements.
* IELEM   degree of the Lagrangian finite elements:
* ICOL    type of quadrature used to integrate the mass matrix
* HTRACK  type of tracking (equal to 'BIVAC' or 'TRIVAC').
* MAT     index-number of the mixture type assigned to each volume.
*
*Parameters: output
* NZS     number of merged regions.
* IHOM    merge indices.
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      TYPE(C_PTR) IPGEOM
      CHARACTER HTRACK*12
      INTEGER MAXNEL,IMPX,NEL,IELEM,ICOL,MAT(NEL),NZS,IHOM(NEL)
*----
*  LOCAL VARIABLES
*----
      PARAMETER (NSTATE=40)
      INTEGER ISTATE(NSTATE),NCODE(6)
      REAL ZCODE(6)
      LOGICAL ILK,LDIAG,CHEX,LFOLD1,LFOLD2,LFOLD3
      DOUBLE PRECISION DFLOTT
      CHARACTER TEXT4*4,HSMG*131
      INTEGER, DIMENSION(:), ALLOCATABLE :: ISPLX,ISPLY,ISPLZ,MAT2,DP,MX
      INTEGER, DIMENSION(:), ALLOCATABLE :: XXX,YYY,ZZZ
      EQUIVALENCE (ITYPE,ISTATE(1)),(LR1,ISTATE(2)),(LX1,ISTATE(3)),
     1 (LY1,ISTATE(4)),(LZ1,ISTATE(5))
*----
*  DETERMINE THE MESH SPLITTING INFO FROM THE GEOMETRY.
*----
      ALLOCATE(ISPLX(MAXNEL),ISPLY(MAXNEL),ISPLZ(MAXNEL))
      ALLOCATE(XXX(MAXNEL+1),YYY(MAXNEL+1),ZZZ(MAXNEL+1))
*
      ALLOCATE(MAT2(MAXNEL))
      CALL READ3D(MAXNEL,MAXNEL,MAXNEL,MAXNEL,IPGEOM,IHEX,IR,MAT2,ILK,
     1 SIDE,XXX,YYY,ZZZ,IMPX,LX,LY,LZ,IPAS,NCODE,ZCODE,ISPLX,ISPLY,
     2 ISPLZ)
      DEALLOCATE(MAT2)
*
      CALL LCMGET(IPGEOM,'STATE-VECTOR',ISTATE)
      LYOLD=1
      LZOLD=1
      NELOLD=0
      IF(ITYPE.EQ.2) THEN
*        1-D CARTESIAN GEOMETRY.
         LXOLD=LX1
         NELOLD=LXOLD
      ELSE IF((ITYPE.EQ.3).OR.(ITYPE.EQ.4)) THEN
*        1-D CYLINDRICAL/SPHERICAL GEOMETRY.
         LXOLD=LR1
         NELOLD=LXOLD
      ELSE IF(ITYPE.EQ.5) THEN
*        2-D CARTESIAN GEOMETRY.
         LXOLD=LX1
         LYOLD=LY1
         NELOLD=LXOLD*LYOLD
         LDIAG=.FALSE.
         DO 30 IC=1,4
   30    LDIAG=LDIAG.OR.(NCODE(IC).EQ.3)
         IF(LDIAG) NELOLD=(LXOLD+1)*LXOLD/2
      ELSE IF(ITYPE.EQ.6) THEN
*        2-D CYLINDRICAL GEOMETRY.
         LXOLD=LR1
         LZOLD=LZ1
         NELOLD=LXOLD*LZOLD
      ELSE IF(ITYPE.EQ.7) THEN
*        3-D CARTESIAN GEOMETRY.
         LXOLD=LX1
         LYOLD=LY1
         LZOLD=LZ1
         NELOLD=LXOLD*LYOLD*LZOLD
         LDIAG=.FALSE.
         DO 40 IC=1,4
   40    LDIAG=LDIAG.OR.(NCODE(IC).EQ.3)
         IF(LDIAG) NELOLD=(LXOLD+1)*LXOLD*LZOLD/2
      ELSE IF(ITYPE.EQ.8) THEN
*        2-D HEXAGONAL GEOMETRY.
         LXOLD=LX1
         NELOLD=LXOLD
      ELSE IF(ITYPE.EQ.9) THEN
*        3-D HEXAGONAL GEOMETRY.
         LXOLD=LX1
         LZOLD=LZ1
         NELOLD=LXOLD*LZOLD
      ENDIF
*----
*  READ THE MERGE INDICES.
*----
      CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
      IF(INDIC.EQ.1) THEN
         DO 160 K=1,NELOLD
  160    IHOM(K)=0
         IHOM(1)=NITMA
         NZS=NITMA
         DO 170 K=2,NELOLD
         CALL REDGET(INDIC,IHOM(K),FLOTT,TEXT4,DFLOTT)
         IF(INDIC.NE.1) CALL XABORT('OUTHOM: INTEGER EXPECTED.')
  170    NZS=MAX(NZS,IHOM(K))
      ELSE IF((INDIC.EQ.3).AND.(TEXT4.EQ.'IN')) THEN
         DO 190 K=1,NELOLD
  190    IHOM(K)=K
         NZS=NELOLD
      ELSE IF((INDIC.EQ.3).AND.(TEXT4.EQ.'MIX')) THEN
         CALL LCMLEN(IPGEOM,'MIX',ILONG,ITYLCM)
         IF(ILONG.NE.NELOLD) THEN
            WRITE(HSMG,'(42HOUTHOM: INCONSISTENT INTG MIX OPTION (EXPE,
     1      24HCTED NUMBER OF MIXTURES=,I5,24H; VALUE FOUND IN L_GEOM ,
     2      7HOBJECT=,I5,2H).)') NELOLD,ILONG
            CALL XABORT(HSMG)
         ENDIF
         CALL LCMGET(IPGEOM,'MIX',IHOM)
         NZS=0
         DO 195 K=1,NELOLD
  195    NZS=MAX(NZS,IHOM(K))
      ELSE
         CALL XABORT('OUTHOM: INVALID KEY WORD.')
      ENDIF
*----
*  MESH-SPLITTING FOR THE IHOM VECTOR.
*----
      IF(NZS.GT.NELOLD) CALL XABORT('OUTHOM: FAILURE 1.')
      IF(ISTATE(11).NE.0) THEN
         CALL SPLIT0(MAXNEL,ITYPE,NCODE,LXOLD,LYOLD,LZOLD,ISPLX,
     1   ISPLY,ISPLZ,NEL,LX,LY,LZ,XXX,YYY,
     2   ZZZ,IHOM,.FALSE.,IMPX)
      ENDIF
*----
*  UNFOLD HEXAGONAL GEOMETRY BIVAC AND TRIVAC CASES.
*----
      CHEX=(ITYPE.EQ.8).OR.(ITYPE.EQ.9)
      LFOLD1=CHEX.AND.(IHEX.NE.9).AND.(HTRACK.EQ.'TRIVAC')
      LFOLD2=CHEX.AND.(IHEX.NE.9).AND.(HTRACK.EQ.'BIVAC').AND.
     1       (IELEM.GT.0).AND.(ICOL.LE.3)
      LFOLD3=CHEX.AND.(IHEX.NE.9).AND.((HTRACK.EQ.'MCCG').OR.
     1       (HTRACK.EQ.'EXCELL'))
      IF(LFOLD1.OR.LFOLD2.OR.LFOLD3) THEN
         ALLOCATE(DP(MAXNEL),MX(LX*LZ))
         DO 200 I=1,LX*LZ
  200    MX(I)=IHOM(I)
         LXOLD=LX
         CALL BIVALL(MAXNEL,IHEX,LXOLD,LX,DP)
         DO 210 KZ=1,LZ
         DO 210 KX=1,LX
         IHOM(KX+(KZ-1)*LX)=0
         KEL=DP(KX)+(KZ-1)*LXOLD
  210    IHOM(KX+(KZ-1)*LX)=MX(KEL)
         DEALLOCATE(MX,DP)
         IF(NEL.NE.LX*LZ) CALL XABORT('OUTHOM: HEX SPLITTING ERROR.')
      ENDIF
*----
*  FORCE DIAGONAL SYMMETRY AND UNFOLD THE IHOM VECTOR.
*----
      IF((NCODE(2).EQ.3).AND.(NCODE(3).EQ.3)) THEN
         K=(LX*(LX+1)/2)*LZ
         DO 230 IZ=LZ,1,-1
         IOFF=(IZ-1)*LX*LY
         DO 230 IY=LY,1,-1
         DO 220 IX=LX,IY+1,-1
  220    IHOM(IOFF+(IY-1)*LX+IX)=IHOM(IOFF+(IX-1)*LY+IY)
         DO 230 IX=IY,1,-1
         IHOM(IOFF+(IY-1)*LX+IX)=IHOM(K)
  230    K=K-1
         IF(K.NE.0) CALL XABORT('OUTHOM: FAILURE 2.')
      ELSE IF((NCODE(1).EQ.3).AND.(NCODE(4).EQ.3)) THEN
         K=(LX*(LX+1)/2)*LZ
         DO 240 IZ=LZ,1,-1
         IOFF=(IZ-1)*LX*LY
         DO 240 IY=LY,1,-1
         DO 240 IX=LX,IY,-1
         IHOM(IOFF+(IY-1)*LX+IX)=IHOM(K)
  240    K=K-1
         DO 250 IZ=1,LZ
         IOFF=(IZ-1)*LX*LY
         DO 250 IY=1,LY
         DO 250 IX=1,IY-1
  250    IHOM(IOFF+(IY-1)*LX+IX)=IHOM(IOFF+(IX-1)*LY+IY)
         IF(K.NE.0) CALL XABORT('OUTHOM: FAILURE 3.')
      ENDIF
      DEALLOCATE(ZZZ,YYY,XXX,ISPLZ,ISPLY,ISPLX)
      DO 260 K=1,NEL
      IF(MAT(K).EQ.0) IHOM(K)=0
  260 CONTINUE
      IF(IMPX.GT.0) THEN
        WRITE(6,'(/15H MERGING INDEX:/(1X,14I5))') (IHOM(K),K=1,NEL)
      ENDIF
      RETURN
      END
