*DECK AXGXEL
      SUBROUTINE AXGXEL(IPGEOM,IPTRKM,IPRINT,GEONAM)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Analyze XEL geometry - XELTRK module.
*
*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): G. Marleau
*
*Parameters: input
* IPGEOM  geometry data structures pointer
* IPTRKM  tracking data structures pointer         
* IPRINT  print level                              
* GEONAM  geometry name
*
*-----------------------------------------------------------------------
*
      USE          GANLIB
      IMPLICIT     NONE
      INTEGER      IOUT,NALB,MREGIO,MXDIM,NSTATE
      CHARACTER    NAMSBR*6
      PARAMETER   (IOUT=6,NALB=6,MREGIO=100000,MXDIM=3,NSTATE=40,
     >             NAMSBR='AXGXEL')
*----
*  ROUTINE PARAMETERS
*----
      TYPE(C_PTR)  IPGEOM
      TYPE(C_PTR)  IPTRKM
      INTEGER      IPRINT
      CHARACTER*12 GEONAM
*----
*  LOCAL VARIABLES
*----
      INTEGER      NCODE(NALB),ICODE(NALB)
      REAL         ALBEDO(NALB)
      INTEGER      MAXGRI(MXDIM),LCLSYM(MXDIM),LCLTRA(MXDIM),
     >             MRGSUR(-NALB:-1)
      INTEGER      ISTATE(NSTATE)
      LOGICAL      LEAKSW,LL1,LL2,L1CELL
      INTEGER      NDIM,NTYPO,NBLOCK,NBMIX,NEXTGE,IFCSYM
      INTEGER      NTOTCO,MAXRO,NGEOME,NGIDL,NTIDL,NUNKO
      INTEGER      NTYP,NTOTCL,MAXR
      INTEGER      NSUR,NSURC,NVOL,NVOLC,NUNK,NSBC
*----
*  ALLOCATABLE ARRAYS
*----
      INTEGER, ALLOCATABLE, DIMENSION(:) :: MRGCEL, NSURO, NVOLO,IDLGEO,
     >   IDLDIM,KEYGEO,IDLTYP,KEYTYP,IDLBLK,KCELLG,KEYTRN,IDLREM, MINDO,
     >    MAXDO,ICORDO,MATGEO,INDEXO,MATTYP,KEYINT,KEYCYL,KEYMRG,MATALB,
     >   MINDIM,MAXDIM, ICORD,INCELL, MATRT, INDEX
      REAL, ALLOCATABLE, DIMENSION(:) :: REMSHO,VOLSRO,VOLSUR,REMESH
*----
*  GET DIMENSIONING INFORMATION
*----
      CALL XELPRP( IPGEOM,  GEONAM,  NDIM, NTYPO , NBLOCK,  NBMIX,
     >             MAXGRI,  ALBEDO, ICODE,  NCODE, LCLSYM, LCLTRA,
     >             MRGSUR,  LEAKSW,   LL1,    LL2, L1CELL, NEXTGE,
     >             IFCSYM,  IPRINT)
*----
*  ALLOCATE MEMORY - 1
*----
      ALLOCATE(MRGCEL(NBLOCK),NSURO(NBLOCK),NVOLO(NBLOCK),
     > IDLGEO(NBLOCK),IDLDIM(NBLOCK),KEYGEO(NBLOCK),IDLTYP(NBLOCK),
     > KEYTYP(NBLOCK),IDLBLK(NBLOCK),KCELLG(3*NBLOCK),KEYTRN(NBLOCK))
*----
*  READ GEOMETRY BLOCK DESCRIPTION
*----
      CALL XELDCL(IPGEOM,GEONAM,NDIM  ,MAXGRI,LCLSYM,NBLOCK,NTYPO ,
     >            LL1   ,LL2   ,IPRINT,NTOTCO,MAXRO ,NGEOME,NTYP  ,
     >            NGIDL ,NTIDL ,NUNKO ,KCELLG,NSURO ,NVOLO ,IDLDIM,
     >            IDLGEO,KEYTRN,KEYGEO,IDLTYP,KEYTYP,MRGCEL,IDLBLK)
