C FIONI     SOURCE    CB215821  20/11/25    13:28:57     10792          
      SUBROUTINE FIONI
C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C               OPERATEUR FION
C
C           CALCULE LA FORCE IONIQUE D'UNE SOLUTION CHIMIQUE
C          UTILISE LES RESULTATS DE CHI1
C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)

-INC PPARAM
-INC CCOPTIO
-INC SMLENTI
-INC SMLMOTS
-INC SMCHPOI
-INC SMELEME
      POINTEUR MLAA.MLREEL,MLOGK.MLREEL,MLFF.MLREEL
      POINTEUR MLIDX.MLENTI,MLIDY.MLENTI,MLIDZ.MLENTI,MLIDP.MLENTI
      POINTEUR MLNN.MLENTI,MLDECY.MLENTI
      POINTEUR MLIONZ.MLENTI,MLPREC.MLENTI
      POINTEUR MLNAME.MLMOTS,MLNESP.MLMOTS
      POINTEUR MLSOLU.MLENTI,MMSOLU.MLMOTS
      POINTEUR MCHFIO.MCHPOI,ICHFIO.MPOVAL
      CHARACTER*8 TYPEMA
      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 SP2
           REAL*8 GX(NXDIM),XX(NXDIM),GS(NZDIM),SS(NZDIM)
           REAL*8 TOT(NXDIM),TOTAQ(NXDIM),TOTFIX(NXDIM),GKS(NZDIM)
           REAL*8 YY(NXDIM),ZZ(NXDIM,NXDIM),CC(NYDIM),GC(NYDIM)
      ENDSEGMENT
      SEGMENT IZBID
            INTEGER IBID(NSOL)
      ENDSEGMENT
C

C
C                       LECTURE DE LA TABLE CHIMI1
      CALL CHMDEB(MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLIDP,MLNN,MLDECY,
     * MLNAME,MLIONZ,ITIDEN,ITREDO,ITEMPE,MLNESP)
      IF(IERR.NE.0)RETURN
C
C                 LECTURE DE LA TABLE IDEN
C      TOUS LES SEGMENTS REVIENNENT ACTIFS OU AVEC UN POINTEUR NUL
C
      CALL CHMIDE(ITIDEN,MLCOMP,MLSOLU,MMSOLU,MLPREC,MMPREC,MLSURF,
     *     MMSURF,MLTYP3,MMTYP3,MLTYP6,MMTYP6,MLPARF,MLREAC,MLIMMO,
     *     MLPOLE,MMPOLE,MLSOSO,MMSOSO,LIMP3)
       IF(IERR.NE.0)RETURN
C
C       LECTURE DU CHPOIN DES CONCENTRATIONS
C
      CALL LIROBJ('CHPOINT',MCHPOI,0,IRETOU)
      IF(IRETOU.EQ.0)THEN
      CALL ERREUR(21)
      RETURN
      ENDIF
      SEGACT MCHPOI
      NSOUPO=IPCHP(/1)
      IF(NSOUPO.NE.1)THEN
           CALL ERREUR(21)
            RETURN
      ENDIF
      MSOUPO=IPCHP(1)
      SEGACT MSOUPO
      MELEME=IGEOC
      MPOVAL=IPOVAL
      NC=NOCOMP(/2)
      NSOL=MLSOLU.LECT(/1)
      SEGINI IZBID
      DO 20 I=1,NSOL
           DO 25 J=1,NC
           IF(MMSOLU.MOTS(I).EQ.NOCOMP(J))THEN
               IBID(I)=J
               GO TO 22
           ENDIF
   25      CONTINUE
            CALL ERREUR(21)
            RETURN
   22      CONTINUE
   20 CONTINUE
      SEGACT MPOVAL
      NPN=VPOCHA(/1)

C
C                         ON ACTIVE LES SEGMENTS
C              ET ON DEFINIT LES TABLEAUX DE TRAVAIL
      SEGACT MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLNN,MLDECY,MLNAME,MLNESP
      SEGACT MLIONZ,MLIDP
      NXDIM=MLIDX.LECT(/1)
      NYDIM=MLIDY.LECT(/1)
      NZDIM=MLIDZ.LECT(/1)
      NPDIM=MLIDP.LECT(/1)
      SEGINI IDSCHI
      SEGINI SP2
