C CHIMI1    SOURCE    CHAT      05/01/12    21:57:28     5004           
      SUBROUTINE CHIMI1
C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C               OPERATEUR CHI1 
C
C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC CCOPTIO
-INC SMTABLE
-INC SMLENTI
-INC SMTEXTE
      SEGMENT IDSCHI
           REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)
           INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)
           INTEGER IDECY(NYDIM),IONZ(NXDIM)
           CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)
      ENDSEGMENT
      SEGMENT IZIADR
            INTEGER IADR(NCR)
      ENDSEGMENT
      POINTEUR MLIDEN.MLENTI
      CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR
      CHARACTER*72 CHARB,CHARL,CHART
      LOGICAL LTEMPE,LOGIR,LOGRE
C
      MLENT3=0
      LIMP3=0
      IRETOU=0
      MTAB1=0
      CALL LIROBJ('TABLE',MTAB1,0,IRETOU)
      IF(IRETOU.EQ.0)THEN
      CALL LIROBJ('OBJET',MTAB1,1,IRETOU)
*      write(6,*)' mtab1 ',mtab1
      IF(IRETOU.EQ.0)RETURN
      ENDIF
C                          ON LIT LES ADRESSES DE LA BASE DE DONNEE
      IOCHI1=0
      IOCHI2=0
      IOCHI3=0
      LBB=0
      LBL=0
      LBT=0
      DO 10 I=1,3
          CALL LIRCHA(CHARR,0,IRETOU)
          IF(IRETOU.EQ.0)GO TO 11
          IF(CHARR(1:6).EQ.'COMP')THEN
              CALL LIRENT(IVAL,0,IRETOU)
              IF(IRETOU.EQ.1)IOCHI1=IVAL
              CALL LIRCHA(CHARB,0,LBB)
          ELSEIF(CHARR(1:4).EQ.'LOGK')THEN
              CALL LIRENT(IVAL,0,IRETOU)
              IF(IRETOU.EQ.1)IOCHI2=IVAL
              CALL LIRCHA(CHARL,0,LBL)
          ELSEIF(CHARR(1:4).EQ.'ENTH')THEN
              CALL LIRENT(IVAL,0,IRETOU)
              IF(IRETOU.EQ.1)IOCHI3=IVAL
              CALL LIRCHA(CHART,0,LBT)
          ELSE
              MOTERR(1:6)='COMP'
              CALL ERREUR(396)
              RETURN
          ENDIF
   10 CONTINUE
   11 CONTINUE
      IF(IOCHI1.EQ.0)THEN
          IF(LBB.EQ.0)THEN
              MOTERR(1:4)='COMP'
              CALL ERREUR(396)
              RETURN
          ELSE
              IOCHI1=80
          ENDIF
      ENDIF
      IF(LBB.NE.0)THEN
            CALL CHIDBD(IOCHI1,CHARB)
      ENDIF
      IF(LBL.NE.0)THEN
            IF(CHARB(1:LBB).EQ.CHARL(1:LBL))THEN
                  IOCHI2=IOCHI1
            ELSE
                  IF(IOCHI2.EQ.0)IOCHI2=IOCHI1+1
                  CALL CHIDBD(IOCHI2,CHARL)
            ENDIF
      ELSE
            IF(IOCHI2.EQ.0)IOCHI2=IOCHI1
      ENDIF
      IF(LBT.NE.0)THEN
            IF(CHART(1:LBT).EQ.CHARL(1:LBL))THEN
                  IOCHI3=IOCHI2
            ELSE
                  IF(IOCHI3.EQ.0)IOCHI3=IOCHI2+1
                  CALL CHIDBD(IOCHI3,CHART)
            ENDIF
      ELSE
      ENDIF