*----
*  ALLOCATE MEMORY - 2
*----
      ALLOCATE(IDLREM(NGEOME),MINDO(NTOTCO),MAXDO(NTOTCO),
     > ICORDO(NTOTCO),MATGEO(NGIDL),INDEXO(4*NGIDL))
      ALLOCATE(REMSHO(MAXRO),VOLSRO(NGIDL))
*----
*  PRODUCE REGION NUMBERING AND VOLUME EVALUATION
*----
      CALL XELTRP(IPGEOM,NGIDL ,NDIM  ,NGEOME,L1CELL,NTOTCO,NEXTGE,
     >            MAXRO ,IPRINT,KCELLG,NSURO ,NVOLO ,IDLDIM,IDLGEO,
     >            KEYTRN,MAXDO ,MINDO ,ICORDO,REMSHO,IDLREM,INDEXO,
     >            VOLSRO,MATGEO)
*----
*  RELEASE SOME MEMORY
*----
      DEALLOCATE(KEYTRN)
*----
*  ALLOCATE MEMORY - 3
*----
      ALLOCATE(MATTYP(NTIDL),KEYINT(NUNKO))
*----
*     INTERFACE ALL CELLS IN THE GEOMETRY
*----
      CALL XELBIN(IPGEOM,NDIM  ,NGEOME,L1CELL,  NTYP, NGIDL,NTIDL ,
     >            NBLOCK,MAXGRI,NUNKO ,IPRINT,KCELLG, NSURO,NVOLO ,
     >            IDLGEO,MATGEO,KEYGEO,IDLTYP,IDLBLK,KEYTYP,MATTYP,
     >            KEYINT)
*----
*  ALLOCATE MEMORY - 4
*----
      ALLOCATE(KEYCYL(NBLOCK))
*----
*  COMPUTE ALLOCATION IN EXACT GEOMETRY.
*----
      CALL XELEDC(NDIM  ,MAXGRI,NGEOME,NTOTCO,NTYP  ,NBLOCK,NUNKO ,
     >            NSURO ,NVOLO ,MINDO ,MAXDO ,ICORDO,IDLDIM,KEYGEO,
     >            KEYTYP,IDLBLK,KEYINT,NTOTCL,MAXR  ,NSUR  ,NVOL  ,
     >            KEYCYL)
      NUNK= NVOL + 1 - NSUR
*----
*  ALLOCATE MEMORY - 5
*----
      ALLOCATE(KEYMRG(NUNK),MATALB(NUNK),MINDIM(NTOTCL),MAXDIM(NTOTCL),
     > ICORD(NTOTCL),INDEX(4*NUNK),INCELL(NUNK))
      ALLOCATE(VOLSUR(NUNK),REMESH(MAXR))
*----
*  TO RECONSTRUCT THE MESH IN EXACT GEOMETRY.
*----
      CALL XELETR(IPRINT,NDIM  ,MAXGRI,NGEOME,NTOTCO,NTYP  ,NTIDL ,
     >            NBLOCK,NSUR  ,NVOL  ,NTOTCL,NUNKO ,NSURO ,NVOLO ,
     >            MINDO, MAXDO ,ICORDO,IDLDIM,IDLGEO,KEYGEO,IDLTYP,
     >            KEYTYP,IDLBLK,KEYCYL,REMSHO,IDLREM,INDEXO,VOLSRO,
     >            MATGEO,KEYINT,MATTYP,REMESH,MINDIM,MAXDIM,ICORD ,
     >            VOLSUR,KEYMRG,INDEX ,INCELL,MATALB,NSURC ,NVOLC )
      NSUR=NSURC
      NVOL=NVOLC
      NUNK= NVOL + 1 - NSUR
      DEALLOCATE(KEYCYL,KEYINT,MATTYP,INDEXO,MATGEO,ICORDO,MAXDO,MINDO,
     > IDLBLK,KEYTYP,IDLTYP,KEYGEO,IDLDIM,IDLREM,KCELLG,IDLGEO,NVOLO,
     > NSURO)
      DEALLOCATE(VOLSRO,REMSHO)
