*DECK USPLIT
      SUBROUTINE USPLIT(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
*
*-----------------------------------------------------------------------
*
*Purpose:
* provide a link between the material index and reactor geometry;
* create a matex object.
*
*Copyright:
* Copyright (C) 2007 Ecole Polytechnique de Montreal.
*
*Author(s): J. Koclas, D. Sekki, V. Descotes
*
*Parameters: input/output
* NENTRY  number of LCM objects or files used by the operator.
* HENTRY  name of each LCM object or file:
*         HENTRY(1): create or modification type(L_GEOM);
*         HENTRY(2): create type(L_MATEX);
*         HENTRY(3): optional read-only type(L_GEOM).
* IENTRY  type of each LCM object or file:
*         =1 LCM memory object; =2 XSM file; =3 sequential binary file;
*         =4 sequential ascii file.
* JENTRY  access of each LCM object or file:
*         =0 the LCM object or file is created;
*         =1 the LCM object or file is open for modifications;
*         =2 the LCM object or file is open in read-only mode.
* KENTRY  LCM object address or file unit number.
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
      TYPE(C_PTR)  KENTRY(NENTRY)
      CHARACTER    HENTRY(NENTRY)*12
*----
*  LOCAL VARIABLES
*----
      PARAMETER(NSTATE=40,IOUT=6)
      CHARACTER TEXT*12,HSIGN*12
      INTEGER KCHAR(3),ISTATE(NSTATE),NCODE(6),ZCODE(6)
      DOUBLE PRECISION DFLOT
      TYPE(C_PTR) IPGEO,IPMTX
      INTEGER, ALLOCATABLE, DIMENSION(:) :: ISPLX,ISPLY,ISPLZ,MAT,INDX,
     1 IRMIX,IFMIX
      REAL, ALLOCATABLE, DIMENSION(:) :: XX,YY,ZZ
*----
*  PARAMETER VALIDATION
*----
      IF(NENTRY.LT.2)CALL XABORT('@USPLIT: 2 PARAMETERS EXPECTED.')
      IPGEO=KENTRY(1)
      IPMTX=KENTRY(2)
      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2))CALL XABORT('@USPLIT:'
     1 //' LCM OBJECT EXPECTED AT LHS.')
      IF((IENTRY(2).NE.1).AND.(IENTRY(2).NE.2))CALL XABORT('@USPLIT:'
     1 //' LCM OBJECT EXPECTED AT LHS.')
      IF(JENTRY(1).EQ.0) THEN
        IF(NENTRY.LT.3)CALL XABORT('@USPLIT: 3 PARAMETERS EXPECTED.')
        IF((IENTRY(3).NE.1).AND.(IENTRY(3).NE.2))CALL XABORT('@USPLIT:'
     1  //' LCM OBJECT EXPECTED AT RHS.')
        IF(JENTRY(3).NE.2)CALL XABORT('@USPLIT: READ-ONLY MODE EXPECTE'
     1  //'D FOR L_GEOM.')
        CALL LCMGET(KENTRY(3),'SIGNATURE',KCHAR)
        WRITE(HSIGN,'(3A4)') (KCHAR(I),I=1,3)
        IF(HSIGN.NE.'L_GEOM')THEN
          TEXT=HENTRY(3)
          CALL XABORT('@USPLIT: SIGNATURE OF '//TEXT//' IS '//HSIGN//
     1    '. L_GEOM EXPECTED.')
        ENDIF
        CALL LCMEQU(KENTRY(3),IPGEO)
      ELSE IF(JENTRY(1).EQ.1) THEN
        CALL LCMGET(IPGEO,'SIGNATURE',KCHAR)
        WRITE(HSIGN,'(3A4)') (KCHAR(I),I=1,3)
        IF(HSIGN.NE.'L_GEOM')THEN
          TEXT=HENTRY(1)
          CALL XABORT('@USPLIT: SIGNATURE OF '//TEXT//' IS '//HSIGN//
     1    '. L_GEOM EXPECTED.')
        ENDIF
      ELSE
        TEXT=HENTRY(1)
        CALL XABORT('@USPLIT: CREATE OR MODFICATION MODE EXPECTED FOR '
     1  //TEXT//'.')
      ENDIF
      IF(JENTRY(2).NE.0)CALL XABORT('@USPLIT: CREATE MODE EXPECTED FOR'
     1 //' L_MATEX.')
*----
*  RECOVER STATE-VECTOR INFORMATION
*----
      CALL XDISET(ISTATE,NSTATE,0)
      CALL LCMGET(IPGEO,'STATE-VECTOR',ISTATE)
      IGEO=ISTATE(1)
      NMAT=ISTATE(7)
      IF((IGEO.NE.7).AND.(IGEO.NE.9))CALL XABORT('@USPLIT: ONLY '
     1 //' 3D-CARTESIAN OR 3D-HEXAGONAL GEOMETRY ALLOWED.')
*----
*  READ INFORMATION
*----
      IMPX=1
      NREFL=0
      NFUEL=0
      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
      IF(ITYP.NE.3)CALL XABORT('@USPLIT: CHARACTER DATA EXPECTED.')
      IF(TEXT.NE.'EDIT')GOTO 10
*     READ PRINTING INDEX
      CALL REDGET(ITYP,IMPX,FLOT,TEXT,DFLOT)
      IF(ITYP.NE.1)CALL XABORT('@USPLIT: INTEGER FOR EDIT EXPECTED.')
*     NUMBER OF ENERGY GROUPS
      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
   10 IF(TEXT.NE.'NGRP')CALL XABORT('@USPLIT: KEYWORD NGRP EXPECTED.')
      CALL REDGET(ITYP,NGRP,FLOT,TEXT,DFLOT)
      IF(ITYP.NE.1)CALL XABORT('@USPLIT: INTEGER DATA EXPECTED(1).')
      IF(NGRP.LT.1)CALL XABORT('@USPLIT: INVALID NUMBER FOR NGRP.')
*     MAXIMUM NUMBER OF REGIONS
      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
      IF(TEXT.NE.'MAXR')CALL XABORT('@USPLIT: KEYWORD MAXR EXPECTED.')
      CALL REDGET(ITYP,MAXR,FLOT,TEXT,DFLOT)
      IF(ITYP.NE.1)CALL XABORT('@USPLIT: INTEGER DATA EXPECTED(6).')
      IF(MAXR.LT.1)CALL XABORT('@USPLIT: INVALID NUMBER FOR MAXR.')
   20 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
*     NUMBER OF REFLECTOR TYPES
      IF(TEXT.EQ.'NREFL') THEN
      CALL REDGET(ITYP,NREFL,FLOT,TEXT,DFLOT)
      IF(ITYP.NE.1)CALL XABORT('@USPLIT: INTEGER DATA EXPECTED(2).')
      IF(NREFL.LT.1)CALL XABORT('@USPLIT: REFLECTOR NOT DEFINED.')
      IF(NREFL.GT.NMAT-1)CALL XABORT('@USPLIT: WRONG NUMBER OF '
     1 //'REFLECTOR TYPES.')
*     REFLECTOR MIXTURES
      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
      IF(TEXT.NE.'RMIX')CALL XABORT('@USPLIT: KEYWORD RMIX EXPECTED.')
      ALLOCATE(IRMIX(NREFL))
      DO I=1,NREFL
        CALL REDGET(ITYP,IRMIX(I),FLOT,TEXT,DFLOT)
        IF(ITYP.NE.1)CALL XABORT('@USPLIT: INTEGER DATA EXPECTED(3).')
        IF(IRMIX(I).LT.1)CALL XABORT('@USPLIT: INVALID RMIX'
     1   //' NUMBER < 1.')
        IF(IRMIX(I).GT.NMAT)CALL XABORT('@USPLIT: INVALID RMIX NUMBER '
     1   //'> NBMIX.')
      ENDDO
      GOTO 20
      ENDIF
*     NUMBER OF FUEL TYPES
      IF(TEXT.EQ.'NFUEL') THEN
        CALL REDGET(ITYP,NFUEL,FLOT,TEXT,DFLOT)
        IF(ITYP.NE.1)CALL XABORT('@USPLIT: INTEGER DATA EXPECTED(4).')
        IF(NFUEL.LT.1)CALL XABORT('@USPLIT: FUEL NOT DEFINED.')
        IF(NREFL+NFUEL.NE.NMAT)THEN
          WRITE(IOUT,*)'@USPLIT: NREFL:',NREFL,', NFUEL:',NFUEL 
          WRITE(IOUT,*)'@USPLIT: TOTAL NUMBER OF MATERIALS ',NMAT 
          CALL XABORT('@USPLIT: WRONG NUMBER OF REFLECTOR OR FUEL TYPE'
     1    //'S.')
        ENDIF
*       FUEL MIXTURES
        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
        IF(TEXT.NE.'FMIX')CALL XABORT('@USPLIT: KEYWORD FMIX EXPECTED.')
        ALLOCATE(IFMIX(NFUEL))
        DO I=1,NFUEL
          CALL REDGET(ITYP,IFMIX(I),FLOT,TEXT,DFLOT)
          IF(ITYP.NE.1)CALL XABORT('@USPLIT: INTEGER DATA EXPECTED(5).')
          IF(IFMIX(I).LT.1)CALL XABORT('@USPLIT: INVALID FMIX NUMBER '
     1    //'< 1.')
          IF(IFMIX(I).GT.NMAT)CALL XABORT('@USPLIT: INVALID FMIX NUMBE'
     1    //'R > NBMIX.')
        ENDDO
        GOTO 20
      ENDIF
      IF(TEXT.NE.';')CALL XABORT('@USPLIT: FINAL ; EXPECTED.')
*----
*  RECOVER INFORMATION
*----
      IMPX0=MAX(0,IMPX-1)
      ALLOCATE(ISPLX(MAXR),ISPLY(MAXR),ISPLZ(MAXR),MAT(MAXR))
      ALLOCATE(XX(MAXR+1),YY(MAXR+1),ZZ(MAXR+1))
      CALL READ3D(MAXR,MAXR,MAXR,MAXR,IPGEO,IHEX,IR,MAT,ILK,SIDE,XX,YY,
     1 ZZ,IMPX0,LX,LY,LZ,NEL,NCODE,ZCODE,ISPLX,ISPLY,ISPLZ)
      IF((NEL.NE.LX*LY*LZ).AND.(IHEX.EQ.0))CALL XABORT('@USPLIT: WRONG'
     1 // ' GEOMETRY.')
      IF((NEL.NE.LX*LZ).AND.(IHEX.NE.0))CALL XABORT('@USPLIT: WRONG' 
     1 // ' HEXAGONAL GEOMETRY, WRONG NUMBER OF ELEMENTS.')
      DEALLOCATE(ISPLZ,ISPLY,ISPLX)
      IF(IHEX.EQ.0) THEN
        CALL LCMPUT(IPMTX,'MESHX',LX+1,2,XX)
        CALL LCMPUT(IPMTX,'MESHY',LY+1,2,YY)
        CALL LCMPUT(IPMTX,'MESHZ',LZ+1,2,ZZ)
        CALL LCMPUT(IPGEO,'MESHX',LX+1,2,XX)
        CALL LCMPUT(IPGEO,'MESHY',LY+1,2,YY)
        CALL LCMPUT(IPGEO,'MESHZ',LZ+1,2,ZZ)
        DEALLOCATE(ZZ,YY,XX)
      ELSE
        CALL LCMPUT(IPMTX,'SIDE',1,2,SIDE)
        CALL LCMPUT(IPMTX,'MESHZ',LZ+1,2,ZZ)
        CALL LCMPUT(IPGEO,'SIDE',1,2,SIDE)
        CALL LCMPUT(IPGEO,'MESHZ',LZ+1,2,ZZ)
        DEALLOCATE(ZZ,YY,XX)
        LY=0
      ENDIF
*     NEW MATERIAL INDEX
      ALLOCATE(INDX(NEL))
      IF(NREFL.EQ.0) ALLOCATE(IRMIX(1))
      IF(NFUEL.EQ.0) ALLOCATE(IFMIX(1))
      CALL USPMIX(IPMTX,NEL,NREFL,NFUEL,MAT,IRMIX,IFMIX,INDX,NMIX)
*     MODIFY GEOMETRY
      ISTATE(3)=LX
      ISTATE(4)=LY
      ISTATE(5)=LZ
      ISTATE(6)=NEL
      ISTATE(7)=NMIX
      ISTATE(11)=0
      CALL LCMPUT(IPGEO,'STATE-VECTOR',NSTATE,1,ISTATE)
      CALL LCMPUT(IPGEO,'MIX',NEL,1,INDX)
      DEALLOCATE(IFMIX,IRMIX,INDX,MAT)
*----
*  STATE-VECTOR FOR MATEX
*----
      NTOT=NEL
      HSIGN='L_MATEX'
      READ(HSIGN,'(3A4)') (KCHAR(I),I=1,3)
      CALL LCMPUT(IPMTX,'SIGNATURE',3,3,KCHAR)
      CALL XDISET(ISTATE,NSTATE,0)
      ISTATE(1)=NGRP
      ISTATE(2)=NMIX
      ISTATE(3)=NREFL
      ISTATE(4)=NFUEL
      ISTATE(5)=NTOT
      ISTATE(6)=IGEO
      ISTATE(7)=NEL
      ISTATE(8)=LX
      ISTATE(9)=LY
      ISTATE(10)=LZ
      CALL LCMPUT(IPMTX,'STATE-VECTOR',NSTATE,1,ISTATE)
      IF(IMPX.GT.0) CALL LCMLIB(IPMTX)
      RETURN
      END