C
      SEGACT MTAB1
      IVALI=1
      XVALI=0.D0
      IRETI=0
      IVALR=0
      XVALR=0.D0
      IRETR=0
      MTYPI='MOT     '
      MTYPR='LISTENTI'
      CHARR='        '
      CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'IDEN',.TRUE.,IRETI,
     * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
      IF(IERR.NE.0)RETURN
      MLIDEN=IRETR
      SEGACT MLIDEN
      NLIDEN=MLIDEN.LECT(/1)
      SEGDES MLIDEN
      LXMX=0
      IVALI=1
      XVALI=0.D0
      IRETI=0
      IVALR=0
      XVALR=0.D0
      IRETR=0
      MTYPI='MOT     '
      MTYPR='        '
      CHARR='        '
      CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'CHXMX',.TRUE.,IRETI,
     * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
      IF(MTYPR.NE.'        ')THEN
            IF(MTYPR.NE.'LISTENTI')THEN
                 MOTERR(1:11)='CHXMX      '
                 MOTERR(12:20)='LISTENTI'
                 CALL ERREUR(627)
                 RETURN
            ENDIF
            LXMX=IRETR
      ENDIF
      LBDD=0
      IVALI=1
      XVALI=0.D0
      IRETI=0
      IVALR=0
      XVALR=0.D0
      IRETR=0
      MTYPI='MOT     '
      MTYPR='        '
      CHARR='        '
      CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'BDD',.TRUE.,IRETI,
     * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
      IF(MTYPR.NE.'        ')THEN
            IF(CHARR.EQ.'MINEQL  ')THEN
                 LBDD=0
            ELSEIF(CHARR.EQ.'STRASBG  ')THEN
                 LBDD=1
            ELSE
                 MOTERR(1:11)='BDD        '
                 MOTERR(12:20)='CONNU   '
                 CALL ERREUR(627)
                 RETURN
            ENDIF
      ENDIF
      CALL CHILEC(LBDD,MLIDEN,LXMX,IDSCHI,IOCHI1,IOCHI2)
      IF(IERR.NE.0)RETURN
C                  ON GARDE LA LISTE DES ESPECES SIMPLES DE TYPE 3
      CALL CHITR1(IDSCHI,IZIADR,IADH,LBDD)
*      WRITE(6,*)'CHILEC et CHITRI faits' 
C
      IVALI=0
      XVALI=0.D0
      IRETI=0
      IVALR=0
      XVALR=0.D0
      IRETR=0
      MTYPI='MOT     '
      MTYPR='        '
      CHARR='        '
      NVCOMP=0
      CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'NVCOMP',.TRUE.,IRETI,
     * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
      IF(MTYPR.NE.'        ')THEN
            IF((MTYPR.NE.'TABLE   ').AND.(MTYPR.NE.'OBJET   '))THEN
                 MOTERR(1:11)='NVCOMP     '
                 MOTERR(12:20)='TABLE   '
                 CALL ERREUR(627)
                 RETURN
            ENDIF
      NVCOMP=IRETR
      CALL CHICMP(NVCOMP,IDSCHI)
      IF(IERR.NE.0)RETURN
      ENDIF
      IVALI=0
      XVALI=0.D0
      IRETI=0
      IVALR=0
      XVALR=0.D0
      IRETR=0
      MTYPI='MOT     '
      MTYPR='        '
      CHARR='        '
      NVESP=0
      CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'NVESP',.TRUE.,IRETI,
     * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
      IF(MTYPR.NE.'        ')THEN
            IF((MTYPR.NE.'TABLE   ').AND.(MTYPR.NE.'OBJET   '))THEN
                 MOTERR(1:11)='NVESP      '
                 MOTERR(12:20)='TABLE   '
                 CALL ERREUR(627)
                 RETURN
            ENDIF
      NVESP=IRETR
      CALL CHIESP(NVESP,IDSCHI)
      ENDIF
      IVALI=0
      XVALI=0.D0
      IRETI=0
      IVALR=0
      XVALR=0.D0
      IRETR=0
      MTYPI='MOT     '
      MTYPR='        '
      CHARR='        '
      NVSOSO=0
*      write(6,*)' mtab1 ',mtab1
      CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'NVSOSO',.TRUE.,IRETI,
     * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
      IF(MTYPR.NE.'        ')THEN
            IF((MTYPR.NE.'TABLE   ').AND.(MTYPR.NE.'OBJET   '))THEN
                 MOTERR(1:11)='NVSOSO     '
                 MOTERR(12:20)='TABLE   '
                 CALL ERREUR(627)
                 RETURN
            ENDIF
      NVSOSO=IRETR
