*DECK COMPO
      SUBROUTINE COMPO(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
*
*-----------------------------------------------------------------------
*
*Purpose:
* creation and construction of a Multicompo database object.
*
*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, R. Chambon
*
*Parameters: input/output
* NENTRY  number of LCM objects or files used by the operator.
* HENTRY  name of each LCM object or file:
*         HENTRY(1): multicompo database object;
*         HENTRY(I): I>1 read-only type(L_BURNUP, L_LIBRARY, L_EDIT
*         or L_FLUX).
* 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,MAXPAR=50,MAXLIN=50,IOUT=6)
      TYPE(C_PTR) ICPOLD,IPLB1,IPLB2,IPDEPL,IPEDIT,IPRHS,IPCPO
      CHARACTER TEXT4*4,TEXT8*8,TEXT12*12,TEXT80*80,HPDEPL*12,NAMDIR*12,
     1 HSIGN*12,PARKEY(MAXPAR)*12,PARCHR(MAXPAR)*8,PARTYP(MAXPAR)*4,
     2 PARFMT(MAXPAR)*8,PARBIB(MAXPAR)*12,PARKEL(MAXPAR)*12,
     3 PARCHL(MAXPAR)*8,PARTYL(MAXPAR)*4,HSMG*131,COMMEN(MAXLIN)*80
      DOUBLE PRECISION DFLOTT
      LOGICAL LINIT,LGNEW(MAXPAR),LMACRO,LWARN,LISO
      INTEGER ISTATE(NSTATE),MUPLET(MAXPAR),PARMIL(MAXPAR),IST1(NSTATE),
     1 IST2(NSTATE),PARCAD(MAXPAR+1),PARPAD(MAXPAR+1),PARCAL(MAXPAR+1)
*----
*  ALLOCATABLE ARRAYS
*----
      REAL, ALLOCATABLE, DIMENSION(:) :: TIMES
