C KRES11    SOURCE    GOUNAND   11/10/07    21:15:50     7149           
      SUBROUTINE KRES11(KMORS,KIZA,KTYP,ISMBR,
     $           KTYPI,ITER,RESID,ICALRS,IRSTRT,LBCG,BRTOL,IDDOT,IMVEC,
     $           KPREC,RXMILU,RXILUP,XLFIL,XDTOL,XSPIV,
     $           KTIME,LTIME,
     $           INCX,LRES,LNMV,ICVG,IMPR,INODET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : KRES11
C DESCRIPTION : - Construction du préconditionneur
C               - Appel des solveurs itératifs
C
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C VERSION    : v1, 29/08/2011, version initiale
C HISTORIQUE : v1, 29/08/2011, création
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
-INC CCOPTIO
-INC SMLENTI
      POINTEUR LNMV.MLENTI
      POINTEUR ATYP.MLENTI
-INC SMLREEL
      POINTEUR LRES.MLREEL
-INC SMMATRIK
      POINTEUR MAPREC.MATRIK
      POINTEUR AMORS.PMORS
      POINTEUR AISA.IZA
-INC SMVECTD
      POINTEUR ISMBR.MVECTD
      POINTEUR INCX.MVECTD
C     Tableau de correspondance : entier <-> mot
C     pour le type d'inversion
      INTEGER NBTYPI,LNTYPI
      PARAMETER (NBTYPI=16)
      PARAMETER (LNTYPI=18)
      CHARACTER*(LNTYPI) LTYPI(NBTYPI)
C     Tableau de correspondance : entier <-> mot
C     pour le type de préconditionnement (cas d'une méthode itérative)
      INTEGER NBPREC,LNPREC
      PARAMETER (NBPREC=11)
      PARAMETER (LNPREC=8)
      CHARACTER*(LNPREC) LPREC(NBPREC)
-INC SMTABLE
      POINTEUR KTIME.MTABLE
      DIMENSION ITTIME(6)
      CHARACTER*8 CHARI
      CHARACTER*1 CCOMP
      LOGICAL LTIME
C     
C Initialisation des tableaux
C     
      DATA LTYPI/'Choleski          ',
     $     'Conjugate Gradient',
     $     'BiCGSTAB G        ',
     $     'BiCGSTAB(l) G     ',
     $     'GMRES(m)          ',
     $     'CGS-Neumaier      ',
     $     'Multigrid FCG     ',
     $     'Multigrid GCR(m)  ',
     $     'Bi-CG             ',
     $     'CG old            ',
     $     'BiCGSTAB old      ',
     $     'GMRES(m) old      ',
     $     'CGS               ',
     $     'BiCGSTAB          ',
     $     'BiCGSTAB(l)       ',
     $     'BiCGSTAB(l)F      '/
      DATA LPREC/'None    ',
     $     'Jacobi  ',
     $     'D-ILU   ',
     $     'ILU(0)  ',
     $     'MILU(0) ',
     $     'ILUT    ',
     $     'ILUT2   ',
     $     'ILUTP   ',
     $     'ILUTP+0 ',
     $     'ILU0-PV ',
     $     'ILU0-PVf'/
*     
* Executable statements
*
*      WRITE(IOIMP,*) 'Entrée dans kres10.eso' 
      ICVG=0
*Debug      IF (KTYPI.EQ.1) KTYPI=3
      IF (KTYPI.LT.2.OR.KTYPI.GT.NBTYPI) THEN
         WRITE(IOIMP,*) 'KTYPI incorrect (2..',NBTYPI,') :',KTYPI
         GOTO 9999
      ENDIF
      IF (KPREC.LT.0.OR.KPREC.GT.NBPREC-1) THEN
         WRITE(IOIMP,*) 'PRECOND ',
     $           'incorrect (0..',NBPREC-1,') :',KPREC
         GOTO 9999
      ENDIF
C
C     Impressions
C
      IF (IMPR.GT.1) THEN
         IF (IDDOT.EQ.0) CCOMP=' '
         IF (IDDOT.EQ.1) CCOMP='c'
         IF (KTYPI.EQ.5.OR.KTYPI.EQ.8) THEN
            WRITE(IOIMP,*) CCOMP,LTYPI(KTYPI),' (m=',IRSTRT,')'
         ELSEIF (KTYPI.EQ.11.OR.KTYPI.EQ.12) THEN
            WRITE(IOIMP,*) CCOMP,LTYPI(KTYPI),' (l=',LBCG,')'
         ELSE
            WRITE(IOIMP,*) CCOMP,LTYPI(KTYPI)
         ENDIF
         IF (KPREC.EQ.4) THEN
            WRITE(IOIMP,110) ' ',LPREC(KPREC+1),' (r=',RXMILU,')'  
 110        FORMAT (3A,D9.2,A)
         ELSEIF (KPREC.GE.5.AND.KPREC.LE.6) THEN
            WRITE(IOIMP,111) ' ',LPREC(KPREC+1),' (lfil=',XLFIL,
     $           ' droptol=',XDTOL,')'  
 111        FORMAT (3A,D9.2,A,D9.2,A)
         ELSEIF (KPREC.GE.7.AND.KPREC.LE.8) THEN
            WRITE(IOIMP,112) ' ',LPREC(KPREC+1),' (lfil=',XLFIL,
     $           ' droptol=',XDTOL,' pivtol=',XSPIV,
     $           ')'  
 112        FORMAT (3A,D9.2,A,D9.2,A,D9.2,A,I4,A)
         ELSEIF (KPREC.EQ.10) THEN
            WRITE(IOIMP,110) ' ',LPREC(KPREC+1),' (r=',RXILUP,')'  
         ELSE
            WRITE(IOIMP,*) LPREC(KPREC+1)
         ENDIF
      ENDIF
      IF (LTIME) THEN
         CALL TIMESPV(ITTIME)
         ITI1=(ITTIME(1)+ITTIME(2))
      ENDIF
C 
C               - Construction du préconditionneur (repris sur kres5)
C
      SEGACT ISMBR
      INC=ISMBR.VECTBB(/1)
      NRIGE=0
      NMATRI=0
      NKID=9
      NKMT=7
      SEGINI MAPREC
      MAPREC.KNTTT=INC
      MAPREC.KSYM=2
      NTT=0
      NPT=0
      NBLK=0
      SEGINI IDMAT
      MAPREC.KIDMAT(1)=IDMAT
*
      IF (KPREC.EQ.1) THEN
         CALL MEIDIA(KMORS,KIZA,MAPREC,IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
      ELSEIF (KPREC.EQ.2) THEN
         CALL PRDILU(KMORS,KIZA,MAPREC,IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
      ELSEIF (KPREC.EQ.3) THEN
         CALL PRILU0(KMORS,KIZA,MAPREC,IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
      ELSEIF (KPREC.EQ.4) THEN
         CALL PRMILU(KMORS,KIZA,MAPREC,RXMILU,IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
      ELSEIF (KPREC.GE.5.AND.KPREC.LE.6) THEN
         IVARI=KPREC-5
         CALL PRILUT(KMORS,KIZA,MAPREC,XLFIL,XDTOL,IVARI,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
*            WRITE(IOIMP,*) 'PRILUT !'
*        ELSEIF (KPREC.GE.7.AND.KPREC.LE.9) THEN
      ELSEIF (KPREC.GE.7.AND.KPREC.LE.8) THEN
         WRITE(IOIMP,*) 'KPREC=',KPREC, 'non dispo'
         GOTO 9999
      ELSEIF (KPREC.EQ.9.OR.KPREC.EQ.10) THEN
         CALL PRILUP(KMORS,KIZA,MAPREC,RXILUP,KPREC-9,IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
      ELSEIF (KPREC.NE.0) THEN
         WRITE(IOIMP,*) 'Erreur de programmation'
         GOTO 9999
      ENDIF
      IF (LTIME) THEN
         CALL TIMESPV(ITTIME)
         ITI2=(ITTIME(1)+ITTIME(2))
      ENDIF
C      MATRIK=MAPREC
C      SEGACT MATRIK
C      nkid=kidmat(/1)
C      WRITE(IOIMP,*) 'Apres constr precon'
C      WRITE(IOIMP,*) '     MAPREC KIDMAT NKID=',nkid
C      WRITE(IOIMP,2020) (KIDMAT(II),II=1,KIDMAT(/1))
C 2020 FORMAT (20(2X,I12) )      
C
C               - Appel des solveurs itératifs
C  Apparemment, le segment MATRIK ne sert qu'à vérifier la symétrie
C  et à construire INCTYP pour le multigrille
C
      NRIGE=0
      NMATRI=0
      NKID=0
      NKMT=0
      SEGINI MATRIK
      IF (KTYPI.NE.2) KSYM=2
      SEGACT ISMBR
      INC=ISMBR.VECTBB(/1)
      SEGINI INCX
      KS2B=ISMBR
      AMORS=KMORS
      AISA=KIZA
      ATYP=KTYP
*
      IF (KTYPI.EQ.2) THEN
         CALL PRCG2(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX,
     $        ITER,INMV,RESID,KPREC,BRTOL,ICALRS,IDDOT,IMVEC,
     $        IMPR,IRET)
      ELSEIF (KTYPI.EQ.3) THEN
         LBCG=1
         CALL PRBCGG(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX,
     $        ITER,INMV,RESID,KPREC,BRTOL,LBCG,ICALRS,IDDOT,IMVEC,
     $        IMPR,IRET)
      ELSEIF (KTYPI.EQ.4) THEN
         CALL PRBCGG(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX,
     $        ITER,INMV,RESID,KPREC,BRTOL,LBCG,ICALRS,IDDOT,IMVEC,
     $        IMPR,IRET)
      ELSEIF (KTYPI.EQ.5) THEN
C         WRITE(IOIMP,*) 'ITER=',ITER
C         WRITE(IOIMP,*) 'INMV=',INMV
C         WRITE(IOIMP,*) 'RESID=',RESID
C         WRITE(IOIMP,*) 'KPREC=',KPREC
C         WRITE(IOIMP,*) 'IRSTRT=',IRSTRT
C         WRITE(IOIMP,*) 'ICALRS=',ICALRS
C         WRITE(IOIMP,*) 'IDDOT=',IDDOT
         CALL PRGMR2(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX,
     $        ITER,INMV,RESID,KPREC,IRSTRT,ICALRS,IDDOT,IMVEC,
     $        IMPR,IRET)
      ELSEIF (KTYPI.EQ.6) THEN
         CALL PRCGSN(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX,
     $        ITER,INMV,RESID,KPREC,BRTOL,ICALRS,IDDOT,IMVEC,
     $        IMPR,IRET)
      ELSEIF (KTYPI.EQ.7) THEN
*            WRITE(IOIMP,*) 'Appel de pragmg'
         CALL PRAGMG(AMORS,ATYP,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,
     $        INCX,
     $        ITER,INMV,RESID,KPREC,1,ICALRS,IDDOT,IMVEC,KTIME,LTIME,
     $        IMPR,IRET)
         SEGSUP ATYP
      ELSEIF (KTYPI.EQ.8) THEN
         CALL PRAGMG(AMORS,ATYP,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,
     $        INCX,
     $        ITER,INMV,RESID,KPREC,IRSTRT,ICALRS,IDDOT,IMVEC,KTIME,
     $        LTIME,
     $        IMPR,IRET)
         SEGSUP ATYP
      ELSEIF (KTYPI.EQ.9) THEN
         CALL PRBCG(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX,
     $        ITER,INMV,RESID,KPREC,BRTOL,ICALRS,IDDOT,IMVEC,
     $        IMPR,IRET)
      ELSE
         WRITE(IOIMP,*) 'KTYPI=',KTYPI,' invalide (1..',NBTYPI,')'
         GOTO 9999
      ENDIF
C  IRET<0 : 'vrai erreur' ou breakdown (dans le cas de BiCGSTAB)
C  IRET>0 : l'itération n'a pas convergé mais on veut
C           quand meme la solution calculée
      ICVG=IRET
      IF (IRET.GT.0) THEN
         WRITE(IOIMP,*) 'Convergence to tolerance not achieved : ',
     $        'ITER=',ITER,' INMV=',INMV,' RESID=',RESID
      ELSEIF (IRET.EQ.0) THEN
         IF (IMPR.GT.0) THEN
            WRITE(IOIMP,*) 'ITER=',ITER,' INMV=',INMV,' RESID=',RESID
         ENDIF
      ELSEIF (IRET.LT.0) THEN
         WRITE(IOIMP,*) 'Error or breakdown in iterative method'
         GOTO 9999
      ELSE
         WRITE(IOIMP,*) 'KTYPI=',KTYPI,' invalide (1..',NBTYPI,')'
         GOTO 9999
      ENDIF
      SEGSUP MATRIK
      IF (LTIME) THEN
         CALL TIMESPV(ITTIME)
         ITI3=(ITTIME(1)+ITTIME(2))
         ITP=ITI2-ITI1
         ITR=ITI3-ITI2
         CHARI='PRECONDI'
         CALL ECCTAB(KTIME,'MOT     ',IVALI,XVALI,CHARI,LOGII,IRETI,
     $        'ENTIER  ',ITP,XVALR,CHARR,LOGIR,IRETR)
         CHARI='RESOLUTI'
         CALL ECCTAB(KTIME,'MOT     ',IVALI,XVALI,CHARI,LOGII,IRETI,
     $        'ENTIER  ',ITR,XVALR,CHARR,LOGIR,IRETR)
      ENDIF
C
C     Destruction du préconditionneur
C
      SEGACT MAPREC
      IDMAT=MAPREC.KIDMAT(1)
      IF (IDMAT.NE.0) THEN
         SEGACT IDMAT
         IZA=IDIAG
         SEGSUP IZA
         SEGSUP IDMAT
      ENDIF
      PMORS=MAPREC.KIDMAT(6)
      IF (PMORS.NE.0) SEGSUP PMORS
      IZA=MAPREC.KIDMAT(7)
      IF (IZA.NE.0) SEGSUP IZA
      SEGSUP MAPREC
C
C     Destruction de la matrice Morse
C
      IF (INODET.EQ.0) THEN
         SEGSUP AMORS
         SEGSUP AISA
      ENDIF
*
* Normal termination
*
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      MOTERR(1:8)='KRES11  '
      CALL ERREUR(349)
      RETURN
*
* End of subroutine KRES11
*
      END