*----
*  ALLOCATE MEMORY - 6
*----
      ALLOCATE(MATRT(-NSUR*2))
*----
*  PREPARE MERGING OF ZONES AND SURFACES USING BOUNDARY CONDITIONS.
*  SET UP REFLECTION-TRANSMISSION MATRIX
*----
      CALL XELMRG(IPRINT,NSUR  ,NVOL  ,NSBC  ,NTOTCL,INDEX ,MINDIM,
     >            MAXDIM,LCLSYM,LCLTRA,LL1   ,LL2   ,MRGCEL,MATALB,
     >            KEYMRG,INCELL,MATRT )
*----
*  SAVE EXCELL TRACKING FOR CARTESIAN GEOMETRY
*----
      CALL LCMSIX(IPTRKM,'EXCELL      ',1)
      CALL XDISET(ISTATE,NSTATE,0)
      ISTATE(1)=NDIM
      ISTATE(2)=-NSUR
      ISTATE(3)=NVOL
      ISTATE(4)=NTOTCL
      ISTATE(5)=MAXR
      ISTATE(6)=NUNK
      ISTATE(7)=NEXTGE
      ISTATE(8)=LCLSYM(1)
      ISTATE(9)=LCLSYM(2)
      IF(NDIM .EQ. 3) ISTATE(10)=LCLSYM(3)
*----
*  LL1 is for diagonal symmetry
*  with region Pi/4 to Pi/2 defined in x-y plane
*  LL2 is for diagonal symmetry
*  with region 0 to Pi/4 defined in x-y plane
*----
      IF(LL1) THEN
        ISTATE(11)=-1
      ELSE IF(LL2) THEN
        ISTATE(11)=1
      ENDIF
      CALL LCMPUT(IPTRKM,'MINDIM      ',NTOTCL,1,MINDIM)
      CALL LCMPUT(IPTRKM,'MAXDIM      ',NTOTCL,1,MAXDIM)
      CALL LCMPUT(IPTRKM,'ICORD       ',NTOTCL,1,ICORD )
      CALL LCMPUT(IPTRKM,'INDEX       ',4*NUNK,1,INDEX )
      CALL LCMPUT(IPTRKM,'REMESH      ',MAXR  ,2,REMESH)
      CALL LCMPUT(IPTRKM,'KEYMRG      ',NUNK  ,1,KEYMRG)
      CALL LCMPUT(IPTRKM,'MATALB      ',NUNK  ,1,MATALB)
      CALL LCMPUT(IPTRKM,'VOLSUR      ',NUNK  ,2,VOLSUR)
      CALL LCMPUT(IPTRKM,'STATE-VECTOR',NSTATE,1,ISTATE)
      CALL LCMSIX(IPTRKM,'EXCELL      ',2)
*----
*  SAVE REFLECTION-TRANSMISSION MATRIX
*----
      CALL LCMPUT(IPTRKM,'BC-REFL+TRAN',NSBC,1,MATRT)
      CALL LCMPUT(IPTRKM,'ALBEDO      ',6     ,2,ALBEDO       )
      CALL LCMPUT(IPTRKM,'ICODE       ',6     ,1,ICODE        )
      CALL LCMPUT(IPTRKM,'NCODE       ',6     ,1,NCODE        )
      DEALLOCATE(MATRT)
*----
*  RELEASE REMAINING MEMORY
*----
      DEALLOCATE(INCELL,INDEX,ICORD,MAXDIM,MINDIM,MATALB,KEYMRG,MRGCEL)
      DEALLOCATE(REMESH,VOLSUR)
      RETURN
      END