*----
*  PARAMETER VALIDATION
*----
      LINIT=.FALSE.
      IF(NENTRY.EQ.0) CALL XABORT('COMPO: PARAMETERS EXPECTED.')
      IF((IENTRY(1).LE.2).AND.(JENTRY(1).EQ.0)) THEN
         ICPOLD=KENTRY(1)
         LINIT=.TRUE.
         HSIGN='L_MULTICOMPO'
         CALL LCMPTC(ICPOLD,'SIGNATURE',12,1,HSIGN)
      ELSE IF(IENTRY(1).LE.2) THEN
         ICPOLD=KENTRY(1)
         LINIT=(NENTRY.EQ.1)
         CALL LCMGTC(ICPOLD,'SIGNATURE',12,1,HSIGN)
         IF(HSIGN.NE.'L_MULTICOMPO') THEN
            TEXT12=HENTRY(1)
            CALL XABORT('COMPO: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
     1      '. L_MULTICOMPO EXPECTED.')
         ENDIF
      ELSE
         CALL XABORT('COMPO: COMPO LCM OBJECT EXPECTED.')
      ENDIF
      IPLB1=C_NULL_PTR
      IPLB2=C_NULL_PTR
      IPDEPL=C_NULL_PTR
      IPEDIT=C_NULL_PTR
      IPRHS=C_NULL_PTR
      HPDEPL=' '
      DO 10 I=2,NENTRY
      IF(IENTRY(I).LE.2) THEN
         IF(JENTRY(I).NE.2) CALL XABORT('COMPO: READ-ONLY RHS EXPECTE'
     1   //'D.')
         CALL LCMGTC(KENTRY(I),'SIGNATURE',12,1,HSIGN)
         IF(HSIGN.EQ.'L_LIBRARY') THEN
            IF(.NOT.C_ASSOCIATED(IPLB1)) IPLB1=KENTRY(I)
            IF(.NOT.C_ASSOCIATED(IPLB2)) IPLB2=KENTRY(I)
         ELSE IF(HSIGN.EQ.'L_BURNUP') THEN
            IPDEPL=KENTRY(I)
            HPDEPL=HENTRY(I)
         ELSE IF(HSIGN.EQ.'L_EDIT') THEN
            IPEDIT=KENTRY(I)
         ELSE IF(HSIGN.EQ.'L_MULTICOMPO') THEN
            IPRHS=KENTRY(I)
         ENDIF
      ELSE
         CALL XABORT('COMPO: LCM OBJECT EXPECTED AT RHS.')
      ENDIF
   10 CONTINUE
*----
*  READ THE INPUT DATA
*----
*     DEFAULT OPTIONS:
      IMPX=1
      NAMDIR='default'
      IPCPO=C_NULL_PTR
      LWARN=.FALSE.
      LISO=.FALSE.
      IF(LINIT) THEN
         MAXCAL=10
         NCOMLI=0
         NPAR=0
         NPCHR=0
         NPPNT=0
         NLOC=0
         NPCHRL=0
         NISO=0
         NMIL=0
         PARCAD(1)=1
         PARPAD(1)=1
         PARCAL(1)=1
      ELSE
         GO TO 100
      ENDIF
   20 CALL REDGET(INDIC,NITMA,FLOTT,TEXT8,DFLOTT)
      IF(INDIC.NE.3) CALL XABORT('COMPO: CHARACTER DATA EXPECTED(1).')
      IF(TEXT8.EQ.'EDIT') THEN
*        READ THE PRINT INDEX.
         CALL REDGET(INDIC,IMPX,FLOTT,TEXT4,DFLOTT)
         IF(INDIC.NE.1) CALL XABORT('COMPO: INTEGER DATA EXPECTED(1).')
      ELSE IF(TEXT8.EQ.'STEP') THEN
*        CHANGE THE HIERARCHICAL LEVEL ON THE COMPO.
         IF(LINIT) THEN
            MAXCAL=10
            NCOMLI=0
            NPAR=0
            NPCHR=0
            NPPNT=0
            NLOC=0
            NPCHRL=0
            NISO=0
            NMIL=0
            PARCAD(1)=1
            PARPAD(1)=1
            PARCAL(1)=1
         ENDIF
         CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
         IF((INDIC.NE.3).OR.(TEXT4.NE.'UP')) CALL XABORT('COMPO: *UP* '
     1   //'EXPECTED.')
         CALL REDGET(INDIC,NITMA,FLOTT,NAMDIR,DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('COMPO: DIR-NAME EXPECTED.')
         IF(IMPX.GT.0) WRITE(IOUT,'(/30H COMPO: CREATE A DIRECTORY NAM,
     1   4HED '',A12,31H'' TO STORE THE COMPO STRUCTURE.)') NAMDIR
      ELSE IF(TEXT8.EQ.'MAXCAL') THEN
         CALL REDGET(INDIC,MAXCAL,FLOTT,TEXT4,DFLOTT)
         IF(INDIC.NE.1) CALL XABORT('COMPO: INTEGER DATA EXPECTED(2).')
      ELSE IF(TEXT8.EQ.'COMM') THEN
   40    CALL REDGET(INDIC,NITMA,FLOTT,TEXT80(:72),DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('COMPO: COMMENTS EXPECTED.')
         IF(TEXT80(:4).EQ.'ENDC') THEN
            IPCPO=LCMDID(ICPOLD,NAMDIR)
            CALL LCMPTC(IPCPO,'COMMENT',80,NCOMLI,COMMEN)
            IPCPO=C_NULL_PTR
            GO TO 20
         ENDIF
         NCOMLI=NCOMLI+1
         IF(NCOMLI.GT.MAXLIN) CALL XABORT('COMPO: TITLE OVERFLOW.')
         COMMEN(NCOMLI)=TEXT80(:72)
         GO TO 40
      ELSE IF(TEXT8.EQ.'PARA') THEN
         NPAR=NPAR+1
         IF(NPAR.GT.MAXPAR) CALL XABORT('COMPO: TOO MANY GLOBAL PARAME'
     1   //'TERS(1).')
         CALL REDGET(INDIC,NITMA,FLOTT,PARKEY(NPAR),DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('COMPO: CHARACTER DATA EXPECTED'
     1   //'(2).')
         DO 50 I=1,NPAR-1
         IF(PARKEY(NPAR).EQ.PARKEY(I)) CALL XABORT('COMPO: PARKEY '//
     1   PARKEY(NPAR)//' ALREADY DEFINED(1).')
   50    CONTINUE
         DO 60 I=1,NLOC
         IF(PARKEY(NPAR).EQ.PARKEL(I)) CALL XABORT('COMPO: PARKEY '//
     1   PARKEY(NPAR)//' ALREADY DEFINED(2).')
   60    CONTINUE
         CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('COMPO: CHARACTER DATA EXPECTED'
     1   //'(3).')
         IF(TEXT4.EQ.'TEMP') THEN
            NPPNT=NPPNT+1
            CALL REDGET(INDIC,NITMA,FLOTT,PARBIB(NPPNT),DFLOTT)
            IF(INDIC.NE.3) CALL XABORT('COMPO: CHARACTER DATA EXPECTED'
     1      //'(4).')
            CALL REDGET(INDIC,PARMIL(NPPNT),FLOTT,TEXT4,DFLOTT)
            IF(INDIC.NE.1) CALL XABORT('COMPO: INTEGER DATA EXPECTE'//
     1      'D(3).')
            PARFMT(NPAR)='REAL'
         ELSE IF(TEXT4.EQ.'CONC') THEN
            NPCHR=NPCHR+1
            CALL REDGET(INDIC,NITMA,FLOTT,PARCHR(NPCHR),DFLOTT)
            IF(INDIC.NE.3) CALL XABORT('COMPO: CHARACTER DATA EXPECTED'
     1      //'(5).')
            NPPNT=NPPNT+1
            CALL REDGET(INDIC,NITMA,FLOTT,PARBIB(NPPNT),DFLOTT)
            IF(INDIC.NE.3) CALL XABORT('COMPO: CHARACTER DATA EXPECTED'
     1      //'(6).')
            CALL REDGET(INDIC,PARMIL(NPPNT),FLOTT,TEXT4,DFLOTT)
            IF(INDIC.NE.1) CALL XABORT('COMPO: INTEGER DATA EXPECTE'//
     1      'D(4).')
            PARFMT(NPAR)='REAL'
         ELSE IF(TEXT4.EQ.'IRRA') THEN
            PARFMT(NPAR)='REAL'
         ELSE IF(TEXT4.EQ.'FLUE') THEN
            PARFMT(NPAR)='REAL'
         ELSE IF(TEXT4.EQ.'FLUB') THEN
            PARFMT(NPAR)='REAL'
         ELSE IF(TEXT4.EQ.'POWR') THEN
            PARFMT(NPAR)='REAL'
         ELSE IF(TEXT4.EQ.'TIME') THEN
            PARFMT(NPAR)='REAL'
         ELSE IF(TEXT4.EQ.'VALU') THEN
            CALL REDGET(INDIC,NITMA,FLOTT,TEXT8,DFLOTT)
            IF(INDIC.NE.3) CALL XABORT('COMPO: CHARACTER DATA EXPECTED'
     1      //'(7).')
            IF(TEXT8.EQ.'REAL')THEN
               PARFMT(NPAR)='REAL'
            ELSEIF(TEXT8.EQ.'CHAR')THEN
               PARFMT(NPAR)='STRING'
            ELSEIF(TEXT8.EQ.'INTE')THEN
               PARFMT(NPAR)='INTEGER'
            ELSE
               CALL XABORT('COMPO: INVALID KEYWORD='//TEXT8//' (1).')
            ENDIF
         ELSE
            CALL XABORT('COMPO: INVALID KEYWORD='//TEXT4//' (2).')
         ENDIF
         PARTYP(NPAR)=TEXT4
         PARCAD(NPAR+1)=NPCHR+1
         PARPAD(NPAR+1)=NPPNT+1
      ELSE IF(TEXT8.EQ.'LOCA') THEN
         NLOC=NLOC+1
         IF(NLOC.GT.MAXPAR) CALL XABORT('COMPO: TOO MANY LOCAL PARAM'//
     1   'ETERS(1).')
         CALL REDGET(INDIC,NITMA,FLOTT,PARKEL(NLOC),DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('COMPO: CHARACTER DATA EXPECTED'
     1   //'(8).')
         DO 70 I=1,NLOC-1
         IF(PARKEL(NLOC).EQ.PARKEL(I)) CALL XABORT('COMPO: PARKEY '//
     1   PARKEL(NLOC)//' ALREADY DEFINED(3).')
   70    CONTINUE
         DO 80 I=1,NPAR
         IF(PARKEL(NLOC).EQ.PARKEY(I)) CALL XABORT('COMPO: PARKEY '//
     1   PARKEL(NLOC)//' ALREADY DEFINED(4).')
   80    CONTINUE
         CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('COMPO: CHARACTER DATA EXPECTED'
     1   //'(9).')
         IF(TEXT4.EQ.'CONC') THEN
            NPCHRL=NPCHRL+1
            CALL REDGET(INDIC,NITMA,FLOTT,PARCHL(NPCHRL),DFLOTT)
            IF(INDIC.NE.3) CALL XABORT('COMPO: CHARACTER DATA EXPECTED'
     1      //'(10).')
         ELSE IF((TEXT4.NE.'IRRA').AND.(TEXT4.NE.'FLUG').AND.
     1           (TEXT4.NE.'FLUB').AND.(TEXT4.NE.'POWR').AND.
     2           (TEXT4.NE.'MASL').AND.(TEXT4.NE.'FLUX').AND.
     3           (TEXT4.NE.'TEMP')) THEN
            CALL XABORT('COMPO: INVALID KEYWORD='//TEXT4//' (3).')
         ENDIF
         PARTYL(NLOC)=TEXT4
         PARCAL(NLOC+1)=NPCHRL+1
      ELSE IF(TEXT8.EQ.'INIT') THEN
         IPCPO=LCMDID(ICPOLD,NAMDIR)
         CALL LCMSIX(IPCPO,'GLOBAL',1)
         IF(NPAR.GT.0) THEN
            CALL LCMPTC(IPCPO,'PARKEY',12,NPAR,PARKEY)
            CALL LCMPTC(IPCPO,'PARTYP',4,NPAR,PARTYP)
            CALL LCMPTC(IPCPO,'PARFMT',8,NPAR,PARFMT)
         ENDIF
         IF(NPCHR.GT.0) CALL LCMPTC(IPCPO,'PARCHR',8,NPCHR,PARCHR)
         CALL LCMPUT(IPCPO,'PARCAD',NPAR+1,1,PARCAD)
         CALL LCMPUT(IPCPO,'PARPAD',NPAR+1,1,PARPAD)
         IF(NPPNT.GT.0) CALL LCMPUT(IPCPO,'PARMIL',NPPNT,1,PARMIL)
         IF(NPPNT.GT.0) CALL LCMPTC(IPCPO,'PARBIB',12,NPPNT,PARBIB)
         CALL LCMSIX(IPCPO,' ',2)
*
         IF(NLOC.GT.0) THEN
            CALL LCMSIX(IPCPO,'LOCAL',1)
            CALL LCMPTC(IPCPO,'PARKEY',12,NLOC,PARKEL)
            CALL LCMPTC(IPCPO,'PARTYP',4,NLOC,PARTYL)
            IF(NPCHRL.GT.0) CALL LCMPTC(IPCPO,'PARCHR',8,NPCHRL,PARCHL)
            CALL LCMPUT(IPCPO,'PARCAD',NLOC+1,1,PARCAL)
            CALL LCMSIX(IPCPO,' ',2)
         ENDIF
*
         CALL XDISET(ISTATE,NSTATE,0)
         ISTATE(1)=NMIL
         ISTATE(4)=MAXCAL
         ISTATE(5)=NPAR
         ISTATE(6)=NLOC
         ISTATE(7)=NPCHR
         ISTATE(8)=NPPNT
         ISTATE(9)=NPCHRL
         ISTATE(10)=NCOMLI
         ISTATE(12)=2006
         CALL LCMPUT(IPCPO,'STATE-VECTOR',NSTATE,1,ISTATE)
         IF(IMPX.GT.0) WRITE(IOUT,400) NAMDIR,IMPX,(ISTATE(I),I=1,12)
         IF(IMPX.GT.4) CALL LCMLIB(IPCPO)
      ELSE IF(TEXT8.EQ.'DB-STRUC') THEN
         GO TO 300
      ELSE IF(TEXT8.EQ.';') THEN
         IF(.NOT.C_ASSOCIATED(IPCPO)) CALL XABORT('COMPO: INIT NOT SET')
         RETURN
      ELSE
         CALL XABORT('COMPO: INVALID KEYWORD='//TEXT8//' (4).')
      ENDIF
      GO TO 20
*  END OF COMPO INITIALIZATION. **********************************
*
  100 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
      IF((INDIC.EQ.10).AND.(C_ASSOCIATED(IPRHS))) GO TO 230
      IF(INDIC.EQ.10) GO TO 160
      IF(INDIC.NE.3) CALL XABORT('COMPO: CHARACTER DATA EXPECTED(11).')
      IF(TEXT12.EQ.'EDIT') THEN
*        READ THE PRINT INDEX.
         CALL REDGET(INDIC,IMPX,FLOTT,TEXT4,DFLOTT)
         IF(INDIC.NE.1) CALL XABORT('COMPO: INTEGER DATA EXPECTED(5).')
      ELSE IF (TEXT12.EQ.'ALLX') THEN
         LISO=.TRUE.
      ELSE IF(TEXT12.EQ.'STEP') THEN
*        CHANGE THE HIERARCHICAL LEVEL ON THE COMPO.
         CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
         IF((INDIC.NE.3).OR.(TEXT4.NE.'UP')) CALL XABORT('COMPO: *UP* '
     1   //'EXPECTED.')
         CALL REDGET(INDIC,NITMA,FLOTT,NAMDIR,DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('COMPO: DIR-NAME EXPECTED.')
         IF(NAMDIR.EQ.'*') THEN
            IF(.NOT.C_ASSOCIATED(IPEDIT)) CALL XABORT('COMPO: * NOT AL'
     1      //'LOWED.')
            CALL LCMGTC(IPEDIT,'LAST-EDIT',12,1,NAMDIR)
         ENDIF
         CALL LCMLEN(ICPOLD,NAMDIR,ILENG,ITYLCM)
         IF((ILENG.EQ.0).OR.(ITYLCM.NE.0)) THEN
            CALL LCMLIB(ICPOLD)
            CALL XABORT('COMPO: NO '//NAMDIR//' DIRECTORY TO STEP.')
         ENDIF
         IF(IMPX.GT.0) WRITE(IOUT,'(/30H COMPO: ACCESS A DIRECTORY NAM,
     1   4HED '',A12,31H'' TO STORE THE COMPO STRUCTURE.)') NAMDIR
      ELSE IF(TEXT12.EQ.'ORIG') THEN
         CALL REDGET(INDIC,NORIG,FLOTT,TEXT4,DFLOTT)
         IF(INDIC.NE.1) CALL XABORT('COMPO: INTEGER DATA EXPECTED(6).')
      ELSE
         GO TO 105
      ENDIF
      GO TO 100
*
  105 ITIM=0
      IPCPO=LCMGID(ICPOLD,NAMDIR)
      CALL LCMGET(IPCPO,'STATE-VECTOR',ISTATE)
      NCALS=ISTATE(3)
      NPAR=ISTATE(5)
      IF(NPAR.GT.MAXPAR) CALL XABORT('COMPO: TOO MANY GLOBAL PARAMETER'
     1 //'S(2).')
      NLOC=ISTATE(6)
      IF(NLOC.GT.MAXPAR) CALL XABORT('COMPO: TOO MANY LOCAL PARAMETERS'
     1 //'(2).')
      NORIG=ISTATE(3)
      IF(NPAR.GT.0) THEN
         CALL LCMSIX(IPCPO,'GLOBAL',1)
         CALL LCMGTC(IPCPO,'PARKEY',12,NPAR,PARKEY)
         CALL LCMGTC(IPCPO,'PARTYP',4,NPAR,PARTYP)
         CALL LCMGTC(IPCPO,'PARFMT',8,NPAR,PARFMT)
         CALL LCMSIX(IPCPO,' ',2)
      ENDIF
      DO 110 I=1,NPAR
      MUPLET(I)=0
  110 LGNEW(I)=.FALSE.
      IF(C_ASSOCIATED(IPRHS)) THEN
         GO TO 200
      ELSE IF(.NOT.C_ASSOCIATED(IPEDIT)) THEN
         CALL XABORT('COMPO: NO COMPO OR EDITION OBJECTS AT RHS.')
      ENDIF
*----
*  INPUT AN ELEMENTARY CALCULATION FROM AN EDITION OBJECT ********
*----
      LMACRO=.FALSE.
      NCALS=NCALS+1
      IF(IMPX.GT.0) WRITE(IOUT,420) NCALS,NAMDIR
*
  120 IF(TEXT12.EQ.'SET') THEN
         CALL REDGET(INDIC,NITMA,XT,TEXT4,DFLOTT)
         IF(INDIC.NE.2) CALL XABORT('COMPO: REAL DATA EXPECTED(1).')
         CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('COMPO: CHARACTER DATA EXPECTED'
     1   //'(12).')
         IF(TEXT4.EQ.'S') THEN
           XT=XT*1.0E-8
         ELSE IF(TEXT4.EQ.'DAY') THEN
           XT=XT*8.64E-4
         ELSE IF(TEXT4.EQ.'YEAR') THEN
           XT=XT*3.1536E-1
         ELSE
           CALL XABORT('COMPO: S, DAY OR YEAR EXPECTED.')
         ENDIF
         IF(.NOT.C_ASSOCIATED(IPDEPL)) CALL XABORT('COMPO: DEPLETION O'
     1   //'BJECT EXPECTED AT RHS.')
         CALL LCMLEN(IPDEPL,'DEPL-TIMES',NTIM,ITYLCM)
         IF(NTIM.EQ.0) CALL XABORT('COMPO: NO DEPLETION TIME STEPS.')
         ALLOCATE(TIMES(NTIM))
         CALL LCMGET(IPDEPL,'DEPL-TIMES',TIMES)
         DO 130 I=1,NTIM
         IF(ABS(TIMES(I)-XT).LE.1.0E-4*XT) ITIM=I
  130    CONTINUE
         IF(ITIM.EQ.0) THEN
            WRITE(HSMG,'(41HCOMPO: UNABLE TO FIND A DEPLETION DIRECTO,
     1      12HRY AT TIME =,1P,E12.4,5H DAY.)') XT/8.64E-4
            CALL XABORT(HSMG)
         ENDIF
         DEALLOCATE(TIMES)
         IF(IMPX.GT.0) THEN
            WRITE(TEXT12,'(8HDEPL-DAT,I4.4)') ITIM
            WRITE(IOUT,430) XT,XT/8.64E-4,TEXT12
         ENDIF
      ELSE IF(TEXT12.EQ.'MACRO') THEN
         LMACRO=.TRUE.
      ELSE IF(TEXT12.EQ.';') THEN
         GO TO 160
      ELSE
         DO 140 IKEY=1,NPAR
         IF(TEXT12.EQ.PARKEY(IKEY)) THEN
            IPAR=IKEY
            GO TO 150
         ENDIF
  140    CONTINUE
         CALL XABORT('COMPO: INVALID KEYWORD='//TEXT12//' (5).')
  150    CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
         IF(PARFMT(IPAR).EQ.'INTEGER') THEN
            IF(INDIC.NE.1) CALL XABORT('COMPO: INTEGER DATA EXPECTE'//
     1      'D(7).')
            IF(IMPX.GT.0) WRITE(IOUT,450) PARKEY(IKEY),NITMA
         ELSE IF(PARFMT(IPAR).EQ.'REAL') THEN
            IF(INDIC.NE.2) CALL XABORT('COMPO: REAL DATA EXPECTED(2).')
            IF(IMPX.GT.0) WRITE(IOUT,440) PARKEY(IKEY),FLOTT
         ELSE IF(PARFMT(IPAR).EQ.'STRING') THEN
            IF(INDIC.NE.3) CALL XABORT('COMPO: CHARACTER DATA EXPEC'//
     1      'TED(13).')
            IF(IMPX.GT.0) WRITE(IOUT,460) PARKEY(IKEY),TEXT12
         ENDIF
         CALL LCMSIX(IPCPO,'GLOBAL',1)
         CALL COMPAV(IPCPO,IPAR,NPAR,PARFMT(IPAR),FLOTT,NITMA,TEXT12,
     1   MUPLET(IPAR),LGNEW(IPAR))
         CALL LCMSIX(IPCPO,' ',2)
      ENDIF
      CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
      IF(INDIC.NE.3) CALL XABORT('COMPO: CHARACTER DATA EXPECTED(14).')
      GO TO 120
*----
*  RECOVER AN ELEMENTARY CALCULATION
*----
  160 IF(ITIM.GT.0) THEN
         WRITE(TEXT12,'(8HDEPL-DAT,I4.4)') ITIM
         CALL LCMSIX(IPDEPL,TEXT12,1)
      ENDIF
      CALL LCMGTC(IPEDIT,'LAST-EDIT',12,1,TEXT12)
      CALL LCMSIX(IPEDIT,TEXT12,1)
      CALL LCMLEN(IPEDIT,'SIGNATURE',ILENG,ITYLCM)
      IF(ILENG.EQ.0) LMACRO=.TRUE.
      CALL LCMSIX(IPEDIT,' ',2)
*     -------------------------------------------------
      CALL COMCAL(IMPX,IPCPO,IPDEPL,IPEDIT,LMACRO,LISO)
*     -------------------------------------------------
      IF(ITIM.GT.0) CALL LCMSIX(IPDEPL,' ',2)
*----
*  RECOVER THE DEPLETION CHAIN
*----
      CALL LCMGTC(IPEDIT,'LAST-EDIT',12,1,TEXT12)
      CALL LCMSIX(IPEDIT,TEXT12,1)
      CALL LCMLEN(IPCPO,'DEPL-CHAIN',ILENG1,ITYLCM)
      CALL LCMLEN(IPEDIT,'DEPL-CHAIN',ILENG2,ITYLCM)
      IF((ILENG1.NE.0).AND.(ILENG2.NE.0)) THEN
         CALL LCMSIX(IPCPO,'DEPL-CHAIN',1)
         CALL LCMGET(IPCPO,'STATE-VECTOR',IST1)
         CALL LCMSIX(IPCPO,' ',2)
         CALL LCMSIX(IPEDIT,'DEPL-CHAIN',1)
         CALL LCMGET(IPEDIT,'STATE-VECTOR',IST2)
         CALL LCMSIX(IPEDIT,' ',2)
         DO 170 I=1,NSTATE
         IF(IST1(I).NE.IST2(I)) THEN
            WRITE(HSMG,'(39HCOMPO: INVALID STATE-VECTOR COMPONENT (,I2,
     1      40H) FOR DEPL-CHAIN DATA IN EDITION OBJECT.)') I
            CALL XABORT(HSMG)
         ENDIF
  170    CONTINUE
      ELSE IF((ILENG1.EQ.0).AND.(ILENG2.NE.0)) THEN
         CALL LCMSIX(IPCPO,'DEPL-CHAIN',1)
         CALL LCMSIX(IPEDIT,'DEPL-CHAIN',1)
         CALL LCMEQU(IPEDIT,IPCPO)
         CALL LCMSIX(IPEDIT,' ',2)
         CALL LCMSIX(IPCPO,' ',2)
      ENDIF
      CALL LCMSIX(IPEDIT,' ',2)
*----
*  RECOVER REMAINING GLOBAL AND LOCAL PARAMETERS
*----
      CALL LCMGET(IPCPO,'STATE-VECTOR',ISTATE)
      NMIL=ISTATE(1)
      CALL COMGEP(IPCPO,IPDEPL,IPLB1,IPLB2,IPEDIT,IMPX,ITIM,NORIG,NPAR,
     1 NLOC,NMIL,MUPLET,LGNEW)
*
      IF(IMPX.GT.0) WRITE(IOUT,400) NAMDIR,IMPX,(ISTATE(I),I=1,12)
      IF(IMPX.GT.4) CALL LCMLIB(IPCPO)
      RETURN
*----
*  INPUT A SET OF ELEMENTARY CALCULATIONS FROM A COMPO **********
*----
  200 IF(TEXT12.EQ.';') THEN
         GO TO 230
      ELSE IF(TEXT12.EQ.'WARNING-ONLY') THEN
         LWARN=.TRUE.
      ELSE
         DO 210 IKEY=1,NPAR
         IF(TEXT12.EQ.PARKEY(IKEY)) THEN
            IPAR=IKEY
            GO TO 220
         ENDIF
  210    CONTINUE
         CALL XABORT('COMPO: INVALID KEYWORD='//TEXT12//' (6).')
  220    IF(PARTYP(IPAR).NE.'VALU') CALL XABORT('COMPO: '//TEXT12//
     1   ' IS NOT OF VALU TYPE.')
         CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
         IF(PARFMT(IPAR).EQ.'INTEGER') THEN
            IF(INDIC.NE.1) CALL XABORT('COMPO: INTEGER DATA EXPECTE'//
     1      'D(8).')
            IF(IMPX.GT.0) WRITE(IOUT,450) PARKEY(IKEY),NITMA
         ELSE IF(PARFMT(IPAR).EQ.'REAL') THEN
            IF(INDIC.NE.2) CALL XABORT('COMPO: REAL DATA EXPECTED(3).')
            IF(IMPX.GT.0) WRITE(IOUT,440) PARKEY(IKEY),FLOTT
         ELSE IF(PARFMT(IPAR).EQ.'STRING') THEN
            IF(INDIC.NE.3) CALL XABORT('COMPO: CHARACTER DATA EXPEC'//
     1      'TED(15).')
            IF(IMPX.GT.0) WRITE(IOUT,460) PARKEY(IKEY),TEXT12
         ENDIF
         CALL LCMSIX(IPCPO,'GLOBAL',1)
         CALL COMPAV(IPCPO,IPAR,NPAR,PARFMT(IPAR),FLOTT,NITMA,TEXT12,
     1   MUPLET(IPAR),LGNEW(IPAR))
         CALL LCMSIX(IPCPO,' ',2)
      ENDIF
      CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
      IF(INDIC.NE.3) CALL XABORT('COMPO: CHARACTER DATA EXPECTED(16).')
      GO TO 200
  230 IPRHS=LCMGID(IPRHS,NAMDIR)
      CALL LCMGET(IPRHS,'STATE-VECTOR',ISTATE)
      IF(IMPX.GT.0) WRITE(IOUT,470) NCALS+1,NCALS+ISTATE(3),NAMDIR
*     ------------------------------------------------------
      CALL COMCAT(IPCPO,IPRHS,NORIG,NPAR,MUPLET,LGNEW,LWARN)
*     ------------------------------------------------------
*
      IF(IMPX.GT.0) THEN
         CALL LCMGET(IPCPO,'STATE-VECTOR',ISTATE)
         WRITE(IOUT,400) NAMDIR,IMPX,(ISTATE(I),I=1,12)
      ENDIF
      IF(IMPX.GT.4) CALL LCMLIB(IPCPO)
      RETURN
*----
*  Display the COMPO structure**********
*----
  300 IPCPO=LCMGID(ICPOLD,NAMDIR)
      CALL COMSDB(IMPX,IPCPO)
      CALL REDGET(INDIC,NITMA,FLOTT,TEXT8,DFLOTT)
      IF(TEXT8.NE.';') CALL XABORT('COMPO: ";" expected.')
      RETURN

*
  400 FORMAT(/29H COMPO: STATE-VECTOR VALUES (,A12,1H)/1X,26(1H-)/
     1 7H IMPX  ,I7,22H  (0=NO PRINT/1=SHORT)/
     2 7H NMIL  ,I7,28H  (NB. OF MIXTURES IN COMPO)/
     3 7H NG    ,I7,33H  (NB. OF ENERGY GROUPS IN COMPO)/
     4 7H NCALS ,I7,34H  (NB. OF ELEMENTARY CALCULATIONS)/
     5 7H MAXCAL,I7,42H  (MAXIMUM NB. OF ELEMENTARY CALCULATIONS)/
     6 7H NPAR  ,I7,28H  (NB. OF GLOBAL PARAMETERS)/
     7 7H NLOC  ,I7,27H  (NB. OF LOCAL PARAMETERS)/
     8 7H NPCHR ,I7,47H  (NB. OF GLOBAL PARAMETERS LINKED TO ISOTOPES)/
     9 7H NPPNT ,I7,48H  (NB. OF GLOBAL PARAMETERS LINKED TO LIBRARIES)/
     1 7H NPCHRL,I7,46H  (NB. OF LOCAL PARAMETERS LINKED TO ISOTOPES)/
     2 7H NCOMLI,I7,27H  (NB. OF LINES OF COMMENT)/
     3 7H LGEOM ,I7,34H  (0/1: GEOMETRIES ABSENT/PRESENT)/
     4 7H LSPEC ,I7,34H  (COMPO SPECIFICATION IDENTIFIER))
  420 FORMAT(/1X,60(1H*)/36H * COMPO: ELEMENTARY CALCULATION NB.,I5,
     1 4X,1H(,A12,3H) */1X,60(1H*))
  430 FORMAT(/43H COMPO: RECOVER INFORMATION RELATED TO TIME,1P,E12.4,
     1 8H E+8 S (,E12.4,32H DAY) FROM LCM DIRECTORY NAMED ',A12,2H'.)
  440 FORMAT(30H COMPO: SET GLOBAL PARAMETER ',A,3H' =,1P,E12.4)
  450 FORMAT(30H COMPO: SET GLOBAL PARAMETER ',A,3H' =,I10)
  460 FORMAT(30H COMPO: SET GLOBAL PARAMETER ',A,5H' = ',A12,1H')
  470 FORMAT(/1X,69(1H*)/37H * COMPO: ELEMENTARY CALCULATIONS NB.,I5,
     1 3H TO,I5,4X,1H(,A12,3H) */1X,69(1H*))
      END
