*DECK KELRNG
      FUNCTION KELRNG(  IPRT,   NDIM, NEXTGE,   NCPC,  MINDO,  MAXDO,
     >                ICORDO,  NSURO,  NVOLO, IDLGEO,
     >                  MAXC, RMESHO, MATGEO,  VOLSO, INDEXO )
*
*-----------------------------------------------------------------------
*
*Purpose:
* Renumber all zones and surfaces for a block by the coordinate 
* (rect/cyl) values.
*
*Copyright:
* Copyright (C) 1990 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): R. Roy
*
*Parameters: input
* IPRT    intermediate printing level for output.      
* NDIM    number of dimensions                              
* NEXTGE  rectangular(0)/circular(1) boundary.         
* NCPC    number of cylindres in a type + 3.
* MINDO   min index values for all axes (rect/cyl).    
* MAXDO   max index values for all axes (rect/cyl).    
* ICORDO  principal axis directions (X/Y/Z) meshes.    
* NSURO   number of surfaces for a specific geometry.       
* NVOLO   number of zones for a specific geometry.          
* IDLGEO  specific position for a geometry.            
* MAXC    dimension of rmesho.                       
* RMESHO  real mesh values (rect/cyl).                 
* MATGEO  material numbers corresponding to geometries.     
* VOLSO   volumes and surfaces for each geometry.        
*
*Parameters: output
* INDEXO  coordinates for zones & surfaces of a cell.
* KELRNG  number of surfaces and zones renumbered.
*
*-----------------------------------------------------------------------
*
      IMPLICIT        NONE
*
      INTEGER         KELRNG, IPRT, NDIM, NEXTGE, NCPC, MAXC,
     >                NSURO, NVOLO, IDLGEO
      INTEGER         ICUR(4), MINDO(NCPC), MAXDO(NCPC),
     >                ICORDO(NCPC), INDEXO(4,*), MATGEO(*), IXYZ(3),
     >                MINT(3), MAXT(3), INCT(3), JINT(3), JAXT(3)
      REAL            VOLSO(*), RMESHO(MAXC)
      DOUBLE PRECISION  RECT(2,3), RAC(2), CEC(2), RAYMAX, RAYXY
      LOGICAL         LELCRN
*
      INTEGER         NSU, NVO, IDLGE, NCP, I, J, KSUR, ISUX, IVOX,
     >                INOX, ICX, ICY, ICZ, IDX, IDY, IDZ, JX, JY, JZ,
     >                IMAT, IMATX, IMATY, IMATZ, IMATYZ, IMATR, NBEXT,
     >                JCP, IX, IY, JRAY, NO, NESUR, NEVOL
*
      INTEGER         IOUT, IND
      PARAMETER     ( IOUT=6 )
*
      IND(I)= IDLGE + I
*
      NSU   =  NSURO
      NVO   =  NVOLO
      IDLGE = IDLGEO
      NCP   =  NCPC 
*
*     INITIALISATION OF INDEX AND VARIOUS THINGS
      DO 20 I= NSU, NVO
         MATGEO(IND(I))=0
         VOLSO(IND(I))=0.0
         DO 10 J= 1, 4
            INDEXO(J,IND(I))= 0
   10    CONTINUE
   20 CONTINUE
      KSUR= MOD(NDIM+1,3)
      DO 25 I= 1, 3
         IXYZ(I)= ABS(ICORDO(I))
         JINT(I)= MINDO(IXYZ(I))
         JAXT(I)= MAXDO(IXYZ(I))+1
         IF( ICORDO(I).GT.0 )THEN
            IF( I.EQ.3 )THEN
               MINT(I)= MINDO(IXYZ(I))+1-KSUR
               MAXT(I)= MAXDO(IXYZ(I))+KSUR
            ELSE
               MINT(I)= MINDO(IXYZ(I))
               MAXT(I)= MAXDO(IXYZ(I))+1
            ENDIF
            INCT(I)= +1
         ELSE
            IF( I.EQ.3 )THEN
               MINT(I)= MAXDO(IXYZ(I))+KSUR
               MAXT(I)= MINDO(IXYZ(I))+1-KSUR
            ELSE
               MINT(I)= MAXDO(IXYZ(I))+1
               MAXT(I)= MINDO(IXYZ(I))
            ENDIF
            INCT(I)= -1
         ENDIF
   25 CONTINUE