C
      JGM=1
      JGN=4
      SEGINI MLMOTS
      MOTS(1)='SCAL'
      CALL CHMCRC(MLMOTS,MELEME,NPN,MCHFIO,ICHFIO)
      SEGSUP MLMOTS
C
C                           INITIALISATION
      SEGACT MELEME
C
C -------------------------------------------------------------------
C                         BOUCLE SUR LES POINTS
C -------------------------------------------------------------------
      DO 100 II=1,NPN
C                   CHARGEMENT DE IDSCHI
      CALL CHMIDS(MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLIDP,MLNN,MLDECY,
     * MLNAME,MLIONZ,IDSCHI,MLNESP)
C     WRITE(6,*)' GK apres CHMIDS '
C     WRITE(6,120)(GK(J),IDY(J),J=1,NYDIM)
  120 FORMAT(6(1X,1PD12.5,I5))
C                   CHARGEMENT DE SP2
      DO 6 J=1,NXDIM
            TOT(J)= 0.D0
            GX(J)= 0.D0
            XX(J)=0.D0
            TOTAQ(J)=0.D0
            TOTFIX(J)=0.D0
            YY(J)=0.D0
    6 CONTINUE
      CALL INITD(GC,NYDIM,0.D0)
      CALL INITD(CC,NYDIM,0.D0)
      DO 30 I=1,NSOL
           CC(I)=VPOCHA(II,IBID(I))
   30 CONTINUE
C
C= REMISE A ZERO DES FORCES IONIQUES
C
      XMUNEW  = 0.D0
      CALL CHMION(IDSCHI,SP2,XMUNEW)
         ICHFIO.VPOCHA(II,1)= XMUNEW
  100 CONTINUE
C   --------------------------------------------------------------
C                      LE MENAGE
C
      SEGSUP IDSCHI
      SEGSUP SP2,IZBID
C
C                   ON DESACTIVE LES DONNEES
      SEGDES MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLNN,MLDECY,MLNAME,MLNESP
       SEGDES MLIONZ,MLIDP
      SEGDES MELEME
       MLENTI=MLCOMP
       SEGDES MLENTI
       IF(MLSOSO.NE.0)THEN
          MLENTI=MLSOSO
          MLMOTS=MMSOSO
          SEGDES MLENTI,MLMOTS
       ENDIF
       IF(MLPOLE.NE.0)THEN
          MLENTI=MLPOLE
          MLMOTS=MMPOLE
          SEGDES MLENTI,MLMOTS
       ENDIF
       IF(MLSOLU.NE.0)THEN
             MLENTI=MLSOLU
             MLMOTS=MMSOLU
             SEGDES MLENTI,MLMOTS
       ENDIF
       IF(MLPREC.NE.0)THEN
             MLENTI=MLPREC
             MLMOTS=MMPREC
             SEGDES MLENTI,MLMOTS
       ENDIF
       IF(MLSURF.NE.0)THEN
             MLENTI=MLSURF
             MLMOTS=MMSURF
             SEGDES MLENTI,MLMOTS
       ENDIF
       IF(MLTYP3.NE.0)THEN
             MLENTI=MLTYP3
             MLMOTS=MMTYP3
             SEGDES MLENTI,MLMOTS
       ENDIF
       IF(MLTYP6.NE.0)THEN
             MLENTI=MLTYP6
             MLMOTS=MMTYP6
             SEGDES MLENTI,MLMOTS
       ENDIF
       IF(MLPARF.NE.0)THEN
             MLENTI=MLPARF
             SEGDES MLENTI
       ENDIF
       IF(MLREAC.NE.0)THEN
             MLENTI=MLREAC
             SEGDES MLENTI
       ENDIF
       IF(MLIMMO.NE.0)THEN
             MLENTI=MLIMMO
             SEGDES MLENTI
       ENDIF
      SEGDES MSOUPO,MPOVAL,MCHPOI
C
C                   ON SAUVE LE RESULTAT
      CALL ECROBJ('CHPOINT',MCHFIO)
      MSOUPO=MCHFIO.IPCHP(1)
      SEGDES ICHFIO,MCHFIO,MSOUPO
      RETURN
      END