*DECK MACINI
      SUBROUTINE MACINI(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
*
*-----------------------------------------------------------------------
*
*Purpose:
* construct a new macrolib that will contain one mixture number per
* material region; fuel-map macrolib is required.
*
*Copyright:
* Copyright (C) 2007 Ecole Polytechnique de Montreal.
*
*Author(s): J. Koclas, E. Varin, D. Sekki
*
*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 type(L_MACROLIB);
*         HENTRY(2): modification type(L_MATEX);
*         HENTRY(3): read-only type(L_MACROLIB);
*         HENTRY(4): read-only type(L_MACROLIB) (optional).
* 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 HSIGN*12,TEXT*12
      INTEGER KCHAR(3),ISTATE(NSTATE)
      DOUBLE PRECISION DFLOT
      LOGICAL LMAP
      TYPE(C_PTR) IPMAC,IPMTX,IPMAC1,IPMAC2,JPMAC,KPMAC
      INTEGER, ALLOCATABLE, DIMENSION(:) :: MIX
      REAL, ALLOCATABLE, DIMENSION(:) :: HFAC
*----
*  PARAMETER VALIDATION
*----
      IF((NENTRY.LE.2).OR.(NENTRY.GE.5)) 
     1  CALL XABORT('@MACINI: 4 PARAMETERS EXPECTED.')
      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2))CALL XABORT('@RMA'
     1 //'C: LCM OBJECT EXPECTED AT LHS.')
      IF(JENTRY(1).NE.0)CALL XABORT('@MACINI: CREATE MODE EXPECTED'
     1 //' FOR L_MACROLIB AT LHS.')
      IPMAC=KENTRY(1)
*     L_MATEX
      IF((IENTRY(2).NE.1).AND.(IENTRY(2).NE.2))CALL XABORT('@RMA'
     1 //'C: LCM OBJECT EXPECTED AT RHS.')
      IF(JENTRY(2).NE.1)CALL XABORT('@MACINI: MODIFICATION MODE EX'
     1 //'PECTED FOR L_MATEX OBJECT.')
      CALL LCMGET(KENTRY(2),'SIGNATURE',KCHAR)
      WRITE(HSIGN,'(3A4)') (KCHAR(I),I=1,3)
      IF(HSIGN.NE.'L_MATEX')THEN
        TEXT=HENTRY(2)
        CALL XABORT('@MACINI: SIGNATURE OF '//TEXT//' IS '//HSIGN//
     1  '. L_MATEX EXPECTED AT RHS.')
      ENDIF
      IPMTX=KENTRY(2)
      DO IEN=3,NENTRY
      IF((IENTRY(IEN).NE.1).AND.(IENTRY(IEN).NE.2))CALL XABORT('@R'
     1 //'MAC: LCM OBJECT EXPECTED AT RHS.')
      IF(JENTRY(IEN).NE.2)CALL XABORT('@MACINI: READ-ONLY MODE EXPEC'
     1 //'TED FOR THE LCM OBJECTS AT RHS.')
      ENDDO
*     L_MACROLIB(1)
      CALL LCMGET(KENTRY(3),'SIGNATURE',KCHAR)
      WRITE(HSIGN,'(3A4)') (KCHAR(I),I=1,3)
      IF(HSIGN.NE.'L_MACROLIB')THEN
        TEXT=HENTRY(3)
        CALL XABORT('@MACINI: SIGNATURE OF '//TEXT//' IS '//HSIGN//
     1  '. FIRST MACROLIB EXPECTED AT RHS.')
      ENDIF
      IPMAC1=KENTRY(3)
*     L_MACROLIB(2)
      IF(NENTRY.EQ.4) THEN
      	CALL LCMGET(KENTRY(4),'SIGNATURE',KCHAR)
      	WRITE(HSIGN,'(3A4)') (KCHAR(I),I=1,3)
      	IF(HSIGN.NE.'L_MACROLIB')THEN
          TEXT=HENTRY(4)
          CALL XABORT('@MACINI: SIGNATURE OF '//TEXT//' IS '//HSIGN//
     1    '. FUEL-MAP MACROLIB EXPECTED AT RHS.')
      	ENDIF
      	IPMAC2=KENTRY(4)
      ELSE
      	IPMAC2=C_NULL_PTR
      ENDIF
*----
*  RECOVER INFORMATION
*----
      CALL XDISET(ISTATE,NSTATE,0)
      CALL LCMGET(IPMAC1,'STATE-VECTOR',ISTATE)
*     MACROLIB(1)-INFO
      NGRP=ISTATE(1)
      NMIX1=ISTATE(2)
      NL=ISTATE(3)
      LEAK=ISTATE(9)
*     MACROLIB(2)-INFO
      IF(NENTRY.EQ.4) THEN
      	CALL XDISET(ISTATE,NSTATE,0)
      	CALL LCMGET(IPMAC2,'STATE-VECTOR',ISTATE)
      	NMIX2=ISTATE(2)
        NL=MAX(ISTATE(3),NL)
        IF(ISTATE(1).NE.NGRP)CALL XABORT('@MACINI: DIFFERENT NGR'
     1 //'P NUMBER IN TWO MACROLIB OBJECTS.')
      	IF(ISTATE(3).NE.NL)CALL XABORT('@MACINI: INCONSISTENT NL'
     1 //' NUMBER IN TWO MACROLIB OBJECTS.')
      	IF(ISTATE(9).NE.LEAK)CALL XABORT('@MACINI: DIFFERENT LEAK'
     1 //' NUMBER IN TWO MACROLIB OBJECTS.')
      ENDIF
      CALL XDISET(ISTATE,NSTATE,0)
      CALL LCMGET(IPMTX,'STATE-VECTOR',ISTATE)
*     MATEX-INFO
      NMIX=ISTATE(2)
      NTOT=ISTATE(5)
      ALLOCATE(MIX(NTOT))
      CALL XDISET(MIX,NTOT,0)
      CALL LCMGET(IPMTX,'MAT',MIX)
      IMPX=1
      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
      IF(ITYP.EQ.10)GOTO 20
      IF(ITYP.NE.3)CALL XABORT('@MACINI: 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('@MACINI: INTEGER FOR EDIT EXPECTED.')
      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
   10 IF(TEXT.NE.';')CALL XABORT('@MACINI: FINAL ; EXPECTED.')
*----
*  NEW MACROLIB CREATION
*----
   20 IF(IMPX.GT.1)WRITE(IOUT,*)'NUMBER OF ENERGY GROUPS  ',NGRP
      IF(IMPX.GT.1)WRITE(IOUT,*)'TOTAL NUMBER OF MIXTURES ',NMIX
*     DO NOT INCLUDE FUEL PROPERTIES
      LMAP=.FALSE.
      IF(IMPX.GT.0)WRITE(IOUT,*)'** TREATING FIRST MACROLIB **'
      CALL MACCRE(IPMAC1,IPMAC,NL,NGRP,NMIX1,NMIX,NTOT,MIX,LMAP,IMPX)
      IF(IMPX.GT.1)CALL LCMLIB(IPMAC)
*     INCLUDE FUEL PROPERTIES
      IF(NENTRY.EQ.4) THEN
      	LMAP=.TRUE.
      	IF(IMPX.GT.0)WRITE(IOUT,*)'** TREATING FUEL-MAP MACROLIB **'
      	CALL MACCRE(IPMAC2,IPMAC,NL,NGRP,NMIX2,NMIX,NTOT,MIX,LMAP,IMPX)
      	DEALLOCATE(MIX)
      ENDIF
*----
*  STATE-VECTOR
*----
      CALL XDISET(ISTATE,NSTATE,0)
      ISTATE(1)=NGRP
      ISTATE(2)=NMIX
      ISTATE(3)=NL
      ISTATE(4)=1
      ISTATE(9)=LEAK
      CALL LCMPUT(IPMAC,'STATE-VECTOR',NSTATE,1,ISTATE)
      HSIGN='L_MACROLIB'
      READ(HSIGN,'(3A4)') (KCHAR(I),I=1,3)
      CALL LCMPUT(IPMAC,'SIGNATURE',3,3,KCHAR)
      IF(IMPX.GT.0)CALL LCMLIB(IPMAC)
*----
*  RECOVER H-FACTOR
*----
      ALLOCATE(HFAC(NMIX*NGRP))
      JPMAC=LCMGID(IPMAC,'GROUP')
      DO JGR=1,NGRP
      KPMAC=LCMGIL(JPMAC,JGR)
      CALL LCMLEN(KPMAC,'H-FACTOR',LENGT,ITYP)
      IF(LENGT.NE.NMIX)CALL XABORT('@MACINI: UNABLE TO FIND H'
     1 //'-FACTOR BLOCK DATA IN THE NEW MACROLIB.')
      CALL LCMGET(KPMAC,'H-FACTOR',HFAC((JGR-1)*NMIX+1))
      ENDDO
      CALL LCMPUT(IPMTX,'H-FACTOR',NMIX*NGRP,2,HFAC)
      DEALLOCATE(HFAC)
      RETURN
      END
