*DECK NEWMDV
      SUBROUTINE NEWMDV(IPMTX,IPMAC,IPMAC2,IPDEV,NMIX,NGRP,NL,LEAK,NEL,
     1 LX,LY,LZ,XFAC,IMPX)
*
*-----------------------------------------------------------------------
*
*Purpose:
* update the material properties and store them in a new macrolib.
*
*Copyright:
* Copyright (C) 2007 Ecole Polytechnique de Montreal.
*
*Author(s): D. Sekki
*
*Parameters: input
* IPMTX   pointer to matex information.
* IPMAC   pointer to create mode macrolib.
* IPMAC2  pointer to read-only mode macrolib.
* IPDEV   pointer to device information.
* NMIX    maximum number of material mixtures.
* NGRP    number of energy groups.
* NL      number of legendre orders (=1 for isotropic scattering).
* LEAK    diffusion coefficient flag (=1: isotropic; =2: anisotropic).
* NEL     total number of elements.
* LX      number of elements along x-axis.
* LY      number of elements along y-axis.
* LZ      number of elements along z-axis.
* XFAC    corrective factor for delta sigmas.
* IMPX    printing index (=0 for no print).
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      TYPE(C_PTR) IPMTX,IPMAC,IPMAC2,IPDEV
      INTEGER NMIX,NGRP,NL,LEAK,NEL,LX,LY,LZ
      REAL XFAC
*----
*  LOCAL VARIABLES
*----
      PARAMETER(NSTATE=40,IOUT=6,EPSI=1.0E-4,MAXPRT=10)
      INTEGER INDX(NEL),ISTATE(NSTATE),DMIX(2,MAXPRT),INAME(3)
      REAL MESHX(LX+1),MESHY(LY+1),MESHZ(LZ+1),DPOS(6,MAXPRT),LEVEL
      CHARACTER RNAME*12
      TYPE(C_PTR) JPDEV,KPDEV
      INTEGER, ALLOCATABLE, DIMENSION(:) :: IJJ,NJJ
      REAL, ALLOCATABLE, DIMENSION(:) :: TOT0,TOT1,NUSIG,SIGF,DIFX,
     1 DIFY,DIFZ,HFAC,SCAT
*----
*  RECOVER EXISTING PROPERTIES
*----
      ALLOCATE(IJJ(NMIX*NGRP*NL),NJJ(NMIX*NGRP*NL),TOT0(NMIX*NGRP),
     1 TOT1(NMIX*NGRP),NUSIG(NMIX*NGRP),SIGF(NMIX*NGRP),DIFX(NMIX*NGRP),
     2 DIFY(NMIX*NGRP),DIFZ(NMIX*NGRP),HFAC(NMIX*NGRP),
     3 SCAT(NMIX*NL*NGRP*NGRP))
      CALL NEWMGT(IPMAC2,NMIX,NGRP,NL,LEAK,TOT0,TOT1,NUSIG,SIGF,DIFX,
     1 DIFY,DIFZ,HFAC,IJJ,NJJ,SCAT)
*----
*  RECOVER MATEX INFORMATION
*----
      CALL XDRSET(MESHX,LX+1,0.)
      CALL XDRSET(MESHY,LY+1,0.)
      CALL XDRSET(MESHZ,LZ+1,0.)
      CALL LCMGET(IPMTX,'MESHX',MESHX)
      CALL LCMGET(IPMTX,'MESHY',MESHY)
      CALL LCMGET(IPMTX,'MESHZ',MESHZ)
      CALL XDISET(INDX,NEL,0)
      CALL LCMGET(IPMTX,'INDEX',INDX)
      CALL LCMGET(IPDEV,'STATE-VECTOR',ISTATE)
      IF(ISTATE(2).EQ.0)GOTO 20