*
      KELRNG= 0
      ISUX= 0
      IVOX= 0
      INOX= 0
*
*     NUMBER ZONES & SURFACES
      IF( NCP.LT.4 )THEN
*        THERE ARE NO CYLINDER AT ALL
         J= 3
         ICUR(4)= 0
         ICZ= 3
      ELSE
         J= 4
         CEC(1)= DBLE(RMESHO(MINDO(J)-2))
         CEC(2)= DBLE(RMESHO(MINDO(J)-1))
         ICZ= ICORDO(J)
      ENDIF
*
*     AXIS ORDER IN TRUE GEOMETRY
      ICX= MOD(ICZ  , 3) + 1
      ICY= MOD(ICZ+1, 3) + 1
*
*     AXIS ORDER FOR NUMBERING PROCESS
      IDX= IXYZ(ICX)
      IDY= IXYZ(ICY)
      IDZ= IXYZ(ICZ)
*
*     LOOP OVER ALL "ICZ,ICY,ICX" ZONES, THEN RADIUS
      DO 260 JZ= MINT(ICZ), MAXT(ICZ), INCT(ICZ)
         ICUR(IDZ)= JZ-1
         IF( JZ.NE.JINT(ICZ).AND.JZ.NE.JAXT(ICZ) )THEN
            IMATZ= 0
         ELSE
            IMATZ=   - 2*ICZ
            IF(    (INCT(ICZ).EQ.+1.AND.JZ.EQ.MINT(ICZ))
     >         .OR.(INCT(ICZ).EQ.-1.AND.JZ.EQ.MAXT(ICZ)) )
     >              IMATZ= IMATZ+1
         ENDIF
         DO 250 JY= MINT(ICY), MAXT(ICY), INCT(ICY)
            RECT(1,IDY)= DBLE(RMESHO(MAX(JINT(ICY)  ,JY-1)))
            RECT(2,IDY)= DBLE(RMESHO(MIN(JAXT(ICY)-1,JY  )))
            ICUR(IDY)= JY-1
            IF( JY.NE.JINT(ICY).AND.JY.NE.JAXT(ICY) )THEN
               IMATY= 0
            ELSE
               IMATY= -2*IDY
               IF(    (INCT(ICY).EQ.+1.AND.JY.EQ.MINT(ICY))
     >            .OR.(INCT(ICY).EQ.-1.AND.JY.EQ.MAXT(ICY)) )
     >                 IMATY= IMATY+1
            ENDIF
*
*           TO EXCLUDE LINES
            IF( IMATY*IMATZ .NE. 0 ) GO TO 250
            IMATYZ= IMATY + IMATZ
            DO 240 JX= MINT(ICX), MAXT(ICX), INCT(ICX)
               RECT(1,IDX)= DBLE(RMESHO(MAX(JINT(ICX)  ,JX-1)))
               RECT(2,IDX)= DBLE(RMESHO(MIN(JAXT(ICX)-1,JX  )))
               ICUR(IDX)= JX-1
               IF( JX.NE.JINT(ICX).AND.JX.NE.JAXT(ICX) )THEN
                  IMATX= 0
               ELSE
                  IMATX= -2*IDX
                  IF(    (INCT(ICX).EQ.+1.AND.JX.EQ.MINT(ICX))
     >               .OR.(INCT(ICX).EQ.-1.AND.JX.EQ.MAXT(ICX)) )
     >                    IMATX= IMATX+1
               ENDIF
*
*              TO EXCLUDE SINGLE POINTS
               IF( IMATYZ*IMATX .NE. 0 ) GO TO 240
               IMAT= IMATYZ + IMATX
               NBEXT=1
               IF( NCP.GT.3 )THEN
                  IMATR= IMAT
                  RAC(1)= 0.0D0
                  DO 230 JRAY= MINDO(J), MAXDO(J)
                     RAC(2)= DBLE(RMESHO(JRAY))
                     ICUR(4)= JRAY-1
                     IF(LELCRN(CEC,RAC,RECT(1,ICX),RECT(1,ICY)))THEN
                        IF( IMAT.EQ.0 )THEN
