*DECK GEODIN
      SUBROUTINE GEODIN (GEONAM,IPLIST,LEVEL,IMPX,MAXMIX)
*
*-----------------------------------------------------------------------
*
*Purpose:
* read and/or modify an object oriented geometry
*
*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): A. Hebert
*
*Parameters: input
* GEONAM  name of the directory where the geometry is stored.
* IPLIST  pointer to the geometry LCM object (L_GEOM signature).
* LEVEL   hierarchical level of the geometry.
* IMPX    print flag (IMPX=0 for no print).
*
*Parameters: output
* MAXMIX  maximum number of mixtures, considering all sub-geometries.
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      TYPE(C_PTR) IPLIST
      INTEGER LEVEL,IMPX,MAXMIX
      CHARACTER GEONAM*12
*----
*  LOCAL VARIABLES
*----
      PARAMETER (MAXCOD=21,MAXHEX=9,MAXTEX=4,MAXTUR=12,MAXTYP=30,
     1 MXCL=500,NSTATE=40,IOUT=6)
      LOGICAL LHEX,LTRI,EMPTY,LCM,SWANG
      LOGICAL LTOT,LCOUR
      CHARACTER NAMT*12,COND(MAXCOD)*4,CHEX(MAXHEX)*8,CHET(MAXTEX)*8,
     1 CTUR(MAXTUR)*1,TYPE(0:MAXTYP)*16,TEXT4*4,CARLIR*12,TEXT12*12,
     2 DIR*1
      INTEGER ISTATE(NSTATE),NCODE(6),ICODE(6)
      REAL ZCODE(6)
      DOUBLE PRECISION DBLLIR
      EQUIVALENCE (LR,ISTATE(2)),(LX,ISTATE(3)),(LY,ISTATE(4)),
     1 (LZ,ISTATE(5)),(LREG,ISTATE(6))
      INTEGER, DIMENSION(:), ALLOCATABLE :: MIX,MERGE,TURN,MESH
      REAL, DIMENSION(:), ALLOCATABLE :: RMESH,XR0,RR0,ANG
      CHARACTER(LEN=12), DIMENSION(:), ALLOCATABLE :: CELL
*----
*  Data
*----
      SAVE  COND,CHEX,CTUR,TYPE
      DATA  COND
     >      /'VOID','REFL','DIAG','TRAN','SYME',
     >       'ALBE','ZERO','PI/2','PI'  ,'SSYM',
     >        9*' ','CYLI','ACYL'/
      DATA  CHEX
     >      /'S30     ','SA60    ','SB60    ','S90     ','R120    ',
     >       'R180    ','SA180   ','SB180   ','COMPLETE'/
      DATA  CTUR
     >      /'A','B','C','D','E','F','G','H','I','J','K','L'/
      DATA  TYPE
     >      /'VIRTUAL         ','HOMOGENEOUS     ','CARTESIAN 1-D   ',
     >       'TUBE 1-D        ','SPHERE 1-D      ','CARTESIAN 2-D   ',
     >       'TUBE 2-D (Z)    ','CARTESIAN 3-D   ','HEXAGONAL 2-D   ',
     >       'HEXAGONE 3-D (Z)','TUBE 2-D (X)    ','TUBE 2-D (Y)    ',
     >       'R-THETA         ','TRIANGULAR 2-D  ','TRIANGULAR 3-D  ',
     >       '                ','                ','                ',
     >       '                ','                ','2-D RECT. CELL  ',
     >       '3-D RECT. CELL X','3-D RECT. CELL Y','3-D RECT. CELL X',
     >       '2-D HEX. CELL   ','3-D HEX. CELL Z ','                ',
     >       '                ','                ','                ',
     >       'DO-IT-YOURSELF  '/
*
      MINMIX=0
      MINICO=1
      CALL LCMLEN(IPLIST,'SIGNATURE',ILONG,ITYX)
      IF(ILONG.EQ.0) THEN
*       INPUT A NEW GEOMETRY.
        DO 10 I=1,NSTATE
   10   ISTATE(I)=0
        LHEX=.FALSE.
        LTRI=.FALSE.
        LCOUR=.FALSE.
        DO 20 I=1,6
        NCODE(I)=0
        ZCODE(I)=0.0
   20   ICODE(I)=0
      ELSE
