*DECK SAP
      SUBROUTINE SAP(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Creation and construction of a Saphyb database object.
*
*Copyright:
* Copyright (C) 2007 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/output
* NENTRY  number of LCM objects or files used by the operator.
* HENTRY  name of each LCM object or file:
*         HENTRY(1): Saphyb 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 (NDIMSA=50,MAXPAR=50,MAXISO=800,NKEYS=8,NREAK=20,
     1 MAXLIN=50,MAXMAC=2)
      TYPE(C_PTR) IPSAP,IPLB1,IPLB2,IPDEPL,IPEDIT,IPFLUX,IPRHS
      CHARACTER TEXT4*4,TEXT8*8,TEXT12*12,TEXT20*20,HSSAP*80,HSIGN*12,
     1 KEYWRD(NKEYS)*4,PARNAM(MAXPAR)*80,PARKEY(MAXPAR)*4,
     2 PARCHR(MAXPAR)*8,PARTYP(MAXPAR)*4,PARFMT(MAXPAR)*8,
     3 PARBIB(MAXPAR)*12,PARNAL(MAXPAR)*80,PARKEL(MAXPAR)*4,
     4 PARCHL(MAXPAR)*8,PARTYL(MAXPAR)*4,PARFML(MAXPAR)*8,
     5 NOMISO(MAXISO)*8,NOMEVO(MAXISO)*12,REAKEY(NREAK)*4,
     6 REANAM(NREAK)*10,NOMREA(NREAK)*12,HSMG*131,COMMEN(MAXLIN)*80,
     7 NOMMAC(MAXMAC)*8
      DOUBLE PRECISION DFLOTT
      LOGICAL LINIT,LKEFF,LKINF,LB2,LWARN,LCRON,LGNEW(MAXPAR)
      INTEGER IDATA(NDIMSA),PARMIL(MAXPAR),NVALUE(MAXPAR),
     1 PARCAD(MAXPAR+1),PARPAD(MAXPAR+1),PARCAL(MAXPAR+1),
     2 PARPAL(MAXPAR+1),TYPISO(MAXISO),MUPLET(MAXPAR),TYPMAC(MAXMAC)
*----
*  ALLOCATABLE ARRAYS
*----
      INTEGER, POINTER, DIMENSION(:) :: HMIX
      INTEGER, ALLOCATABLE, TARGET, DIMENSION(:) :: HMIX2
      REAL, ALLOCATABLE, DIMENSION(:) :: TIMES
      LOGICAL, ALLOCATABLE, DIMENSION(:) :: LOG
*----
*  DATA STATEMENTS
*----
      DATA KEYWRD/'NOML','PARA','LOCA','ISOT','MACR','REAC','NAME',
     1            ';   '/
      DATA REAKEY/'TOTA','ABSO','SNNN','FISS','CHI ','NUFI','ENER',
     1            'EFIS','EGAM','FUIT','SELF','DIFF','PROF','TRAN',
     2            'FUIR','FUIZ','NP  ','NT  ','NA  ','TOP1'/
      DATA REANAM/'TOTALE    ','ABSORPTION','EXCESS    ','FISSION   ',
     1            'SPECTRE   ','NU*FISSION','ENERGIE   ','ENERGIE F.',
     2            'ENERGIE G.','FUITES    ','SELF      ','DIFFUSION ',
     3            'PROFIL    ','TRANSFERT ','FUITES R  ','FUITES Z  ',
     4            'NP        ','NT        ','NA        ','TOTALE P1 '/
*----
*  PARAMETER VALIDATION.
*----
      LINIT=.FALSE.
      IF(NENTRY.EQ.0) CALL XABORT('SAP: PARAMETERS EXPECTED.')
      IF((IENTRY(1).LE.2).AND.(JENTRY(1).EQ.0)) THEN
         IPSAP=KENTRY(1)
         LINIT=.TRUE.
         HSSAP='SAPHYB LIBRARY VER. 0.02'
         CALL LCMPTC(IPSAP,'TITLE',80,1,HSSAP)
         TEXT12='L_SAPHYB'
         CALL LCMPTC(IPSAP,'SIGNATURE',12,1,TEXT12)
      ELSE IF(IENTRY(1).LE.2) THEN
         IPSAP=KENTRY(1)
         CALL LCMGTC(IPSAP,'TITLE',80,1,HSSAP)
         IF(HSSAP(:6).NE.'SAPHYB') THEN
            TEXT12=HENTRY(1)
            CALL XABORT('SAP: SIGNATURE OF '//TEXT12//' IS '//
     1      HSSAP(:6)//'. SAPHYB EXPECTED.')
         ENDIF
         LINIT=.FALSE.
      ELSE
         CALL XABORT('SAP: SAPHYB LCM OBJECT EXPECTED.')
      ENDIF
      IPLB1=C_NULL_PTR
      IPLB2=C_NULL_PTR
      IPDEPL=C_NULL_PTR
      IPEDIT=C_NULL_PTR
      IPFLUX=C_NULL_PTR
      IPRHS=C_NULL_PTR
      DO 10 I=2,NENTRY
      IF(IENTRY(I).LE.2) THEN
         IF(JENTRY(I).NE.2) CALL XABORT('SAP: 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)) THEN
               IPLB1=KENTRY(I)
            ELSE
               IF(.NOT.C_ASSOCIATED(IPLB2)) IPLB2=KENTRY(I)
            ENDIF
         ELSE IF(HSIGN.EQ.'L_BURNUP') THEN
            IPDEPL=KENTRY(I)
         ELSE IF(HSIGN.EQ.'L_EDIT') THEN
            IPEDIT=KENTRY(I)
         ELSE IF(HSIGN.EQ.'L_FLUX') THEN
            IPFLUX=KENTRY(I)
         ELSE IF(HSIGN.EQ.'L_SAPHYB') THEN
            IPRHS=KENTRY(I)
         ENDIF
      ELSE
         CALL XABORT('SAP: LCM OBJECT EXPECTED AT RHS.')
      ENDIF
   10 CONTINUE
*----
*  READ THE INPUT DATA.
*----
*     DEFAULT OPTIONS:
      IMPX=1
      IF(LINIT) THEN
         NCOMLI=0
         NPAR=0
         NPCHR=0
         NPPNT=0
         NLOC=0
         NPPNTL=0
         NPCHRL=0
         NISO=0
         NMAC=0
         NMIL=0
         NREA=0
         NISOF=0
         NISOP=0
         PARCAD(1)=1
         PARPAD(1)=1
         PARCAL(1)=1
         PARPAL(1)=1
      ELSE
         GO TO 300
      ENDIF
   20 CALL REDGET(INDIC,NITMA,FLOTT,TEXT8,DFLOTT)
      IF(INDIC.NE.3) CALL XABORT('SAP: CHARACTER DATA EXPECTED(1).')
   30 IF(TEXT8.EQ.'EDIT') THEN
*        READ THE PRINT INDEX.
         CALL REDGET(INDIC,IMPX,FLOTT,TEXT4,DFLOTT)
         IF(INDIC.NE.1) CALL XABORT('SAP: INTEGER DATA EXPECTED(1).')
      ELSE IF(TEXT8.EQ.'COMM') THEN
   35    CALL REDGET(INDIC,NITMA,FLOTT,HSSAP(:72),DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('SAP: COMMENTS EXPECTED.')
         IF(HSSAP(:4).EQ.'ENDC') THEN
            CALL LCMPTC(IPSAP,'COMMEN',80,NCOMLI,COMMEN)
            GO TO 20
         ENDIF
         NCOMLI=NCOMLI+1
         IF(NCOMLI.GT.MAXLIN) CALL XABORT('SAP: TITLE OVERFLOW.')
         COMMEN(NCOMLI)=HSSAP(:72)
         GO TO 35
      ELSE IF(TEXT8.EQ.'NOML') THEN
         HSSAP=' '
         CALL REDGET(INDIC,NITMA,FLOTT,HSSAP(:72),DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('SAP: CHARACTER DATA EXPECTED'
     1   //'(2).')
         CALL LCMPTC(IPSAP,'NOMLIB',80,1,HSSAP)
      ELSE IF(TEXT8.EQ.'PARA') THEN
         NPAR=NPAR+1
         IF(NPAR.GT.MAXPAR) CALL XABORT('SAP: TOO MANY PARAMETERS.')
         PARNAM(NPAR)=' '
         CALL REDGET(INDIC,NITMA,FLOTT,PARNAM(NPAR)(:72),DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('SAP: CHARACTER DATA EXPECTED'
     1   //'(3).')
         DO 40 I=1,NPAR-1
         IF(PARNAM(NPAR).EQ.PARNAM(I)) CALL XABORT('SAP: PARNAM '//
     1   PARNAM(NPAR)//' ALREADY DEFINED(1).')
   40    CONTINUE
         CALL REDGET(INDIC,NITMA,FLOTT,PARKEY(NPAR),DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('SAP: CHARACTER DATA EXPECTED'
     1   //'(4).')
         DO 50 I=1,NPAR-1
         IF(PARKEY(NPAR).EQ.PARKEY(I)) CALL XABORT('SAP: PARKEY '//
     1   PARKEY(NPAR)//' ALREADY DEFINED(1).')
   50    CONTINUE
         CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('SAP: CHARACTER DATA EXPECTED'
     1   //'(4).')
         IF(TEXT4.EQ.'TEMP') THEN
            NPPNT=NPPNT+1
            CALL REDGET(INDIC,NITMA,FLOTT,PARBIB(NPPNT),DFLOTT)
            IF(INDIC.NE.3) CALL XABORT('SAP: CHARACTER DATA EXPECTED'
     1      //'(5).')
            CALL REDGET(INDIC,PARMIL(NPPNT),FLOTT,TEXT4,DFLOTT)
            IF(INDIC.NE.1) CALL XABORT('SAP: INTEGER DATA EXPECTE'//
     1      'D(2).')
            PARFMT(NPAR)='FLOTTANT'
         ELSE IF(TEXT4.EQ.'CONC') THEN
            NPCHR=NPCHR+1
            CALL REDGET(INDIC,NITMA,FLOTT,PARCHR(NPCHR),DFLOTT)
            IF(INDIC.NE.3) CALL XABORT('SAP: CHARACTER DATA EXPECTED'
     1      //'(6).')
            NPPNT=NPPNT+1
            CALL REDGET(INDIC,NITMA,FLOTT,PARBIB(NPPNT),DFLOTT)
            IF(INDIC.NE.3) CALL XABORT('SAP: CHARACTER DATA EXPECTED'
     1      //'(7).')
            CALL REDGET(INDIC,PARMIL(NPPNT),FLOTT,TEXT4,DFLOTT)
            IF(INDIC.NE.1) CALL XABORT('SAP: INTEGER DATA EXPECTE'//
     1      'D(3).')
            PARFMT(NPAR)='FLOTTANT'
         ELSE IF(TEXT4.EQ.'IRRA') THEN
            PARFMT(NPAR)='FLOTTANT'
         ELSE IF(TEXT4.EQ.'FLUX') THEN
            PARFMT(NPAR)='FLOTTANT'
         ELSE IF(TEXT4.EQ.'FLUB') THEN
            PARFMT(NPAR)='FLOTTANT'
         ELSE IF(TEXT4.EQ.'PUIS') THEN
            PARFMT(NPAR)='FLOTTANT'
         ELSE IF(TEXT4.EQ.'TIME') THEN
            PARFMT(NPAR)='FLOTTANT'
         ELSE IF(TEXT4.EQ.'VALE') THEN
            CALL REDGET(INDIC,NITMA,FLOTT,TEXT8,DFLOTT)
            IF(INDIC.NE.3) CALL XABORT('SAP: CHARACTER DATA EXPECTED'
     1      //'(8).')
            IF(TEXT8.EQ.'FLOT')THEN
               PARFMT(NPAR)='FLOTTANT'
            ELSEIF(TEXT8.EQ.'CHAI')THEN
               PARFMT(NPAR)='CHAINE'
            ELSEIF(TEXT8.EQ.'ENTI')THEN
               PARFMT(NPAR)='ENTIER'
            ELSE
               CALL XABORT('SAP: INVALID KEYWORD='//TEXT4//'(1).')
            ENDIF
         ELSE
            CALL XABORT('SAP: INVALID KEYWORD='//TEXT4//'(2).')
         ENDIF
         NVALUE(NPAR)=0
         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('SAP: TOO MANY LOCAL VAR'//
     1   'IABLES.')
         PARNAL(NLOC)=' '
         CALL REDGET(INDIC,NITMA,FLOTT,PARNAL(NLOC)(:72),DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('SAP: CHARACTER DATA EXPECTED'
     1   //'(9).')
         DO 60 I=1,NLOC-1
         IF(PARNAL(NLOC).EQ.PARNAL(I)) CALL XABORT('SAP: PARNAM '//
     1   PARNAL(NLOC)//' ALREADY DEFINED(2).')
   60    CONTINUE
         CALL REDGET(INDIC,NITMA,FLOTT,PARKEL(NLOC),DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('SAP: CHARACTER DATA EXPECTED'
     1   //'(10).')
         DO 70 I=1,NLOC-1
         IF(PARKEL(NLOC).EQ.PARKEL(I)) CALL XABORT('SAP: PARKEY '//
     1   PARKEL(NLOC)//' ALREADY DEFINED(2).')
   70    CONTINUE
         CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('SAP: CHARACTER DATA EXPECTED'
     1   //'(11).')
         IF(TEXT4.EQ.'CONC') THEN
            NPCHRL=NPCHRL+1
            CALL REDGET(INDIC,NITMA,FLOTT,PARCHL(NPCHRL),DFLOTT)
            IF(INDIC.NE.3) CALL XABORT('SAP: CHARACTER DATA EXPECTED'
     1      //'(12).')
         ELSE IF((TEXT4.NE.'IRRA').AND.(TEXT4.NE.'FLUG').AND.
     1           (TEXT4.NE.'FLUB').AND.(TEXT4.NE.'PUIS').AND.
     2           (TEXT4.NE.'MASL').AND.(TEXT4.NE.'FLUX').AND.
     3           (TEXT4.NE.'EQUI').AND.(TEXT4.NE.'TEMP')) THEN
            CALL XABORT('SAP: INVALID KEYWORD='//TEXT4//'(3).')
         ENDIF
         PARFML(NLOC)='FLOTTANT'
         PARTYL(NLOC)=TEXT4
         PARCAL(NLOC+1)=NPCHRL+1
         PARPAL(NLOC+1)=NPPNTL+1
      ELSE IF(TEXT8.EQ.'ISOT') THEN
   80    CALL REDGET(INDIC,NITMA,FLOTT,TEXT8,DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('SAP: CHARACTER DATA EXPECTED'
     1   //'(13).')
         DO 90 IKEY=1,NKEYS
         IF(TEXT8.EQ.KEYWRD(IKEY)) GO TO 30
   90    CONTINUE
         IF(TEXT8.EQ.'TOUT') THEN
            CALL COMISO(-1,MAXISO,IPLB1,NISO,NOMISO,NOMEVO,TYPISO)
            GO TO 20
         ELSE IF(TEXT8.EQ.'FISS') THEN
            CALL COMISO(-2,MAXISO,IPLB1,NISO,NOMISO,NOMEVO,TYPISO)
         ELSE IF(TEXT8.EQ.'PF') THEN
            CALL COMISO(-3,MAXISO,IPLB1,NISO,NOMISO,NOMEVO,TYPISO)
         ELSE IF(TEXT8.EQ.'MILI') THEN
            CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
            IF(INDIC.NE.1) CALL XABORT('SAP: INTEGER DATA EXPECTE'//
     1      'D(4).')
            CALL COMISO(NITMA,MAXISO,IPLB1,NISO,NOMISO,NOMEVO,TYPISO)
         ELSE
            DO 100 IKEY=1,NKEYS
            IF(TEXT8.EQ.KEYWRD(IKEY)) GO TO 30
  100       CONTINUE
            NISO=NISO+1
            IF(NISO.GT.MAXISO) CALL XABORT('SAP: TOO MANY ISOTOPES.')
            NOMISO(NISO)=TEXT8
            TYPISO(NISO)=0
         ENDIF
         GO TO 80
      ELSE IF(TEXT8.EQ.'MACR') THEN
         CALL REDGET(INDIC,NITMA,FLOTT,TEXT8,DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('SAP: CHARACTER DATA EXPECTED'
     1   //'(14).')
         CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('SAP: CHARACTER DATA EXPECTED'
     1   //'(15).')
         NMACRT=0
         IF(TEXT4.EQ.'TOUT') THEN
            NMACRT=1
         ELSE IF(TEXT4.EQ.'REST') THEN
            NMACRT=2
         ELSE
            CALL XABORT('SAP: INVALID KEYWORD='//TEXT4//'(3).')
         ENDIF
         CALL LCMSIX(IPSAP,'contenu',1)
         IF(NMAC.GT.0) THEN
            CALL LCMGTC(IPSAP,'NOMMAC',8,NMAC,NOMMAC)
            CALL LCMGET(IPSAP,'TYPMAC',TYPMAC)
         ENDIF
         NMAC=NMAC+1
         IF(NMAC.GT.MAXMAC) CALL XABORT('SAP: MAXMAC OVERFLOW.')
         NOMMAC(NMAC)=TEXT8
         TYPMAC(NMAC)=NMACRT
         CALL LCMPTC(IPSAP,'NOMMAC',8,NMAC,NOMMAC)
         CALL LCMPUT(IPSAP,'TYPMAC',NMAC,1,TYPMAC)
         CALL LCMSIX(IPSAP,' ',2)
      ELSE IF(TEXT8.EQ.'REAC') THEN
  110    CALL REDGET(INDIC,NITMA,FLOTT,TEXT8,DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('SAP: CHARACTER DATA EXPECTED'
     1   //'(16).')
         DO 120 IKEY=1,NKEYS
         IF(TEXT8.EQ.KEYWRD(IKEY)) GO TO 30
  120    CONTINUE
         NREA=NREA+1
         IF(NREA.GT.NREAK) CALL XABORT('SAP: TOO MANY REACTIONS.')
         DO 130 IKEY=1,NREAK
         NOMREA(NREA)=REANAM(IKEY)
         IF(TEXT8.EQ.REAKEY(IKEY)) GO TO 110
  130    CONTINUE
         NOMREA(NREA)=TEXT8
         GO TO 110
      ELSE IF(TEXT8.EQ.'NAME') THEN
*        READ MIXTURE NAMES.
         MAXMIL=30
         ALLOCATE(HMIX(5*MAXMIL))
  140    CALL REDGET(INDIC,NITMA,FLOTT,TEXT20,DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('SAP: CHARACTER DATA EXPECTED'//
     1   '(17).')
         IF(TEXT20.EQ.';') THEN
            CALL LCMSIX(IPSAP,'geom',1)
            IF(NMIL.GT.0) CALL LCMPUT(IPSAP,'NOMMIL',5*NMIL,3,HMIX)
            CALL LCMSIX(IPSAP,' ',2)
            DEALLOCATE(HMIX)
            GO TO 160
         ENDIF
         NMIL=NMIL+1
         IF(NMIL.GT.MAXMIL) THEN
            ALLOCATE(HMIX2(5*(MAXMIL+30)))
            DO 150 I=1,5*MAXMIL
            HMIX2(I)=HMIX(I)
  150       CONTINUE
            DEALLOCATE(HMIX)
            MAXMIL=MAXMIL+30
            HMIX=>HMIX2
         ENDIF
         READ(TEXT20,'(5A4)') (HMIX((NMIL-1)*5+I0),I0=1,5)
         GO TO 140
      ELSE IF(TEXT8.EQ.';') THEN
         GO TO 160
      ELSE
         CALL XABORT('SAP: INVALID KEYWORD='//TEXT8//'(4).')
      ENDIF
      GO TO 20
*
* ADD THE TIME PARAMETER.
  160 DO 170 I=1,NPAR
      IF((PARTYP(I).EQ.'IRRA').OR.(PARTYP(I).EQ.'FLUB')) GO TO 180
  170 CONTINUE
      GO TO 220
  180 DO 210 I=1,NPAR
      IF(PARTYP(I).EQ.'TIME') GO TO 220
  210 CONTINUE
      NPAR=NPAR+1
      IF(NPAR.GT.MAXPAR) CALL XABORT('SAP: TOO MANY PARAMETERS.')
      PARNAM(NPAR)='TEMPS'
      PARKEY(NPAR)='TIME'
      PARTYP(NPAR)='TIME'
      PARFMT(NPAR)='FLOTTANT'
      NVALUE(NPAR)=0
      PARCAD(NPAR+1)=PARCAD(1)+NPCHR
      PARPAD(NPAR+1)=PARPAD(1)+NPPNT
*----
*  STORE THE SAPHYB INITIALIZATION INFORMATION.
*----
  220 CALL LCMSIX(IPSAP,'contenu',1)
      IF(NISO.GT.0) THEN
         CALL COMISO(0,MAXISO,IPLB1,NISO,NOMISO,NOMEVO,TYPISO)
         CALL LCMPTC(IPSAP,'NOMISO',8,NISO,NOMISO)
         DO 230 I=1,NISO
         IF(TYPISO(I).EQ.2) NISOF=NISOF+1
         IF(TYPISO(I).EQ.3) NISOP=NISOP+1
  230    CONTINUE
      ENDIF
      IF(NREA.GT.0) CALL LCMPTC(IPSAP,'NOMREA',12,NREA,NOMREA)
      CALL LCMSIX(IPSAP,' ',2)
*
      IF(NPAR.GT.0) THEN
         CALL LCMSIX(IPSAP,'paramdescrip',1)
         CALL LCMPUT(IPSAP,'NPAR',1,1,NPAR)
         CALL LCMPUT(IPSAP,'NPCHR',1,1,NPCHR)
         CALL LCMPTC(IPSAP,'PARNAM',80,NPAR,PARNAM)
         CALL LCMPTC(IPSAP,'PARKEY',4,NPAR,PARKEY)
         CALL LCMPTC(IPSAP,'PARTYP',4,NPAR,PARTYP)
         CALL LCMPTC(IPSAP,'PARFMT',8,NPAR,PARFMT)
         IF(NPCHR.GT.0) THEN
           CALL LCMPTC(IPSAP,'PARCHR',8,NPCHR,PARCHR)
         ELSE
*          dummy record to make Lisaph happy
           PARCHR(1)=' '
           PARCHR(2)=' '
           CALL LCMPTC(IPSAP,'PARCHR',8,2,PARCHR)
         ENDIF
         CALL LCMPUT(IPSAP,'NVALUE',NPAR,1,NVALUE)
         CALL LCMPUT(IPSAP,'PARCAD',NPAR+1,1,PARCAD)
         CALL LCMPUT(IPSAP,'PARPAD',NPAR+1,1,PARPAD)
         IF(NPPNT.GT.0) CALL LCMPUT(IPSAP,'PARMIL',NPPNT,1,PARMIL)
         IF(NPPNT.GT.0) CALL LCMPTC(IPSAP,'PARBIB',12,NPPNT,PARBIB)
         CALL LCMSIX(IPSAP,' ',2)
      ENDIF
*
      IF(NLOC.GT.0) THEN
         CALL LCMSIX(IPSAP,'varlocdescri',1)
         CALL LCMPUT(IPSAP,'NPAR',1,1,NLOC)
         CALL LCMPUT(IPSAP,'NPCHR',1,1,NPCHRL)
         CALL LCMPTC(IPSAP,'PARNAM',80,NLOC,PARNAL)
         CALL LCMPTC(IPSAP,'PARKEY',4,NLOC,PARKEL)
         CALL LCMPTC(IPSAP,'PARTYP',4,NLOC,PARTYL)
         CALL LCMPTC(IPSAP,'PARFMT',8,NLOC,PARFML)
         IF(NPCHRL.GT.0) THEN
           CALL LCMPTC(IPSAP,'PARCHR',8,NPCHRL,PARCHL)
         ELSE
*          dummy record to make Lisaph happy
           PARCHL(1)=' '
           PARCHL(2)=' '
           CALL LCMPTC(IPSAP,'PARCHR',8,2,PARCHL)
         ENDIF
         CALL LCMPUT(IPSAP,'PARCAD',NLOC+1,1,PARCAL)
         CALL LCMPUT(IPSAP,'PARPAD',NLOC+1,1,PARPAL)
         CALL LCMSIX(IPSAP,' ',2)
      ENDIF
*----
*  FILL THE 'constphysiq' DIRECTORY.
*----
      IF(C_ASSOCIATED(IPLB1)) THEN
         CALL LCMGET(IPLB1,'STATE-VECTOR',IDATA)
         NBISO=IDATA(2)
         NGA=IDATA(3)
         CALL SAPFWC(IPSAP,IPLB1,MAXISO,NBISO,NGA,NISOTA)
      ELSE
         NBISO=0
         NGA=0
         NISOTA=0
      ENDIF
*----
*  CREATE A dummy 'geom' DIRECTORY TO MAKE LISAPH HAPPY.
*----
      CALL LCMSIX(IPSAP,'geom',1)
      IDATA(1)=4040200
      CALL LCMPUT(IPSAP,'GEOTYP',1,1,IDATA)
      IDATA(1)=1
      IDATA(2)=2
      IDATA(3)=3
      IDATA(4)=4
      IDATA(5)=5
      CALL LCMPUT(IPSAP,'FIRSTS',5,1,IDATA)
      IDATA(1)=1
      IDATA(2)=3
      CALL LCMPUT(IPSAP,'XNP',2,1,IDATA)
      FLOTT=1.0
      CALL LCMPUT(IPSAP,'XVOLMR',1,2,FLOTT)
      FLOTT=1.0
      CALL LCMPUT(IPSAP,'XNUR',1,2,FLOTT)
      CALL LCMSIX(IPSAP,' ',2)
*----
*  FILL THE 'contenu' DIRECTORY WITH LOGICAL INFORMATION.
*----
      CALL LCMSIX(IPSAP,'contenu',1)
      IF(NISOTA*NMAC.GT.0) THEN
         ALLOCATE(LOG(NISOTA*NMAC))
         CALL XDLSET(LOG,NISOTA*NMAC,.FALSE.)
         CALL LCMPUT(IPSAP,'LISMAC',NISOTA*NMAC,5,LOG)
         DEALLOCATE(LOG)
      ENDIF
      IF(NMIL*NISO.GT.0) THEN
         ALLOCATE(LOG(NMIL*NISO))
         CALL XDLSET(LOG,NMIL*NISO,.TRUE.)
         CALL LCMPUT(IPSAP,'LISMIL',NMIL*NISO,5,LOG)
         DEALLOCATE(LOG)
      ENDIF
      IF(NMIL*NMAC.GT.0) THEN
         ALLOCATE(LOG(NMIL*NMAC))
         CALL XDLSET(LOG,NMIL*NMAC,.TRUE.)
         CALL LCMPUT(IPSAP,'LMAMIL',NMIL*NMAC,5,LOG)
         DEALLOCATE(LOG)
      ENDIF
      IF(NREA*NISO.GT.0) THEN
         ALLOCATE(LOG(NREA*NISO))
         CALL XDLSET(LOG,NREA*NISO,.TRUE.)
         CALL LCMPUT(IPSAP,'LISREA',NREA*NISO,5,LOG)
         DEALLOCATE(LOG)
      ENDIF
      IF(NREA*NMAC.GT.0) THEN
         ALLOCATE(LOG(NREA*NMAC))
         CALL XDLSET(LOG,NREA*NMAC,.TRUE.)
         CALL LCMPUT(IPSAP,'LMAREA',NREA*NMAC,5,LOG)
         DEALLOCATE(LOG)
      ENDIF
      CALL LCMSIX(IPSAP,' ',2)
*
      CALL XDISET(IDATA,NDIMSA,0)
      IDATA(1)=NCOMLI
      IDATA(2)=NISOTA
      IDATA(4)=NREA
      IDATA(5)=NISO
      IDATA(6)=NMAC
      IDATA(7)=NMIL
      IDATA(8)=NPAR
      IDATA(9)=NPCHR
      IDATA(10)=NPPNT
      IDATA(11)=NLOC
      IDATA(12)=NPCHRL
      IDATA(13)=NPPNTL
      IDATA(14)=NISOF
      IDATA(15)=NISOP
      IDATA(16)=1
      IDATA(22)=2
      IDATA(30)=NGA
      CALL LCMPUT(IPSAP,'DIMSAP',NDIMSA,1,IDATA)
      IF(IMPX.GT.0) THEN
         WRITE(6,400) IMPX,(IDATA(I),I=1,17)
         WRITE(6,410) (IDATA(I),I=18,33)
      ENDIF
      RETURN
* END OF SAPHYB INITIALIZATION. **********************************
*----
*  INPUT AN ELEMENTARY CALCULATION. *******************************
*----
  300 CALL LCMGET(IPSAP,'DIMSAP',IDATA)
      IF(IDATA(22).NE.2) CALL XABORT('SAP: INVALID VERSION OF SAP'//
     1 'HYB SPECIFICATION.')
      NPAR=IDATA(8)
      IF(NPAR.GT.MAXPAR) CALL XABORT('SAP: TOO MANY PARAMETERS(3).')
      NPCHR=IDATA(9)
      NPPNT=IDATA(10)
      NCALS=IDATA(19)
      NORIG=NCALS
      IF(NPAR.GT.0) THEN
         CALL LCMSIX(IPSAP,'paramdescrip',1)
         CALL LCMGTC(IPSAP,'PARKEY',4,NPAR,PARKEY)
         CALL LCMGTC(IPSAP,'PARTYP',4,NPAR,PARTYP)
         CALL LCMGTC(IPSAP,'PARFMT',8,NPAR,PARFMT)
         CALL LCMSIX(IPSAP,' ',2)
      ENDIF
*
      ITIM=0
      LWARN=.FALSE.
      LCRON=.FALSE.
  310 CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
      IF(INDIC.EQ.10) GO TO 350
      IF(INDIC.NE.3) CALL XABORT('SAP: CHARACTER DATA EXPECTED(18).')
      IF(TEXT4.EQ.'EDIT') THEN
*        READ THE PRINT INDEX.
         CALL REDGET(INDIC,IMPX,FLOTT,TEXT4,DFLOTT)
         IF(INDIC.NE.1) CALL XABORT('SAP: INTEGER DATA EXPECTED(5).')
      ELSE IF(TEXT4.EQ.'SET') THEN
         CALL REDGET(INDIC,NITMA,XT,TEXT4,DFLOTT)
         IF(INDIC.NE.2) CALL XABORT('SAP: REAL DATA EXPECTED(1).')
         CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('SAP: CHARACTER DATA EXPECTED'
     1   //'(19).')
         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('SAP: S, DAY OR YEAR EXPECTED.')
         ENDIF
         IF(.NOT.C_ASSOCIATED(IPDEPL)) CALL XABORT('SAP: DEPLETION OBJ'
     1   //'ECT EXPECTED AT RHS.')
         CALL LCMLEN(IPDEPL,'DEPL-TIMES',NTIM,ITYLCM)
         IF(NTIM.EQ.0) CALL XABORT('SAP: NO DEPLETION TIME STEPS.')
         ALLOCATE(TIMES(NTIM))
         CALL LCMGET(IPDEPL,'DEPL-TIMES',TIMES)
         DO 320 I=1,NTIM
         IF(ABS(TIMES(I)-XT).LE.1.0E-4*XT) ITIM=I
  320    CONTINUE
         IF(ITIM.EQ.0) THEN
            WRITE(HSMG,'(39HSAP: 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(6,430) XT,XT/8.64E-4,TEXT12
         ENDIF
      ELSE IF(TEXT4.EQ.'ORIG') THEN
         CALL REDGET(INDIC,NORIG,FLOTT,TEXT4,DFLOTT)
         IF(INDIC.NE.1) CALL XABORT('SAP: INTEGER DATA EXPECTED(6).')
      ELSE IF(TEXT4.EQ.'KEFF') THEN
         LKEFF=.TRUE.
      ELSE IF(TEXT4.EQ.'KINF') THEN
         LKINF=.TRUE.
      ELSE IF(TEXT4.EQ.'B2') THEN
         LB2=.TRUE.
      ELSE IF(TEXT4.EQ.';') THEN
         GO TO 350
      ELSE IF(TEXT4.EQ.'WARN') THEN
         LWARN=.TRUE.
      ELSE IF(TEXT4.EQ.'CRON') THEN
         LCRON=.TRUE.
      ELSE
         DO 330 IKEY=1,NPAR
         IF(TEXT4.EQ.PARKEY(IKEY)) THEN
            IPAR=IKEY
            GO TO 340
         ENDIF
  330    CONTINUE
         CALL XABORT('SAP: INVALID KEYWORD='//TEXT4//'(5).')
  340    IF(PARTYP(IPAR).NE.'VALE') CALL XABORT('SAP: '//TEXT4//
     1   ' IS NOT OF VALE TYPE.')
         CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
         IF(PARFMT(IPAR).EQ.'ENTIER') THEN
            IF(INDIC.NE.1) CALL XABORT('SAP: INTEGER DATA EXPECTE'//
     1      'D(7).')
            IF(IMPX.GT.0) WRITE(6,450) PARKEY(IKEY),NITMA
         ELSE IF(PARFMT(IPAR).EQ.'FLOTTANT') THEN
            IF(INDIC.NE.2) CALL XABORT('SAP: REAL DATA EXPECTED(2).')
            IF(IMPX.GT.0) WRITE(6,440) PARKEY(IKEY),FLOTT
         ELSE IF(PARFMT(IPAR).EQ.'CHAINE') THEN
            IF(INDIC.NE.3) CALL XABORT('SAP: CHARACTER DATA EXPEC'//
     1      'TED(20).')
            IF(IMPX.GT.0) WRITE(6,460) PARKEY(IKEY),TEXT12
         ENDIF
         CALL SAPPAV(IPSAP,IPAR,NPAR,PARFMT(IPAR),FLOTT,NITMA,TEXT12,
     1   MUPLET(IPAR),LGNEW(IPAR))
      ENDIF
      GO TO 310
*----
*  RECOVER AN ELEMENTARY CALCULATION.
*----
  350 IF(C_ASSOCIATED(IPRHS)) GO TO 360
      IF(IMPX.GT.0) WRITE(6,420) NCALS+1
      IF(ITIM.GT.0) THEN
         WRITE(TEXT12,'(8HDEPL-DAT,I4.4)') ITIM
         CALL LCMSIX(IPDEPL,TEXT12,1)
      ENDIF
*     -------------------------------------------
      CALL SAPCAL(IMPX,IPSAP,IPDEPL,IPEDIT,LCRON)
*     -------------------------------------------
*----
*  RECOVER THE FLUX OF THE REFERENCE CALCULATION.
*----
      IF(C_ASSOCIATED(IPFLUX)) THEN
         CALL LCMGET(IPFLUX,'STATE-VECTOR',IDATA)
         NGA=IDATA(1)
         NRT=IDATA(2)
         CALL SAPFLU(IMPX,NCALS+1,IPSAP,IPFLUX,IPDEPL,NGA,NRT)
      ELSE
         NGA=0
         NRT=0
      ENDIF
      IF(ITIM.GT.0) CALL LCMSIX(IPDEPL,' ',2)
*----
*  RECOVER REMAINING GLOBAL PARAMETER AND LOCAL VALUES.
*----
      CALL SAPGEP(IPSAP,IPDEPL,IPLB1,IPLB2,IPEDIT,IMPX,ITIM,NORIG,NPAR,
     1 MUPLET,LGNEW,NVPNEW,NCALAR)
      CALL LCMGET(IPSAP,'DIMSAP',IDATA)
      IF((C_ASSOCIATED(IPDEPL)).AND.(IDATA(3).EQ.0)) THEN
         IDATA(3)=1
         CALL LCMSIX(IPSAP,'constphysiq',1)
         WRITE(TEXT8,'(8HDECAY   )')
         CALL LCMPTC(IPSAP,'NOMLAM',8,1,TEXT8)
         CALL LCMSIX(IPSAP,' ',2)
      ENDIF
      IDATA(17)=NVPNEW
      IDATA(19)=NCALAR
      IF(IDATA(28).EQ.0) THEN
         IDATA(28)=NRT
      ELSE
         IF(NRT.NE.IDATA(28)) CALL XABORT('SAP: BAD VALUE OF NRT.')
      ENDIF
      IF(NGA.NE.0) THEN
         IF(NGA.NE.IDATA(30)) CALL XABORT('SAP: BAD VALUE OF NGA.')
      ENDIF
      CALL LCMPUT(IPSAP,'DIMSAP',NDIMSA,1,IDATA)
*
      NISO=IDATA(5)
      NMAC=IDATA(6)
      NMIL=IDATA(7)
      CALL LCMSIX(IPSAP,'contenu',1)
      CALL LCMLEN(IPSAP,'LISMIL',ILONG,ITYLCM)
      IF((ILONG.EQ.0).AND.(NMIL*NISO.GT.0)) THEN
         ALLOCATE(LOG(NMIL*NISO))
         CALL XDLSET(LOG,NMIL*NISO,.TRUE.)
         CALL LCMPUT(IPSAP,'LISMIL',NMIL*NISO,5,LOG)
         DEALLOCATE(LOG)
      ENDIF
      CALL LCMLEN(IPSAP,'LMAMIL',ILONG,ITYLCM)
      IF((ILONG.EQ.0).AND.(NMIL*NMAC.GT.0)) THEN
         ALLOCATE(LOG(NMIL*NMAC))
         CALL XDLSET(LOG,NMIL*NMAC,.TRUE.)
         CALL LCMPUT(IPSAP,'LMAMIL',NMIL*NMAC,5,LOG)
         DEALLOCATE(LOG)
      ENDIF
      CALL LCMSIX(IPSAP,' ',2)
*
      IF(IMPX.GT.0) THEN
         WRITE(6,400) IMPX,(IDATA(I),I=1,17)
         WRITE(6,410) (IDATA(I),I=18,33)
      ENDIF
      RETURN
*----
*  SAPHYB CONCATENATION.
*----
  360 CALL LCMGET(IPRHS,'DIMSAP',IDATA)
      IF(IMPX.GT.0) WRITE(6,470) NCALS+1,NCALS+IDATA(19)
*     ------------------------------------------------------
      CALL SAPCAT(IPSAP,IPRHS,NORIG,NPAR,MUPLET,LGNEW,LWARN)
*     ------------------------------------------------------
*
      IF(IMPX.GT.0) THEN
         CALL LCMGET(IPSAP,'DIMSAP',IDATA)
         WRITE(6,400) IMPX,(IDATA(I),I=1,17)
         WRITE(6,410) (IDATA(I),I=18,33)
      ENDIF
      RETURN
*
  400 FORMAT(/19H SAP: DIMSAP VALUES/1X,19(1H-)/
     1 7H IMPX  ,I7,22H  (0=NO PRINT/1=SHORT)/
     2 7H NCOMLI,I7,43H  (NB. OF COMMENT LINES IN RECORD 'COMMEN')/
     3 7H NISOTA,I7,48H  (NB. OF ISOTOPES IN THE REFERENCE CALCULATION)/
     4 7H NCHANN,I7,34H  (NB. OF RADIOACTIVE DECAY TYPES)/
     5 7H NREA  ,I7,43H  (NB. OF REQUESTED NUCLEAR REACTION TYPES)/
     6 7H NISO  ,I7,44H  (NB. OF PARTICULARIZED ISOTOPES IN SAPHYB)/
     7 7H NMAC  ,I7,40H  (NB. OF MACROSCOPIC XS SETS IN SAPHYB)/
     8 7H NMIL  ,I7,29H  (NB. OF MIXTURES IN SAPHYB)/
     9 7H NPAR  ,I7,28H  (NB. OF GLOBAL PARAMETERS)/
     1 7H NPCHR ,I7,47H  (NB. OF GLOBAL PARAMETERS LINKED TO ISOTOPES)/
     2 7H NPPNT ,I7,48H  (NB. OF GLOBAL PARAMETERS LINKED TO LIBRARIES)/
     3 7H NLOC  ,I7,26H  (NB. OF LOCAL VARIABLES)/
     4 7H NPCHRL,I7,45H  (NB. OF LOCAL VARIABLES LINKED TO ISOTOPES)/
     5 7H NPPNTL,I7,46H  (NB. OF LOCAL VARIABLES LINKED TO LIBRARIES)/
     6 7H NISOF ,I7,42H  (NB. OF PARTICULARIZED FISSILE ISOTOPES)/
     7 7H NISOP ,I7,42H  (NB. OF PARTICULARIZED FISSION PRODUCTS)/
     8 7H NMGY  ,I7,36H  (NB. OF FISSION YIELD MACROGROUPS)/
     9 7H NVP   ,I7,45H  (NB. OF NODES IN THE GLOBAL PARAMETER TREE))
  410 FORMAT(7H NADRX ,I7,31H  (NB. OF ADDRESS SETS IN ADRX)/
     1 7H NCALS ,I7,34H  (NB. OF ELEMENTARY CALCULATIONS)/
     2 7H NG    ,I7,34H  (NB. OF ENERGY GROUPS IN SAPHYB)/
     3 7H NISOY ,I7,42H  (NB. OF FISSION YIELDS SETS PER MIXTURE)/
     4 7H NVERS ,I7,40H  (VERSION OF SAPHYB SPECIFICATION USED)/
     5 7H NFACES,I7,44H  (NB. OF SURFACES SURROUNDING THE GEOMETRY)/
     6 7H NSURFS,I7,35H  (NB. OF SURFACES IN THE GEOMETRY)/
     7 7H NRINGS,I7,27H  (RELATED TO THE GEOMETRY)/
     8 7H NCASE ,I7,27H  (RELATED TO THE GEOMETRY)/
     9 7H NCOORD,I7,33H  (NB. OF MESHES IN THE GEOMETRY)/
     1 7H NRT   ,I7,45H  (NB. OF UNKNOWNS IN THE REFERENCE GEOMETRY)/
     2 7H NSURFT,I7,47H  (NB. OF SURFACES IN THE HOMOGENIZED GEOMETRY)/
     3 7H NGA   ,I7,43H  (NB. OF GROUPS IN THE REFERENCE GEOMETRY)/
     4 7H NPRC  ,I7,43H  (NB. OF DELAYED NEUTRON PRECURSOR GROUPS)/
     5 7H NISOTS,I7,36H  (NB. OF ISOTOPES IN OUTPUT TABLES)/
     6 7H NMINLR,I7,47H  (NB. OF OUTPUT MIXTURES WITH DELAYED NEUTRON ,
     7 5HDATA))
  420 FORMAT(/1X,40(1H*)/34H * SAP: ELEMENTARY CALCULATION NB.,I5,
     1 2H */1X,40(1H*))
  430 FORMAT(/41H SAP: 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(28H SAP: SET GLOBAL PARAMETER ',A,3H' =,1P,E12.4)
  450 FORMAT(28H SAP: SET GLOBAL PARAMETER ',A,3H' =,I10)
  460 FORMAT(28H SAP: SET GLOBAL PARAMETER ',A,5H' = ',A12,1H')
  470 FORMAT(/1X,49(1H*)/35H * SAP: ELEMENTARY CALCULATIONS NB.,I5,
     1 3H TO,I5,2H */1X,49(1H*))
      END