*                          ZONE NUMBERING
                           IVOX= IVOX + 1
                           INOX= INOX + 1
                           NO=INOX
                           IMATR= IVOX
                        ELSE
*                          SURFACE NUMBERING
                           ISUX= ISUX - 1
                           NO= ISUX
                        ENDIF
*                       IDENTIFY FACE AND CHARGE THE ZONE OR SURFACE NO
                        MATGEO(IND(NO))= IMATR
                        DO 220 JCP= 1, 4
                           INDEXO(JCP,IND(NO))= ICUR(JCP)
  220                   CONTINUE
                     ELSE
                        IF( IMAT.EQ.0 )THEN
*                          ZONE NUMBERING
                           INOX= INOX + 1
*                       IDENTIFY FACE AND CHARGE THE ZONE OR SURFACE NO
                           MATGEO(IND(INOX))= -1
*                        ELSE
*                          ISUX=ISUX-1
                        ENDIF
                     ENDIF
                     RAC(1)= RAC(2)
  230             CONTINUE
                  ICUR(4)= MAXDO(J)
                  RAYMAX= DBLE(RMESHO(MAXDO(J)))
                  NBEXT=0
                  DO 233 IX= 1, 2
                  DO 232 IY= 1, 2
                  RAYXY= (RECT(IX,ICX)-CEC(1))*(RECT(IX,ICX)-CEC(1))
     >                 + (RECT(IY,ICY)-CEC(2))*(RECT(IY,ICY)-CEC(2))
                    IF( RAYXY.GE.RAYMAX ) NBEXT= NBEXT + 1
  232             CONTINUE
  233             CONTINUE
               ENDIF
               IF( NBEXT.EQ.0 )THEN
*
*                 NUMBER 'INSIDE' OF CYLINDER
                  IF( NEXTGE.EQ.0 )THEN
*
*                    CONSIDER ONLY FOR OVERALL CARTESIAN GEOMETRY
*                    SET IMAT TO -1 TO IDENTIFY REGION EXTRACTED
                     IF( IMAT.EQ.0 )THEN
*
*                       ZONE NUMBERING
                        INOX= INOX + 1
                        MATGEO(IND(INOX))= -1
                     ENDIF
                  ENDIF
               ELSE
*
*                 NUMBER 'OUTSIDE' OF CYLINDER
                  IF( IMAT.EQ.0 )THEN
*
*                    ZONE NUMBERING
                     IVOX= IVOX + 1
                     INOX= INOX + 1
                     IMAT= IVOX
                     NO  = INOX
                  ELSE
*
*                    SURFACE NUMBERING
                     ISUX= ISUX - 1
                     NO= ISUX
                  ENDIF
*
*                 IDENTIFY FACE AND CHARGE THE ZONE OR SURFACE NO
                  MATGEO(IND(NO))= IMAT
                  DO 235 JCP= 1, 4
                     INDEXO(JCP,IND(NO))= ICUR(JCP)
  235             CONTINUE
               ENDIF
  240       CONTINUE
  250    CONTINUE
  260 CONTINUE
*
      KELRNG= IVOX - ISUX + 1
*
      IF( IPRT.GT.5 )THEN
         NESUR= 0
         NEVOL= 0
         DO 549 I= NSU, NVO
            IF( I.GT.0.AND.MATGEO(IND(I)).LT.0 ) NEVOL= NEVOL+1
            IF( I.LT.0.AND.MATGEO(IND(I)).EQ.0 ) NESUR= NESUR-1
  549    CONTINUE
         WRITE(IOUT,'(/13H   NUMBERING ,I8,13H VOLUMES AND ,'//
     >           'I8,10H SURFACES.)') NVO-NEVOL,-NSU+NESUR
         WRITE(IOUT,'(17X,7HMINDIM=,10I8)') (MINDO(J),J=1,NCP)
         WRITE(IOUT,'(17X,7HMAXDIM=,10I8)') (MAXDO(J),J=1,NCP)
*
         DO 550 I= NSU-NESUR, NVO
             WRITE(IOUT,'(8H MATGEO(,I8,2H)=,I6,7H INDEX=,4I8)')
     >                    I, MATGEO(IND(I)), (INDEXO(J,IND(I)),J=1,4)
  550    CONTINUE
      ENDIF
*
      RETURN
      END