*      WRITE(6,*)'CHIMI1, NVSOSO=',NVSOSO
      CALL CHISOL(NVSOSO,IDSCHI)
      ENDIF      
      IVALI=0
      XVALI=0.D0
      IRETI=0
      IVALR=0
      XVALR=0.D0
      IRETR=0
      MTYPI='MOT     '
      MTYPR='        '
      CHARR='LISTENTI'
      IZECH=0
      CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'ECHANGE',.TRUE.,IRETI,
     * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
      IF(MTYPR.NE.'        ')THEN
      IZECH=IRETR
      CALL CHIECH(IZECH,IDSCHI)
      ENDIF
      IVALI=0
      XVALI=0.D0
      IRETI=0
      IVALR=0
      XVALR=0.D0
      IRETR=0
      MTYPI='MOT     '
      MTYPR='        '
      CHARR='TABLE'
      ICLIM=0
      MLENT=0 
      CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'CLIM',.TRUE.,IRETI,
     * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
      IF(MTYPR.NE.'        ')THEN
      ICLIM=IRETR
      CALL CHICLM(ICLIM,IDSCHI,IZIADR,MLENT3,LIMP3)
      IF(IERR.NE.0)RETURN
      ENDIF
      LTEMPE=.FALSE.
      LTMP=1
      LOGIR=.TRUE.
      IVALI=1
      XVALI=0.D0
      IRETI=0
      IVALR=0
      XVALR=0.D0
      IRETR=0
      MTYPI='MOT     '
      MTYPR='        '
      CHARR='        '
      CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'TEMPERATURE',.TRUE.,IRETI,
     * MTYPR,IVALR,XVALR,CHARR,LOGIR,IRETR)
      IF(MTYPR.NE.'        ')THEN
            IF(CHARR.EQ.'OUI')THEN
                   LTEMPE=.TRUE.
            ELSEIF(CHARR.EQ.'NON')THEN
                   LTEMPE=.FALSE.
            ELSEIF(MTYPR.EQ.'ENTIER  ')THEN
                   LTEMPE=.TRUE.
                   LTMP=IVALR
                   IF((LTMP.NE.1).AND.(LTMP.NE.2))THEN
               MOTERR(1:40)='**********************TEMPERATURE       '
                       CALL ERREUR(-301)
                       CALL ERREUR(21)
                       RETURN
                   ENDIF
            ELSE
               MOTERR(1:40)='**********************TEMPERATURE       '
                   CALL ERREUR(-301)
                   CALL ERREUR(21)
                   RETURN
            ENDIF
      ENDIF
      IF(LTEMPE)THEN
          IF(IOCHI3.EQ.0)IOCHI3=IOCHI2
      ENDIF
      SEGDES MTAB1
C                   ON CREE LA TABLE RESULTAT
      CALL CRTABL(MTAB3)
      CALL ECCTAB(MTAB3,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,'MOT',
     *  0,0.D0,'CHIMI1',.TRUE.,0)
C                      TABLE DESCHI (DESCRIPTION)
      CALL CRTABL(MTAB2)
      CALL CHIDES(MTAB2,IDSCHI)
      CHARR='        '
      CALL ECCTAB(MTAB3,'MOT',0,0.D0,'DESCHI',.TRUE.,0,'TABLE',
     *  0,0.D0,CHARR,.TRUE.,MTAB2)
      SEGDES MTAB2
      MTAB2=0
      CALL CRTABL(MTAB1)
      CALL CHIRED(IDSCHI,MTAB1,MTAB2,IZIADR,IADH,MLENT3,LIMP3)
      IF(MLENT3.NE.0)THEN
                    SEGDES MLENT3
      ENDIF
      IF(IERR.NE.0)RETURN
      CHARR='        '
      CALL ECCTAB(MTAB3,'MOT',0,0.D0,'IDEN',.TRUE.,0,'TABLE',
     *  0,0.D0,CHARR,.TRUE.,MTAB1)
      SEGDES MTAB1
      IF(MTAB2.NE.0)THEN
            CHARR='        '
            CALL ECCTAB(MTAB3,'MOT',0,0.D0,'REDOX',.TRUE.,0,'TABLE',
     *        0,0.D0,CHARR,.TRUE.,MTAB2)
            SEGDES MTAB2
      ENDIF
      IF(LTEMPE)THEN
            CALL CRTABL(MTAB1)
            CALL CHITET(MTAB1,IDSCHI,LBDD,IOCHI3,LTMP)
            CHARR='        '
            CALL ECCTAB(MTAB3,'MOT',0,0.D0,'TEMPE',.TRUE.,0,'TABLE',
     *        0,0.D0,CHARR,.TRUE.,MTAB1)
            SEGDES MTAB1
      ENDIF
      REWIND(UNIT=IOCHI1)
      CLOSE(UNIT=IOCHI1)
      IF(IOCHI1.NE.IOCHI2)THEN
            REWIND(UNIT=IOCHI2)
            CLOSE(UNIT=IOCHI2)
      ENDIF
      IF((IOCHI3.NE.IOCHI2).AND.LTEMPE)THEN
            REWIND(UNIT=IOCHI3)
            CLOSE(UNIT=IOCHI3)
      ENDIF
      CALL ECROBJ('TABLE',MTAB3)
      SEGDES MTAB3
      SEGSUP IDSCHI
      RETURN
      END