*       MODIFY AN EXISTING GEOMETRY.
        CALL LCMGTC(IPLIST,'SIGNATURE',12,1,CARLIR)
        IF(CARLIR.NE.'L_GEOM') THEN
          NAMT=GEONAM
          CALL XABORT('GEODIN: SIGNATURE OF '//NAMT//' IS '//CARLIR
     1    //'. L_GEOM EXPECTED.')
        ENDIF
        CALL LCMGET(IPLIST,'STATE-VECTOR',ISTATE)
        LHEX=(ISTATE(1).EQ.8).OR.(ISTATE(1).EQ.9).OR.(ISTATE(1).EQ.24)
     1  .OR.(ISTATE(1).EQ.25)
        LTRI=(ISTATE(1).EQ.13).OR.(ISTATE(1).EQ.14)
        LCOUR=.FALSE.
        IF(LHEX) THEN
          CALL LCMGET(IPLIST,'IHEX',IHEX)
          LCOUR=IHEX.EQ.9
        ENDIF
        CALL LCMGET(IPLIST,'NCODE',NCODE)
        CALL LCMGET(IPLIST,'ZCODE',ZCODE)
        CALL LCMGET(IPLIST,'ICODE',ICODE)
        IF(LEVEL.EQ.1) GO TO 50
      ENDIF
*
      CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
      IF(ITYPLU.NE.3) CALL XABORT('GEODIN: CHARACTER DATA EXPECTED(1).')
      IF(CARLIR.EQ.'VIRTUAL') THEN
        ISTATE(1)=0
      ELSE IF(CARLIR.EQ.'HOMOGE') THEN
        ISTATE(1)=1
        LREG=1
      ELSE IF(CARLIR.EQ.'CAR1D') THEN
        ISTATE(1)=2
        CALL REDGET(ITYPLU,LX,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTED.')
        LREG=LX
      ELSE IF(CARLIR.EQ.'SPHERE') THEN
        ISTATE(1)=4
        CALL REDGET(ITYPLU,LR,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTED.')
        LREG=LR
      ELSE IF(CARLIR.EQ.'CAR2D') THEN
        ISTATE(1)=5
        CALL REDGET(ITYPLU,LX,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTED.')
        CALL REDGET(ITYPLU,LY,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTED.')
        LREG=LX*LY
      ELSE IF(CARLIR.EQ.'CAR3D') THEN
        ISTATE(1)=7
        CALL REDGET(ITYPLU,LX,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTED.')
        CALL REDGET(ITYPLU,LY,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTED.')
        CALL REDGET(ITYPLU,LZ,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTED.')
        LREG=LX*LY*LZ
      ELSE IF(CARLIR.EQ.'HEX') THEN
        ISTATE(1)=8
        LHEX=.TRUE.
        CALL REDGET(ITYPLU,LX,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTED.')
        LREG=LX
      ELSE IF(CARLIR.EQ.'HEXZ') THEN
        ISTATE(1)=9
        LHEX=.TRUE.
        CALL REDGET(ITYPLU,LX,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTED.')
        CALL REDGET(ITYPLU,LZ,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTED.')
        LREG=LX*LZ
      ELSE IF(CARLIR.EQ.'TRI') THEN
        ISTATE(1)=13
        LTRI=.TRUE.
        CALL REDGET(ITYPLU,LX,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTED.')
        LREG=LX
      ELSE IF(CARLIR.EQ.'TRIZ') THEN
        ISTATE(1)=14
        LTRI=.TRUE.
        CALL REDGET(ITYPLU,LX,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTED.')
        CALL REDGET(ITYPLU,LZ,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTED.')
        LREG=LX*LZ
      ELSE IF(CARLIR.EQ.'RTHETA') THEN
        ISTATE(1)=12
        CALL REDGET(ITYPLU,LR,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTED.')
        CALL REDGET(ITYPLU,LZ,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTED.')
        LREG=LR*LZ
      ELSE IF(CARLIR(1:4).EQ.'TUBE') THEN
        DIR=CARLIR(5:5)
        CALL REDGET(ITYPLU,LR,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTED.')
        IF(DIR.EQ.' ') THEN
          ISTATE(1)=3
          LX=1
          LY=1
          IRLXY=1
          CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
          IF(ITYPLU.EQ.3) THEN
            IRLXY=0
          ELSE IF(ITYPLU.EQ.2) THEN
            CALL XABORT('GEODIN: INVALID REAL DATA.')
          ELSE
            LX=INTLIR
            CALL REDGET(ITYPLU,LY,REALIR,CARLIR,DBLLIR)
            IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTE'
     1      //'D.')
          ENDIF
          LREG=LR*LY*LX
          IF(IRLXY.EQ.0) GO TO 60
        ELSE
          LX=1
          LY=1
          LZ=1
          CALL REDGET(ITYPLU,LX,REALIR,CARLIR,DBLLIR)
          IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTED.')
          CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
          IRLYZ=-99
          IF(ITYPLU.EQ.3) THEN
            IRLYZ=0
          ELSE IF(ITYPLU.EQ.2) THEN
            CALL XABORT('GEODIN: REAL DATA NOT EXPECTED.')
          ELSE
            LY=INTLIR
            IRLYZ=1
            CALL REDGET(ITYPLU,LZ,REALIR,CARLIR,DBLLIR)
            IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTE'
     1      //'D.')
          ENDIF
          LREG=LR*LY*LZ*LX
          IF(DIR.EQ.'X') THEN
            ISTATE(1)=10
            IF(IRLYZ.EQ.0) GO TO 60
          ELSE IF(DIR.EQ.'Y') THEN
            ISTATE(1)=11
            IF(IRLYZ.EQ.0) THEN
              LY=LX
              LX=1
              GO TO 60
            ENDIF
          ELSE IF(DIR.EQ.'Z') THEN
            ISTATE(1)=6
            IF(IRLYZ.EQ.0) THEN
              LZ=LX
              LX=1
              GO TO 60
            ENDIF
          ELSE
            CALL XABORT('GEODIN: INVALID DATA IN TUBE CONSTRUCT.')
          ENDIF
        ENDIF
      ELSE IF(CARLIR(1:6).EQ.'CARCEL') THEN
        CALL REDGET(ITYPLU,LR,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTED.')
        DIR=CARLIR(7:7)
        IF(DIR.EQ.' ') THEN
          ISTATE(1)=20
          LX=1
          LY=1
          IRLXY=1
          CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
          IF(ITYPLU.EQ.3) THEN
            IRLXY=0
          ELSE IF(ITYPLU.EQ.2) THEN
            CALL XABORT('GEODIN: INVALID REAL DATA.')
          ELSE
            LX=INTLIR
            CALL REDGET(ITYPLU,LY,REALIR,CARLIR,DBLLIR)
            IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTE'
     1      //'D.')
          ENDIF
          LREG=(LR+1)*LY*LX
          IF(IRLXY.EQ.0) GO TO 60
        ELSE
          LX=1
          LY=1
          LZ=1
          CALL REDGET(ITYPLU,LX,REALIR,CARLIR,DBLLIR)
          IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTED.')
          CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
          IRLYZ=-99
          IF(ITYPLU.EQ.3) THEN
            IRLYZ=0
          ELSE IF(ITYPLU.EQ.2) THEN
            CALL XABORT('GEODIN: INVALID REAL DATA.')
          ELSE
            LY=INTLIR
            IRLYZ=1
            CALL REDGET(ITYPLU,LZ,REALIR,CARLIR,DBLLIR)
            IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTE'
     1      //'D.')
          ENDIF
          LREG=(LR+1)*LY*LZ*LX
          IF(DIR.EQ.'X') THEN
            ISTATE(1)=21
          ELSE IF(DIR.EQ.'Y') THEN
            ISTATE(1)=22
            IF(IRLYZ.EQ.0) THEN
              LY=LX
              LX=1
              GO TO 60
            ENDIF
          ELSE IF(DIR.EQ.'Z') THEN
            ISTATE(1)=23
            IF(IRLYZ.EQ.0) THEN
              LZ=LX
              LX=1
              GO TO 60
            ENDIF
          ELSE
            CALL XABORT('GEODIN: INVALID DATA.')
          ENDIF
        ENDIF
      ELSE IF(CARLIR(1:6).EQ.'HEXCEL') THEN
        LHEX=.TRUE.
        CALL REDGET(ITYPLU,LR,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTED.')
        LX=1
        IF(CARLIR(7:7).EQ.' ') THEN
          ISTATE(1)=24
          LREG=LR+1
        ELSE IF(CARLIR(7:7).EQ.'Z') THEN
          ISTATE(1)=27
          CALL REDGET(ITYPLU,LZ,REALIR,CARLIR,DBLLIR)
          IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTED.')
          LREG=(LR+1)*LZ
        ELSE
          CALL XABORT('GEODIN: INVALID SUFFIX FOR HEXCEL.')
        ENDIF
      ELSE IF(CARLIR.EQ.'GROUP') THEN
*       DO-IT-YOURSELF OPTION.
        ISTATE(1)=30
        CALL REDGET(ITYPLU,LX,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTED.')
        LREG=LX
      ELSE IF(CARLIR.NE.GEONAM) THEN
*       COPY ATTRIBUTES FROM AN EXISTING GEOMETRY LOCATED ON A PARALLEL
*       DIRECTORY OF THE LCM OBJECT POINTED BY IPLIST.
        IF(LEVEL.EQ.1) CALL XABORT('GEODIN: THE GEOMETRY NAME SHOULD A'
     1  //'PPEAR BEFORE THE ::.')
        CALL LCMSIX(IPLIST,' ',2)
        CALL LCMLEN(IPLIST,CARLIR,ILONG,ITYX)
        IF(ILONG.EQ.0) CALL XABORT('GEODIN: UNKNOWN GEOMETRY.')
        CALL LCMSIX(IPLIST,CARLIR,1)
        IFILE=KDROPN('DUMMYSQ',0,2,0,0)
        IF(IFILE.LE.0) CALL XABORT('GEODIN: KDROPN FAILURE.')
        CALL LCMEXP(IPLIST,0,IFILE,1,1)
        REWIND(IFILE)
        CALL LCMSIX(IPLIST,' ',2)
        CALL LCMSIX(IPLIST,GEONAM,1)
        CALL LCMEXP(IPLIST,0,IFILE,1,2)
        IRC=KDRCLS(IFILE,2)
        IF(IRC.LT.0) CALL XABORT('GEODIN: KDRCLS FAILURE.')
        CALL LCMGET(IPLIST,'STATE-VECTOR',ISTATE)
        LHEX=(ISTATE(1).EQ.8).OR.(ISTATE(1).EQ.9).OR.(ISTATE(1).EQ.24)
     1  .OR.(ISTATE(1).EQ.25)
        LTRI=(ISTATE(1).EQ.13).OR.(ISTATE(1).EQ.14)
        CALL LCMGET(IPLIST,'NCODE',NCODE)
        CALL LCMGET(IPLIST,'ZCODE',ZCODE)
        CALL LCMGET(IPLIST,'ICODE',ICODE)
      ENDIF
*
   50 CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
      IF(ITYPLU.NE.3) CALL XABORT('GEODIN: CHARACTER DATA EXPECTED(2).')
   60 IF(CARLIR.EQ.'EDIT') THEN
        CALL REDGET(ITYPLU,IMPX,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTED.')
      ELSE IF((CARLIR.EQ.'MIX').OR.(CARLIR.EQ.'CELL')) THEN
*       INPUT MIXTURE NUMBERS OR FORCE SUB GEOMETRIES AT SPECIFIC
*       LOCATIONS.
        ALLOCATE(CELL(LREG),MIX(LREG))
        CALL XDISET(MIX,LREG,0)
        LTOT=.TRUE.
        I=0
        IKG=0
   70   I=I+1
        CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU.EQ.3) THEN
          IF(CARLIR.EQ.'PLANE') THEN
            IF(I.EQ.1) THEN
              IF(ISTATE(1).EQ.7.OR.ISTATE(1).EQ.9) THEN
                IF(ISTATE(1).EQ.9) LY=1
                CALL GEODMI(LX,LY,LZ,LCOUR,MIX,MINMIX,ISTATE(7))
                LTOT=.FALSE.
                GO TO 70
              ELSE
                CALL XABORT('GEODIN: INVALID KEY WORD PLANE FOR NON '
     1          //' 3-D GEOMETRY')
              ENDIF
            ELSE
              CALL XABORT('GEODIN: WRONG USE OF KEYWORD PLANE.')
            ENDIF
          ENDIF
          IF((CARLIR(2:2).EQ.'-').OR.(CARLIR(2:2).EQ.'+').OR.
     1    (CARLIR.EQ.'HBC').OR.(CARLIR(1:4).EQ.'MESH').OR.
     2    (CARLIR(1:5).EQ.'SPLIT').OR.(CARLIR.EQ.'SIDE').OR.
     3    (CARLIR(:3).EQ.'MIX').OR.(CARLIR.EQ.'MERGE').OR.
     4    (CARLIR.EQ.'TURN').OR.(CARLIR.EQ.'CLUSTER').OR.
     5    (CARLIR(2:4).EQ.'PIN').OR.(CARLIR.EQ.'BIHET').OR.
     6    (CARLIR.EQ.'POURCE').OR.(CARLIR.EQ.'PROCEL').OR.
     7    (CARLIR.EQ.'SECT').OR.(CARLIR.EQ.'RADIUS').OR.
     8    (CARLIR.EQ.';').OR.(CARLIR.EQ.':::')) GO TO 90
           IF(I.GT.LREG) CALL XABORT('GEODIN: MIX/CELL INDEX OVERFLO'
     1     //'W.')
           DO 80 J=1,I-1
           JKG=-MIX(J)
           IF(CARLIR.EQ.CELL(JKG)) THEN
             MIX(I)=-JKG
             GO TO 70
           ENDIF
   80      CONTINUE
           IKG=IKG+1
           ISTATE(8)=1
           MIX(I)=-IKG
           CELL(IKG)=CARLIR
        ELSE IF(ITYPLU.EQ.1) THEN
           IF(I.GT.LREG) CALL XABORT('GEODIN: MIX INDEX OVERFLOW.')
           MIX(I)=INTLIR
           ISTATE(7)=MAX(ISTATE(7),MIX(I))
           MINMIX=MIN(MINMIX,MIX(I))
        ELSE
           CALL XABORT('GEODIN: INTEGER OR CHARACTER DATA EXPECTED.')
        ENDIF
        GO TO 70
   90   CONTINUE
        IF(CARLIR.EQ.'REPEAT') THEN
           NBR=LREG/(I-1)
           NBRR=NBR*(I-1)
           IF(NBRR.NE.LREG) THEN
             WRITE(IOUT,530) I-1,LREG
             CALL XABORT('GEODIN: IMPOSSIBLE TO REPEAT AN INTEGER NUMB'
     1       //'ER OF TIMES.')
           ENDIF
           JREP=I-1
           DO IREP=1,NBR-1
             DO II=1,I-1
               JREP=JREP+1
               MIX(JREP)=MIX(II)
             ENDDO
           ENDDO
           I=JREP+1
           CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
           IF(ITYPLU.NE.3) CALL XABORT('GEODIN: CHARACTER DATA EXPECTE'
     1     //'D.')
        ENDIF
        IF(LTOT) LREG=I-1
        IF(IKG.GT.0) CALL LCMPTC(IPLIST,'CELL',12,IKG,CELL)
        CALL LCMPUT(IPLIST,'MIX',LREG,1,MIX)
        DEALLOCATE(MIX,CELL)
        GO TO 60
      ELSE IF(CARLIR(1:4).EQ.'MESH') THEN
*       INPUT CARTESIAN COORDINATES.
        IF(CARLIR(5:5).EQ.'X') THEN
          IF(LX.EQ.0) CALL XABORT('GEODIN: MESHX - LX=0.')
          LMESH=LX+1
        ELSE IF(CARLIR(5:5).EQ.'Y') THEN
          IF(LY.EQ.0) CALL XABORT('GEODIN: MESHY - LY=0.')
          LMESH=LY+1
        ELSE IF(CARLIR(5:5).EQ.'Z') THEN
          IF(LZ.EQ.0) CALL XABORT('GEODIN: MESHZ - LZ=0.')
          LMESH=LZ+1
        ELSE
          CALL XABORT('GEODIN: INVALID MESH SUFFIX.')
        ENDIF
        ALLOCATE(RMESH(LMESH))
        DO 100 I=1,LMESH
        CALL REDGET(ITYPLU,INTLIR,RMESH(I),TEXT12,DBLLIR)
        IF(ITYPLU.NE.2) CALL XABORT('GEODIN: REAL DATA EXPECTED.')
        IF(I.GT.1) THEN
          IF(RMESH(I).LE.RMESH(I-1)) THEN
            CALL XABORT('GEODIN: NON INCREASING MESHES.')
          ENDIF
        ENDIF
  100   CONTINUE
        CALL LCMPUT(IPLIST,CARLIR,LMESH,2,RMESH)
        DEALLOCATE(RMESH)
      ELSE IF(CARLIR.EQ.'SIDE') THEN
*       INPUT THE SIDE LENGTH IN TRIANGULAR OR HEXAGONAL GEOMETRY.
        IF((.NOT.LHEX).AND.(.NOT.LTRI)) CALL XABORT('GEODIN: SIDE PRO'
     1  //'HIBITED.')
        CALL REDGET(ITYPLU,INTLIR,SIDE,CARLIR,DBLLIR)
        IF(ITYPLU.NE.2) CALL XABORT('GEODIN: REAL DATA EXPECTED.')
        CALL LCMPUT(IPLIST,'SIDE',1,2,SIDE)
      ELSE IF (CARLIR.EQ.'RADS') THEN
*       OPTIONS FOR CYLINDRICAL CORRECTION IN CARTESIAN GEOMETRY.
        IF((ISTATE(1).NE.5).AND.(ISTATE(1).NE.7)) CALL XABORT('GEO'
     1  //'IN1: OPTION RADS IS LIMITED TO CARTESIAN GEOMETRIES.')
        CALL REDGET(INDIC,NR0,REALIR,TEXT4,DBLLIR)
        SWANG=TEXT4.EQ.'ANG'
        IF(SWANG) CALL REDGET(INDIC,NR0,REALIR,TEXT4,DBLLIR)
        IF(INDIC.NE.1) CALL XABORT('GEO: INTEGER DATA EXPECTED.')
        IF(NR0.EQ.0) CALL XABORT('GEODIN: NON-ZERO INTEGER EXPECTED.')
        ALLOCATE(XR0(NR0),RR0(NR0),ANG(NR0))
        DO 135 I=1,NR0
        CALL REDGET(INDIC,INTLIR,XR0(I),TEXT4,DBLLIR)
        IF(INDIC.NE.2) CALL XABORT('GEODIN: REAL DATA EXPECTED.')
        CALL REDGET(INDIC,INTLIR,RR0(I),TEXT4,DBLLIR)
        IF(INDIC.NE.2) CALL XABORT('GEODIN: REAL DATA EXPECTED.')
        IF(SWANG) THEN
          CALL REDGET(INDIC,INTLIR,ANG(I),TEXT4,DBLLIR)
          IF(INDIC.NE.2) CALL XABORT('GEODIN: REAL DATA EXPECTED.')
        ELSE
*         USE PI/2 + 0.1
          ANG(I)=1.670796327
        ENDIF
  135   CONTINUE
        CALL LCMPUT(IPLIST,'XR0',NR0,2,XR0)
        CALL LCMPUT(IPLIST,'RR0',NR0,2,RR0)
        CALL LCMPUT(IPLIST,'ANG',NR0,2,ANG)
        DEALLOCATE(ANG,RR0,XR0)
      ELSE IF(CARLIR(1:5).EQ.'SPLIT') THEN
*       INPUT MESH SPLITTING FACTORS.
        ISTATE(11)=1
        IF(CARLIR(6:6).EQ.'X') THEN
          IF(LX.EQ.0) CALL XABORT('GEODIN: SPLITX - LX=0.')
          LMESH=LX
        ELSE IF(CARLIR(6:6).EQ.'Y') THEN
          IF(LY.EQ.0) CALL XABORT('GEODIN: SPLITY - LY=0.')
          LMESH=LY
        ELSE IF(CARLIR(6:6).EQ.'Z') THEN
          IF(LZ.EQ.0) CALL XABORT('GEODIN: SPLITZ - LZ=0.')
          LMESH=LZ
        ELSE IF(CARLIR(6:6).EQ.'R') THEN
          IF(LR.EQ.0) CALL XABORT('GEODIN: SPLITR - LR=0.')
          LMESH=LR
        ELSE
          CALL XABORT('GEODIN: INVALID SPLIT SUFFIX.')
        ENDIF
        ALLOCATE(MESH(LMESH))
        DO 140 I=1,LMESH
        CALL REDGET(ITYPLU,MESH(I),REALIR,TEXT12,DBLLIR)
        IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTED.')
        IF(((MESH(I).LE.0).AND.(CARLIR.NE.'SPLITR')).OR.(MESH(I).EQ.0))
     1  CALL XABORT('GEODIN: INVALID MESH-SPLITTING INDEX.')
  140   CONTINUE
        CALL LCMPUT(IPLIST,CARLIR,LMESH,1,MESH)
        DEALLOCATE(MESH)
      ELSE IF(CARLIR.EQ.'MERGE') THEN
*       INPUT CELL-MERGING INDICES.
        ISTATE(10)=1
        ALLOCATE(MERGE(LREG))
        I=0
  150   I=I+1
        CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU.EQ.3) GO TO 160
        IF(ITYPLU.NE.1) CALL XABORT('GEODIN: INTEGER DATA EXPECTED.')
        IF(I.GT.LREG) CALL XABORT('GEODIN: MERGE INDEX OVERFLOW.')
        MERGE(I)=INTLIR
        GO TO 150
  160   LREG=I-1
        CALL LCMPUT(IPLIST,'MERGE',LREG,1,MERGE)
        DEALLOCATE(MERGE)
        GO TO 60
      ELSE IF(CARLIR.EQ.'TURN') THEN
*       INPUT ORIENTATION INFORMATION.
        ALLOCATE(TURN(LREG))
        I=0
  170   I=I+1
        CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU.NE.3) CALL XABORT('GEODIN: CHARACTER DATA EXPECTED.')
        DO 180 J=1,MAXTUR
        IF(CARLIR.EQ.CTUR(J)) THEN
          IF(I.GT.LREG) CALL XABORT('GEODIN: TURN INDEX OVERFLOW(1).')
          TURN(I)=J
          GO TO 170
        ELSE IF(CARLIR.EQ.'-'//CTUR(J)) THEN
          IF(I.GT.LREG) CALL XABORT('GEODIN: TURN INDEX OVERFLOW(2).')
          TURN(I)=MAXTUR+J
          GO TO 170
        ENDIF
  180   CONTINUE
        LREG=I-1
        CALL LCMPUT(IPLIST,'TURN',LREG,1,TURN)
        DEALLOCATE(TURN)
        GO TO 60
      ELSE IF((CARLIR(2:2).EQ.'+').OR.(CARLIR(2:2).EQ.'-').OR.
     1  (CARLIR.EQ.'HBC')) THEN
*       INPUT BOUNDARY CONDITIONS.
        ISURF=-99
        IF(CARLIR.EQ.'X-') THEN
          ISURF=1
          IF(LX.EQ.0) CALL XABORT('GEODIN: HBC X- -> LX=0.')
        ELSE IF(CARLIR.EQ.'X+') THEN
          ISURF=2
          IF(LX.EQ.0) CALL XABORT('GEODIN: HBC X+ -> LX=0.')
        ELSE IF(CARLIR.EQ.'R+') THEN
          ISURF=2
          IF(LR.EQ.0) CALL XABORT('GEODIN: HBC R+ -> LR=0.')
        ELSE IF(CARLIR.EQ.'Y-') THEN
          ISURF=3
          IF(LY.EQ.0) CALL XABORT('GEODIN: HBC Y- -> LY=0.')
        ELSE IF(CARLIR.EQ.'Y+') THEN
          ISURF=4
          IF(LY.EQ.0) CALL XABORT('GEODIN: HBC Y+ -> LY=0.')
        ELSE IF(CARLIR.EQ.'Z-') THEN
          ISURF=5
          IF(LZ.EQ.0) CALL XABORT('GEODIN: HBC Z- -> LZ=0.')
        ELSE IF(CARLIR.EQ.'Z+') THEN
          ISURF=6
          IF(LZ.EQ.0) CALL XABORT('GEODIN: HBC Z+ -> LZ=0.')
        ELSE IF(CARLIR.EQ.'HBC') THEN
          ISURF=1
          IF(.NOT.LHEX) CALL XABORT('GEODIN: HBC PROHIBITED.')
          CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
          IF(ITYPLU.NE.3) CALL XABORT('GEODIN: CHARACTER DATA EXPECTE'
     1    //'D.')
          DO 330 I=1,MAXHEX
          IF(CARLIR.EQ.CHEX(I)) THEN
            IHEX=I
            GO TO 340
          ENDIF
  330     CONTINUE
          CALL XABORT('GEODIN: INVALID TYPE OF HEXAGONAL SYMMETRY.')
  340     CALL LCMPUT(IPLIST,'IHEX',1,1,IHEX)
          LCOUR=IHEX.EQ.9
        ELSE IF(CARLIR.EQ.'TBC') THEN
          ISURF=1
          IF(.NOT.LTRI) CALL XABORT('GEODIN: TBC PROHIBITED.')
          CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
          IF(ITYPLU.NE.3) CALL XABORT('GEODIN: CHARACTER DATA EXPECTE'
     1    //'D.')
          DO 350 I=1,MAXTEX
          IF(CARLIR.EQ.CHET(I)) THEN
            ITRI=I
            GO TO 360
          ENDIF
  350     CONTINUE
          CALL XABORT('GEODIN: INVALID TYPE OF TRIANGULAR SYMMETRY.')
  360     CALL LCMPUT(IPLIST,'ITRI',1,1,ITRI)
        ELSE
          CALL XABORT('GEODIN: INVALID KEY WORD '//CARLIR//'.')
        ENDIF
        CALL REDGET(ITYPLU,INTLIR,REALIR,TEXT4,DBLLIR)
        IF(ITYPLU.NE.3) CALL XABORT('GEODIN: CHARACTER DATA EXPECTED.')
        DO 370 I=1,MAXCOD
        IF(TEXT4.EQ.COND(I)) THEN
          NCODE(ISURF)=I
          IF(TEXT4.EQ.'ACYL') NCODE(ISURF)=I-1
          GO TO 380
        ENDIF
  370   CONTINUE
        CALL XABORT('GEODIN: INVALID TYPE OF BOUNDARY CONDITION.')
  380   IF(TEXT4.EQ.'ALBE') THEN
          CALL REDGET(ITYPLU,INTLIR,REALIR,TEXT4,DBLLIR)
          IF(ITYPLU.EQ.1) THEN
            ICODE(ISURF)=INTLIR
            MINICO=MIN(MINICO,INTLIR)
          ELSE IF(ITYPLU.EQ.2) THEN
            ZCODE(ISURF)=REALIR
          ELSE
            CALL XABORT('GEODIN: INTEGER OR REAL DATA EXPECTED.')
          ENDIF
        ELSE IF(TEXT4.EQ.'ACYL') THEN
          CALL REDGET(ITYPLU,INTLIR,REALIR,TEXT4,DBLLIR)
          IF(ITYPLU.EQ.1) THEN
            ICODE(ISURF)=INTLIR
            MINICO=MIN(MINICO,INTLIR)
          ELSE IF(ITYPLU.EQ.2) THEN
            ZCODE(ISURF)=REALIR
          ELSE
            CALL XABORT('GEODIN: INTEGER OR REAL DATA EXPECTED '
     1      //'AFTER ACYL.')
          ENDIF
        ELSE IF(TEXT4.EQ.'REFL') THEN
          ZCODE(ISURF)=1.0
        ELSE IF(TEXT4.EQ.'VOID') THEN
          ZCODE(ISURF)=0.0
        ENDIF
      ELSE IF(CARLIR.EQ.';') THEN
*       END-OF-GEOMETRY.
        GO TO 410
      ELSE IF(CARLIR.EQ.':::') THEN
*       INPUT A SUB GEOMETRY.
        CALL XABORT('GEODIN: SUB-GEOMETRY NOT ALLOWED.')
      ELSE IF(CARLIR.EQ.'MIX-NAMES') THEN
*       DEFINE MIXTURE CHARACTER NAMES.
        IF(LEVEL.NE.1) CALL XABORT('GEODIN: MIX-NAMES DATA SHOULD BE '
     1  //'WRITTEN ON FIRST DIRECTORY LEVEL.')
        ALLOCATE(CELL(LREG))
        I=0
  390   I=I+1
        CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU.NE.3) CALL XABORT('GEODIN: CHARACTER DATA EXPECTED.')
        IF((CARLIR(2:2).EQ.'-').OR.(CARLIR(2:2).EQ.'+').OR.
     1  (CARLIR.EQ.'HBC').OR.(CARLIR(1:4).EQ.'MESH').OR.(CARLIR(1:5)
     2  .EQ.'SPLIT').OR.(CARLIR.EQ.'SIDE').OR.(CARLIR(:3).EQ.'MIX').OR.
     3  (CARLIR.EQ.'CELL').OR.(CARLIR.EQ.'MERGE').OR.(CARLIR.EQ.'TURN')
     4  .OR.(CARLIR(2:4).EQ.'PIN').OR.(CARLIR.EQ.'BIHET').OR.
     5  (CARLIR.EQ.'POURCE').OR.(CARLIR.EQ.'PROCEL').OR.
     6  (CARLIR.EQ.'SECT').OR.(CARLIR.EQ.'RADIUS').OR.(CARLIR.EQ.';')
     7  .OR. (CARLIR.EQ.':::')) GO TO 400
        IF(I.GT.LREG) CALL XABORT('GEODIN: MIX-NAMES INDEX OVERFLOW.')
        CELL(I)=CARLIR
        GO TO 390
  400   CALL LCMPTC(IPLIST,'MIX-NAMES',12,I-1,CELL)
        ISTATE(13)=I-1
        DEALLOCATE(CELL)
        GO TO 60
      ELSE
        CALL XABORT('GEODIN: '//CARLIR//' IS AN INVALID KEY WORD.')
      ENDIF
      GO TO 50
*
  410 CARLIR='L_GEOM'
      CALL LCMPTC(IPLIST,'SIGNATURE',12,1,CARLIR)
      CALL LCMPUT(IPLIST,'STATE-VECTOR',NSTATE,1,ISTATE)
      CALL LCMPUT(IPLIST,'NCODE',6,1,NCODE)
      CALL LCMPUT(IPLIST,'ZCODE',6,2,ZCODE)
      CALL LCMPUT(IPLIST,'ICODE',6,1,ICODE)
      IF(MINMIX.LT.0)
     >  CALL XABORT('GEODIN: NEGATIVE MIXTURE NUMBERS INVALID')
      IF(MINICO.LT.1)
     >  CALL XABORT('GEODIN: ALBEDO NUMBER MUST BE GREATER THAN 0')
      MAXMIX=ISTATE(7)
      IF(IMPX.GT.0) THEN
        CALL LCMINF(IPLIST,CARLIR,TEXT12,EMPTY,ILONG,LCM)
        WRITE (IOUT,510) LEVEL,GEONAM,CARLIR,TYPE(ISTATE(1))
      ENDIF
      IF(IMPX.GT.1) THEN
        WRITE (IOUT,520) ISTATE(1),TYPE(ISTATE(1)),(ISTATE(I),I=2,14)
      ENDIF
      IF((ISTATE(8).EQ.1).AND.(ISTATE(9).EQ.0)) CALL XABORT('GEODIN: '
     1 //'CELL OPTION ACTIVATED WITHOUT SUB-GEOMETRIES.')
      RETURN
*
  510 FORMAT(/20H CREATION OF A LEVEL,I3,27H GEOMETRY ON THE DIRECTORY ,
     1 7HNAMED ',A12,21H' OF THE LCM OBJECT ',A12,12H' WITH TYPE ,A16,
     2 1H.)
  520 FORMAT(/14H STATE VECTOR:/
     1 7H ITYPE ,I6, 4H   (,A16,1H)/
     2 7H LR    ,I6,20H   (NUMBER OF TUBES)/
     3 7H LX    ,I6,22H   (X-DIMENSION INDEX)/
     4 7H LY    ,I6,22H   (Y-DIMENSION INDEX)/
     5 7H LZ    ,I6,22H   (Z-DIMENSION INDEX)/
     6 7H LREG  ,I6,22H   (NUMBER OF REGIONS)/
     7 7H MAXMIX,I6,48H   (MAX. NB. OF MIXTURES/0=TRANSPARENT GEOMETRY)/
     8 7H ISUB1 ,I6,34H   (1=COMMAND CELL IS USED/0=ELSE)/
     9 7H ISUB2 ,I6,29H   (NUMBER OF SUB GEOMETRIES)/
     1 7H IMERGE,I6,26H   (1=CELL-MERGING/0=ELSE)/
     2 7H ISPLIT,I6,28H   (1=MESH-SPLITTING/0=ELSE)/
     3 7H IBIHET,I6,34H   (1=DOUBLE HETEROGENEITY/0=ELSE)/
     4 7H ICLUST,I6,28H   (NUMBER OF CLUSTER RINGS)/
     5 7H ISECT ,I6,26H   (TYPE OF SECTORIZATION))
  530 FORMAT(' ***** Error in GEODIN *****'/
     1       ' Initial number of mixtures ',I10/
     2       ' Cannot be repeated an integer number of times',
     3       ' to fill ',I10,' mixtures')
      END