*----
*  UPDATE ROD PROPERTIES
*----
      ITOT=0
      NROD=ISTATE(2)
      JPDEV=LCMGID(IPDEV,'DEV_ROD')
      IF(IMPX.GT.0)WRITE(IOUT,1000)
      DO 10 ID=1,NROD
      KPDEV=LCMGIL(JPDEV,ID)
      IF(IMPX.GT.5)CALL LCMLIB(KPDEV)
      CALL LCMGET(KPDEV,'LEVEL',LEVEL)
      IF(LEVEL.LT.EPSI)GOTO 10
      CALL LCMGET(KPDEV,'ROD-NAME',INAME)
      WRITE(RNAME,'(3A4)') (INAME(I),I=1,3)
      CALL LCMGET(KPDEV,'ROD-PARTS',NPART)
      IF(NPART.GT.MAXPRT) CALL XABORT('NEWMDV: MAXPRT OVERFLOW.')
      CALL LCMGET(KPDEV,'ROD-POS',DPOS)
      CALL LCMGET(KPDEV,'ROD-MIX',DMIX)
      DO 5 IPART=1,NPART
      IF(IMPX.GT.2)WRITE(IOUT,1001)ID,IPART,RNAME,LEVEL,DPOS(1,IPART)
      CALL NEWMVF(INDX,DPOS(1,IPART),DMIX(1,IPART),NGRP,NL,LEAK,NEL,
     1 NMIX,LX,LY,LZ,MESHX,MESHY,MESHZ,TOT0,TOT1,NUSIG,SIGF,DIFX,DIFY,
     2 DIFZ,HFAC,SCAT,XFAC,IMPX)
      IF(IMPX.GT.2)WRITE(IOUT,1002)
    5 CONTINUE
      ITOT=ITOT+1
   10 CONTINUE
      IF(IMPX.GT.0)WRITE(IOUT,1003)ITOT
   20 IF(ISTATE(4).EQ.0)GOTO 40
*----
*  UPDATE LZC PROPERTIES
*----
      ITOT=0
      NLZC=ISTATE(4)
      JPDEV=LCMGID(IPDEV,'DEV_LZC')
      IF(IMPX.GT.0)WRITE(IOUT,1004)
      DO 30 ID=1,NLZC
      KPDEV=LCMGIL(JPDEV,ID)
      IF(IMPX.GT.2)WRITE(IOUT,1005)ID
      IF(IMPX.GT.5)CALL LCMLIB(KPDEV)
*     EMPTY-PART
      CALL LCMGET(KPDEV,'EMPTY-POS',DPOS)
      CALL LCMGET(KPDEV,'EMPTY-MIX',DMIX)
      IF(IMPX.GT.2)WRITE(IOUT,1006)DPOS
      CALL NEWMVF(INDX,DPOS,DMIX,NGRP,NL,LEAK,NEL,NMIX,LX,LY,LZ,MESHX,
     1 MESHY,MESHZ,TOT0,TOT1,NUSIG,SIGF,DIFX,DIFY,DIFZ,HFAC,SCAT,XFAC,
     2 IMPX)
*     FULL-PART
      CALL LCMGET(KPDEV,'FULL-POS',DPOS)
      CALL LCMGET(KPDEV,'FULL-MIX',DMIX)
      IF(IMPX.GT.2)WRITE(IOUT,1007)DPOS
      CALL NEWMVF(INDX,DPOS,DMIX,NGRP,NL,LEAK,NEL,NMIX,LX,LY,LZ,MESHX,
     1 MESHY,MESHZ,TOT0,TOT1,NUSIG,SIGF,DIFX,DIFY,DIFZ,HFAC,SCAT,XFAC,
     2 IMPX)
      IF(IMPX.GT.2)WRITE(IOUT,1002)
      ITOT=ITOT+1
   30 CONTINUE
      IF(IMPX.GT.0)WRITE(IOUT,1008)ITOT
*----
*  STORE NEW PROPERTIES
*----
   40 CALL NEWMPT(IPMAC,NMIX,NGRP,NL,LEAK,TOT0,TOT1,NUSIG,SIGF,DIFX,
     1 DIFY,DIFZ,HFAC,IJJ,NJJ,SCAT)
*
      DEALLOCATE(NJJ,IJJ,SCAT,HFAC,DIFZ,DIFY,DIFX,SIGF,NUSIG,TOT1,TOT0)
      RETURN
*
 1000 FORMAT(/1X,'**',1X,'UPDATING PROPERTIES',
     1  1X,'FOR ALL INSERTED RODS',1X,'**'/)
 1001 FORMAT(
     1 /5X,'=>',2X,'ROD-ID #',I3.3,' PART:',I4,5X,'ROD-NAME:',1X,A
     2 /1X,'ROD INSERTION LEVEL =',F8.4
     3 /1X,'CURRENT ROD POSITION :'
     4 /1X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4
     5 /1X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4)
 1002 FORMAT(/1X,38('-')/)
 1003 FORMAT(/1X,'TOTAL NUMBER OF TREATED RODS:',I3/)
*
 1004 FORMAT(/1X,'**',1X,'UPDATING PROPERTIES',
     1  1X,'FOR ALL LZC-DEVICES',1X,'**'/)
 1005 FORMAT(/5X,'=>',2X,'LZC-ID #',I2.2)
 1006 FORMAT(/1X,'EMPTY-PART POSITION :'
     1 /1X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4
     2 /1X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4)
 1007 FORMAT(/1X,'FULL-PART POSITION :'
     1 /1X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4
     2 /1X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4)
 1008 FORMAT(/1X,'TOTAL NUMBER OF TREATED LZC:',I2/)
      END
