Télécharger prkres.eso

Retour à la liste

prkres
C PRKRES    SOURCE    GOUNAND   25/04/30    21:15:34     12258          
      SUBROUTINE PRKRES(MATRIK,MTINV,IMPR,KCLIM,KSMBR,KTYPI,MATASS,
     $     MAPREC,
     $     MRENU,MMULAG,ISCAL,INORMU,IOUBL,IMPINV,MCHINI,ITER,RESID,
     $     BRTOL,IRSTRT,KPREC,RXMILU,RXILUP,XLFIL,XDTOL,XSPIV,LBCG,
     $     ICALRS,METASS,LTIME,NELIM,MRIGID,IDDOT,IMVEC,IORINC,MLAG1
     $     ,MLAG2,LDUMP,ISMOOT,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : PRKRES
C DESCRIPTION :
C  Lecture des arguments et mise à défaut des optionnels ()
C
C  MATRIK : La matrice lue en entrée au format MATRIK
C  MTINV  : L'éventuelle table d'inversion (obsolète)
C  IMPR   : Niveau d'impression solveur direct
C  KCLIM  : Chpoint éventuel de conditions aux limites de Dirichlet
C  KSMBR  : Chpoint second membre
C  KTYPI  : Type de méthode de résolution
C  MATASS : Matrice utilisée pour préconditionner l'assemblage
C  MAPREC : Matrice utilisée pour préconditionner la construction du
C           préconditionneur
C  MRENU  : Type de renumérotation
C  MMULAG : Placement des multiplicateurs de Lagrange
C  ISCAL  : Scaling de la matrice
C  INORMU : Mise à l'échelle des multiplicateurs de Lagrange
C  IOUBL  : Oubli des matrices élémentaires ?
C  IMPINV : Niveau d'impression solveur itératif
C  MCHINI : Chpoint estimation de l'inconnue
C  ITER   : Nombre maxi d'itérations à effectuer
C  RESID  : Norme L2 maxi du résidu
C  BRTOL  : Breakdown tolerance pour les méthodes de type Bi-CG
C  IRSTRT : Paramètre m de redémarrage pour GMRES
C  KPREC  : Type du préconditionneur
C  RXMILU : Paramètre de relaxation pour MILU(0)
C  RXILUP : Paramètre de filtre pour ILU(0)-PV
C  XLFIL  : Paramètre de remplissage pour les préconditionneurs ILUT
C  XDTOL  : Drop tolerance pour les préconditionneurs ILUT
C  XSPIV  : Sensibilité du pivoting pour les préconditionneurs ILUTP
C  LBCG   : le l dans BicgStab(l)
C  ICALRS : façon de calculer le résidu
C  METASS : méthode d'assemblage (obsolete)
C  LTIME  : construit une table avec des statistiques temporelles
C           si vrai
C  NELIM  : nombre de passes d'elimination
C           Par defaut : 2
C  IDDOT  : 0 => utilisation du produit scalaire normal dans les
C                méthodes itératives
C           1 => utilisation du produit scalaire compensé
C  IMVEC  : 0, pas de parallélisme pour les produits matrice-vecteur
C           1, parallélisme stratégie 1, entrelace les lignes.
C           2, parallélisme stratégie 2, groupe les lignes.
C           Par defaut : 2
C  IORINC : pointeur sur une LISTE de LISTMOTS indiquant quels noms
C     d'inconnues pour chaque bloc pour AGMG par blocs
C     Par defaut : 0
C  MLAG1  : pointeur sur un LISTMOTS indiquant les noms d'inconnues a
C     traiter comme des multiplicateurs de Lagrange, à placer après les
C     inconnues en relation
C     Par defaut : 0
C  MLAG2  : pointeur sur un LISTMOTS indiquant les noms d'inconnues a
C     traiter comme des multiplicateurs de Lagrange, à placer avant les
C     inconnues en relation
C     Par defaut : 0
C  LDUMP  : LOGIQUE valant vrai si on sort les informations completes
C     de resolution du systeme lineaire par AGMG en fichiers ASCII.
C  ISMOOT : smoother pour AGMG bloc (7 ou 8)
C           0 : Gauss-Seidel si symétrique
C               SOR(omega_calc) sinon
C          -1 : SOR(0.7) adéquat pour éléments quadratiques.
C           1 : GS
C           2 : ILU
C          -2 : ILU(0.7)
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES          :
C APPELES (E/S)    :
C APPELES (BLAS)   :
C APPELES (CALCUL) :
C APPELE PAR       :
C***********************************************************************
C SYNTAXE GIBIANE    :
C ENTREES            :
C ENTREES/SORTIES    :
C SORTIES            :
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 22/02/2006, version initiale
C HISTORIQUE : v1, 22/02/2006, création
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
C Prière de PRENDRE LE TEMPS de compléter les commentaires
C en cas de modification de ce sous-programme afin de faciliter
C la maintenance !
C***********************************************************************
-INC CCREEL
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
      POINTEUR KCLIM.MCHPOI
      POINTEUR KSMBR.MCHPOI
      POINTEUR MCHINI.MCHPOI
      POINTEUR MCHSOL.MCHPOI
-INC SMTABLE
      POINTEUR MTINV.MTABLE
*-INC SMMATRIK
*      POINTEUR MAPREC.MATRIK
*      POINTEUR MATASS.MATRIK
-INC SMRIGID
-INC SMELEME
-INC SMLOBJE
      POINTEUR IORINC.MLOBJE
*
      INTEGER KTYPI,ISCAL,INORMU,IOUBL,IMPINV,ITER,IRSTRT,KPREC
      REAL*8 RESID,BRTOL,RXMILU,RXILUP,XLFIL,XDTOL,XSPIV
      CHARACTER*4 MRENU,MMULAG
*
      CHARACTER*8 TYPI,TYPR,TYP2,BLAN,TYPE,MTYP,TYPOBL,TYPOBA
      CHARACTER*8 TYTABL,TYLMOT,TYCHPO,TYMOT,TYENT,TYFLO,TYLENT
      CHARACTER*8 TYMATK,TYRIGI,INDTAB,TYLOG
*
      INTEGER IBID,IVAL,IOBJ
      REAL*8 XBID,XVAL
      CHARACTER*4 CBID,CVAL
      LOGICAL LBID,LVAL,LTIME,LMRENU,LMETAS,LDEPE,LLDEPE,LDUMP
      LOGICAL LMUANO,LNORMA
*
      INTEGER IMPR,IRET
      PARAMETER (NMOT=36)
      CHARACTER*8 MOTSCL(NMOT),TYARG(NMOT)
C     CALL PRKRES(MATRIK,MTINV,IMPR,KCLIM,KSMBR,KTYPI,MATASS,MAPREC,
C    $     MRENU,MMULAG,ISCAL,INORMU,IOUBL,IMPINV,MCHINI,ITER,RESID,BRTOL,
C    $     IRSTRT,KPREC,RXMILU,XLFIL,XDTOL,XSPIV,IMPR,IRET)
      DATA MOTSCL/
     $     'IMPR    ','TYPI    ','CLIM    ','SMBR    ','TYPINV  ',
     $     'MATASS  ','MAPREC  ','TYRENU  ','PCMLAG  ','SCALING ',
     $     'SCALAG  ',
     $     'OUBMAT  ','IMPINV  ','XINIT   ','NITMAX  ','RESID   ',
     $     'BCGSBTOL','GMRESTRT','PRECOND ','MILURELX','ILUTLFIL',
     $     'ILUTDTOL','ILUTPPIV','LBCG    ','CALRES  ','METASS  ',
     $     'LTIME   ','ELIM    ','ILUPRELX','IDDOT   ','IMVEC   ',
     $     'ORDINC  ','LAGR1   ','LAGR2   ','DUMP    ','SMOOTHER'/
      DATA TYARG/
     $     'ENTIER  ','TABLE   ','CHPOINT ','CHPOINT ','ENTIER  ',
     $     'MATRIK  ','MATRIK  ','MOT     ','MOT     ','ENTIER  ',
     $     'ENTIER  ',
     $     'ENTIER  ','ENTIER  ','CHPOINT ','ENTIER  ','FLOTTANT',
     $     'FLOTTANT','ENTIER  ','ENTIER  ','FLOTTANT','FLOTTANT',
     $     'FLOTTANT','FLOTTANT','ENTIER  ','ENTIER  ','ENTIER  ',
     $     'LOGIQUE ','ENTIER  ','FLOTTANT','ENTIER  ','ENTIER  ',
     $     'LISTOBJE','LISTMOTS','LISTMOTS','LOGIQUE ','ENTIER  '/
      DATA TYTABL,TYCHPO,TYMOT,TYENT,TYFLO,TYMATK,TYRIGI,BLAN,TYLOG
     $     ,TYLMOT/
     $     'TABLE   ','CHPOINT ','MOT     ','ENTIER  ','FLOTTANT',
     $     'MATRIK  ','RIGIDITE','        ','LOGIQUE ','LISTMOTS'/
*
* Executable statements
*
      IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans prkres.eso'
*
* Lecture de la matrice
*
      TYPE=BLAN
      CALL QUETYP(TYPE,1,IRET)
      IF (IRET.EQ.0) GOTO 9999
      IF (TYPE.EQ.TYRIGI) THEN
         MATRIK=0
         CALL LIROBJ(TYPE,MRIGID,1,IRET)
*         WRITE(IOIMP,*) 'Ap MACHI2'
*         WRITE(IOIMP,*) 'Non implémenté'
*         GOTO 9999
      ELSE
         MRIGID=0
         TYPE=TYMATK
         CALL LIROBJ(TYPE,MATRIK,1,IRET)
         IF(IRET.EQ.0) GOTO 9999
      ENDIF
*
* Lecture du second membre éventuel
*
      KSMBR=0
      CALL QUETYP(TYPE,1,IRET)
      IF (TYPE.EQ.TYCHPO) THEN
         CALL LIROBJ(TYPE,KSMBR,1,IRET)
         IF(IRET.EQ.0) GOTO 9999
      ENDIF
*
* Valeurs par défaut
*
C     CALL PRKRES(MATRIK,MTINV,IMPR,KCLIM,KSMBR,KTYPI,MATASS,MAPREC,
C    $     MRENU,MMULAG,ISCAL,IOUBL,IMPINV,MCHINI,ITER,RESID,BRTOL,
C    $     IRSTRT,KPREC,RXMILU,XLFIL,XDTOL,XSPIV,LBCG,IRET)
      MTINV=0
      IMPR=0
      KCLIM=0
      KTYPI=1
      MATASS=MATRIK
      MAPREC=MATRIK
      MRENU='SLOA'
      LMRENU=.FALSE.
      MMULAG='APR2'
      ISCAL=0
      INORMU=1
      IF (MRIGID.NE.0) THEN
         IOUBL=1
      ELSE
         IOUBL=0
      ENDIF
      IMPINV=0
      MCHINI=0
      ITER=2000
      RESID=1.D-10
      BRTOL=1.D-40
      IRSTRT=50
      KPREC=3
      RXMILU=1.D0
      RXILUP=0.5D0
      XLFIL=2.D0
      XDTOL=-1.D0
      XSPIV=0.1D0
      LBCG=4
      ICALRS=0
      METASS=5
      LMETAS=.FALSE.
      LTIME=.FALSE.
      IF (MRIGID.NE.0) THEN
         NELIM=2
      ELSE
         NELIM=0
      ENDIF
      IDDOT=0
      IMVEC=2
      ith=oothrd
      IF(ITH.NE.0)THEN
         IMVEC=0
      ENDIF
      IORINC=0
      MLAG1=0
      MLAG2=0
      LDUMP=.FALSE.
      ISMOOT=0
*
* Boucle de lecture des arguments
*
 1    CONTINUE
      CALL LIRMOT(MOTSCL,NMOT,IRAN,0)
      IF(IRAN.EQ.0) GOTO 2
      IF (IRAN.EQ.2) THEN
         CALL LIRTAB('METHINV',MTINV,1,IRET)
         IF (IRET.EQ.0) GOTO 9999
*
* Lectures des indices de table
*
*        WRITE(IOIMP,*) 'Lecture de la table'
         DO I=1,NMOT
            TYPI=TYMOT
            TYPR=BLAN
            TYPE=TYARG(I)
            INDTAB=MOTSCL(I)
*            WRITE(IOIMP,*) 'INDTAB=',INDTAB
            CALL ACCTAB(MTINV,TYPI,IBID,XBID,INDTAB,LBID,IBID,
     $           TYPR,IVAL,XVAL,CVAL,LVAL,IOBJ)
            IF (IERR.NE.0) GOTO 9999
            IF (TYPR.NE.TYPE) THEN
               IF (TYPR.EQ.TYENT.AND.TYPE.EQ.TYFLO) THEN
                  XVAL=IVAL
               ELSEIF (TYPR.NE.BLAN) THEN
                  WRITE(IOIMP,*) 'Index ',INDTAB,' : ',TYPR,
     $                 ' type object instead of ',TYPE
                  GOTO 9999
               ENDIF
            ENDIF
            IF (TYPR.NE.BLAN) THEN
               IF (I.EQ.1) THEN
                  IMPR=IVAL
* I.EQ.2 n'a pas de sens
               ELSEIF (I.EQ.3) THEN
                  KCLIM=IOBJ
               ELSEIF (I.EQ.4) THEN
                  KSMBR=IOBJ
               ELSEIF (I.EQ.5) THEN
                  KTYPI=IVAL
               ELSEIF (I.EQ.6) THEN
                  MATASS=IOBJ
               ELSEIF (I.EQ.7) THEN
                  MAPREC=IOBJ
               ELSEIF (I.EQ.8) THEN
                  MRENU=CVAL
                  LMRENU=.TRUE.
               ELSEIF (I.EQ.9) THEN
                  MMULAG=CVAL
               ELSEIF (I.EQ.10) THEN
                  ISCAL=IVAL
               ELSEIF (I.EQ.11) THEN
                  INORMU=IVAL
               ELSEIF (I.EQ.12) THEN
                  IOUBL=IVAL
               ELSEIF (I.EQ.13) THEN
                  IMPINV=IVAL
               ELSEIF (I.EQ.14) THEN
                  MCHINI=IOBJ
               ELSEIF (I.EQ.15) THEN
                  ITER=IVAL
               ELSEIF (I.EQ.16) THEN
                  RESID=XVAL
               ELSEIF (I.EQ.17) THEN
                  BRTOL=XVAL
               ELSEIF (I.EQ.18) THEN
                  IRSTRT=IVAL
               ELSEIF (I.EQ.19) THEN
                  KPREC=IVAL
               ELSEIF (I.EQ.20) THEN
                  RXMILU=XVAL
               ELSEIF (I.EQ.21) THEN
                  XLFIL=XVAL
               ELSEIF (I.EQ.22) THEN
                  XDTOL=XVAL
               ELSEIF (I.EQ.23) THEN
                  XSPIV=XVAL
               ELSEIF (I.EQ.24) THEN
                  LBCG=IVAL
               ELSEIF (I.EQ.25) THEN
                  ICALRS=IVAL
               ELSEIF (I.EQ.26) THEN
                  METASS=IVAL
                  LMETAS=.TRUE.
               ELSEIF (I.EQ.27) THEN
                  LTIME=LVAL
               ELSEIF (I.EQ.28) THEN
                  NELIM=IVAL
               ELSEIF (I.EQ.29) THEN
                  RXILUP=XVAL
               ELSEIF (I.EQ.30) THEN
                  IDDOT=IVAL
               ELSEIF (I.EQ.31) THEN
                  IMVEC=IVAL
               ELSEIF (I.EQ.32) THEN
                  IORINC=IOBJ
               ELSEIF (I.EQ.33) THEN
                  MLAG1=IOBJ
               ELSEIF (I.EQ.34) THEN
                  MLAG2=IOBJ
               ELSEIF (I.EQ.35) THEN
                  LDUMP=LVAL
               ELSEIF (I.EQ.36) THEN
                  ISMOOT=IVAL
               ELSE
                  WRITE(IOIMP,*) 'Programing error'
                  CALL ERREUR(5)
                  GOTO 9999
               ENDIF
            ENDIF
         ENDDO
      ELSE
         TYPE=TYARG(IRAN)
         IF (TYPE.EQ.TYENT) THEN
            CALL LIRENT(IVAL,1,IRET)
         ELSEIF (TYPE.EQ.TYFLO) THEN
            CALL LIRREE(XVAL,1,IRET)
         ELSEIF (TYPE.EQ.TYMOT) THEN
            CALL LIRCHA(CVAL,1,IRET)
         ELSEIF (TYPE.EQ.TYLOG) THEN
            CALL LIRLOG(LVAL,1,IRET)
         ELSE
            CALL LIROBJ(TYPE,IOBJ,1,IRET)
         ENDIF
         IF (IRET.EQ.0) THEN
            WRITE(IOIMP,*) MOTSCL(IRAN)
            GOTO 9999
         ENDIF
         IF (IRAN.EQ.1) THEN
            IMPR=IVAL
* I.EQ.2 n'a pas de sens
         ELSEIF (IRAN.EQ.3) THEN
            KCLIM=IOBJ
         ELSEIF (IRAN.EQ.4) THEN
            KSMBR=IOBJ
         ELSEIF (IRAN.EQ.5) THEN
            KTYPI=IVAL
         ELSEIF (IRAN.EQ.6) THEN
            MATASS=IOBJ
         ELSEIF (IRAN.EQ.7) THEN
            MAPREC=IOBJ
         ELSEIF (IRAN.EQ.8) THEN
            MRENU=CVAL
            LMRENU=.TRUE.
         ELSEIF (IRAN.EQ.9) THEN
            MMULAG=CVAL
         ELSEIF (IRAN.EQ.10) THEN
            ISCAL=IVAL
         ELSEIF (IRAN.EQ.11) THEN
            INORMU=IVAL
         ELSEIF (IRAN.EQ.12) THEN
            IOUBL=IVAL
         ELSEIF (IRAN.EQ.13) THEN
            IMPINV=IVAL
         ELSEIF (IRAN.EQ.14) THEN
            MCHINI=IOBJ
         ELSEIF (IRAN.EQ.15) THEN
            ITER=IVAL
         ELSEIF (IRAN.EQ.16) THEN
            RESID=XVAL
         ELSEIF (IRAN.EQ.17) THEN
            BRTOL=XVAL
         ELSEIF (IRAN.EQ.18) THEN
            IRSTRT=IVAL
         ELSEIF (IRAN.EQ.19) THEN
            KPREC=IVAL
         ELSEIF (IRAN.EQ.20) THEN
            RXMILU=XVAL
         ELSEIF (IRAN.EQ.21) THEN
            XLFIL=XVAL
         ELSEIF (IRAN.EQ.22) THEN
            XDTOL=XVAL
         ELSEIF (IRAN.EQ.23) THEN
            XSPIV=XVAL
         ELSEIF (IRAN.EQ.24) THEN
            LBCG=IVAL
         ELSEIF (IRAN.EQ.25) THEN
            ICALRS=IVAL
         ELSEIF (IRAN.EQ.26) THEN
            METASS=IVAL
            LMETAS=.TRUE.
         ELSEIF (IRAN.EQ.27) THEN
            LTIME=LVAL
         ELSEIF (IRAN.EQ.28) THEN
            NELIM=IVAL
         ELSEIF (IRAN.EQ.29) THEN
            RXILUP=XVAL
         ELSEIF (IRAN.EQ.30) THEN
            IDDOT=IVAL
         ELSEIF (IRAN.EQ.31) THEN
            IMVEC=IVAL
         ELSEIF (IRAN.EQ.32) THEN
            IORINC=IOBJ
         ELSEIF (IRAN.EQ.33) THEN
            MLAG1=IOBJ
         ELSEIF (IRAN.EQ.34) THEN
            MLAG2=IOBJ
         ELSEIF (IRAN.EQ.35) THEN
            LDUMP=LVAL
         ELSEIF (IRAN.EQ.36) THEN
            ISMOOT=IVAL
         ELSE
            WRITE(IOIMP,*) 'Programing error 2'
            CALL ERREUR(5)
            GOTO 9999
         ENDIF
      ENDIF
      GOTO 1
*
* Fin des lectures
*
 2    CONTINUE
C      MTYP=TYMATK
C      CALL ECRENT(6)
C      CALL ECROBJ(MTYP,MATRIK)
C      CALL PRLIST
C      MTYP=TYCHPO
C      CALL ECROBJ(MTYP,KSMBR)
C      CALL PRLIST
*
* Vérification de la validité de certains paramètres
*
C     CALL PRKRES(MATRIK,MTINV,IMPR,KCLIM,KSMBR,KTYPI,MATASS,MAPREC,
C    $     MRENU,MMULAG,ISCAL,IOUBL,IMPINV,MCHINI,ITER,RESID,BRTOL,
C    $     IRSTRT,KPREC,RXMILU,XLFIL,XDTOL,XSPIV,LBCG,IRET)
C   41 2
C %m1:8 = %r1 inférieur à %r2
C   42 2
C %m1:8 = %r1 non compris entre %r2 et %r3
C   43 2
C %m1:8 = %r1 supérieur à %r2
      IINF=0
      ISUP=2
      IF (ISCAL.LT.IINF.OR.ISCAL.GT.ISUP) THEN
         MOTERR(1:8)=MOTSCL(10)
         REAERR(1)=ISCAL
         REAERR(2)=IINF
         REAERR(3)=ISUP
         CALL ERREUR(42)
         GOTO 9999
      ENDIF
      IINF=0
      ISUP=1
      IF (INORMU.LT.IINF.OR.INORMU.GT.ISUP) THEN
         MOTERR(1:8)=MOTSCL(11)
         REAERR(1)=INORMU
         REAERR(2)=IINF
         REAERR(3)=ISUP
         CALL ERREUR(42)
         GOTO 9999
      ENDIF
      IINF=0
      ISUP=22
      IF (IOUBL.LT.IINF.OR.IOUBL.GT.ISUP) THEN
         MOTERR(1:8)=MOTSCL(12)
         REAERR(1)=IOUBL
         REAERR(2)=IINF
         REAERR(3)=ISUP
         CALL ERREUR(42)
         GOTO 9999
      ENDIF
      IINF=0
      IF (ITER.LT.IINF) THEN
         MOTERR(1:8)=MOTSCL(15)
         REAERR(1)=ITER
         REAERR(2)=IINF
         CALL ERREUR(41)
         GOTO 9999
      ENDIF
      XINF=XZERO
      IF (RESID.LT.XINF-XZPREC) THEN
         MOTERR(1:8)=MOTSCL(16)
         REAERR(1)=RESID
         REAERR(2)=XINF
         CALL ERREUR(41)
         GOTO 9999
      ENDIF
      XINF=XZERO
      IF (BRTOL.LT.XINF-XZPREC) THEN
         MOTERR(1:8)=MOTSCL(17)
         REAERR(1)=BRTOL
         REAERR(2)=XINF
         CALL ERREUR(41)
         GOTO 9999
      ENDIF
      IINF=1
      IF (IRSTRT.LT.IINF) THEN
         MOTERR(1:8)=MOTSCL(18)
         REAERR(1)=IRSTRT
         REAERR(2)=IINF
         CALL ERREUR(41)
         GOTO 9999
      ENDIF
      XINF=XZERO
      XSUP=1.D0
      IF (RXMILU.LT.XINF-XZPREC.OR.RXMILU.GT.XSUP+XZPREC) THEN
         MOTERR(1:8)=MOTSCL(20)
         REAERR(1)=RXMILU
         REAERR(2)=XINF
         REAERR(3)=XSUP
         CALL ERREUR(42)
         GOTO 9999
      ENDIF
      XINF=XZERO
      IF (XLFIL.LT.XINF-XZPREC) THEN
         MOTERR(1:8)=MOTSCL(21)
         REAERR(1)=XLFIL
         REAERR(2)=XINF
         CALL ERREUR(41)
         GOTO 9999
      ENDIF
      XSUP=XZERO
      IF (XDTOL.GT.XSUP+XZPREC) THEN
         MOTERR(1:8)=MOTSCL(22)
         REAERR(1)=XDTOL
         REAERR(2)=XSUP
         CALL ERREUR(43)
         GOTO 9999
      ENDIF
      XINF=XZERO
      XSUP=1.D0
      IF (XSPIV.LT.XINF-XZPREC.OR.XSPIV.GT.XSUP+XZPREC) THEN
         MOTERR(1:8)=MOTSCL(23)
         REAERR(1)=XSPIV
         REAERR(2)=XINF
         REAERR(3)=XSUP
         CALL ERREUR(42)
         GOTO 9999
      ENDIF
      IINF=1
      IF (LBCG.LT.IINF) THEN
         MOTERR(1:8)=MOTSCL(24)
         REAERR(1)=LBCG
         REAERR(2)=IINF
         CALL ERREUR(41)
         GOTO 9999
      ENDIF
      IINF=0
      ISUP=1
      IF (ICALRS.LT.IINF.OR.ICALRS.GT.ISUP) THEN
         MOTERR(1:8)=MOTSCL(25)
         REAERR(1)=ICALRS
         REAERR(2)=IINF
         REAERR(3)=ISUP
         CALL ERREUR(42)
         GOTO 9999
      ENDIF
      IINF=1
      ISUP=6
      IF (METASS.LT.IINF.OR.METASS.GT.ISUP) THEN
         MOTERR(1:8)=MOTSCL(26)
         REAERR(1)=METASS
         REAERR(2)=IINF
         REAERR(3)=ISUP
         CALL ERREUR(42)
         GOTO 9999
      ENDIF
      IINF=0
      ISUP=30
      IF (NELIM.LT.IINF.OR.NELIM.GT.ISUP) THEN
         MOTERR(1:8)=MOTSCL(28)
         REAERR(1)=NELIM
         REAERR(2)=IINF
         REAERR(3)=ISUP
         CALL ERREUR(42)
         GOTO 9999
      ENDIF
C      XINF=XZERO
C      IF (RXILUP.LT.XINF-XZPREC) THEN
C         MOTERR(1:8)=MOTSCL(29)
C         REAERR(1)=RXILUP
C         REAERR(2)=XINF
C         CALL ERREUR(41)
C         GOTO 9999
C      ENDIF
      IINF=0
      ISUP=1
      IF (IDDOT.LT.IINF.OR.IDDOT.GT.ISUP) THEN
         MOTERR(1:8)=MOTSCL(30)
         REAERR(1)=IDDOT
         REAERR(2)=IINF
         REAERR(3)=ISUP
         CALL ERREUR(42)
         GOTO 9999
      ENDIF
      IINF=0
      ISUP=2
      IF (IMVEC.LT.IINF.OR.IMVEC.GT.ISUP) THEN
         MOTERR(1:8)=MOTSCL(31)
         REAERR(1)=IMVEC
         REAERR(2)=IINF
         REAERR(3)=ISUP
         CALL ERREUR(42)
         GOTO 9999
      ENDIF
      IF (IORINC.NE.0) THEN
         SEGACT IORINC
         TYPOBL=IORINC.TYPOBJ
         TYPOBA='LISTMOTS'
         IF (TYPOBL.NE.TYPOBA) THEN
            MOTERR(1:128)=MOTSCL(32)
            CALL ERREUR(-385)
            MOTERR(1:8)=TYPOBA
            CALL ERREUR(37)
            GOTO 9999
         ENDIF
      ENDIF
      IINF=-2
      ISUP=2
      IF (ISMOOT.LT.IINF.OR.ISMOOT.GT.ISUP) THEN
         MOTERR(1:8)=MOTSCL(36)
         REAERR(1)=ISMOOT
         REAERR(2)=IINF
         REAERR(3)=ISUP
         CALL ERREUR(42)
         GOTO 9999
      ENDIF
 
* S'il y a eu une tentative forte de l'utilisateur de fournir ce
* paramètre.
      IF (MRIGID.EQ.0.AND.NELIM.GT.0) THEN
* 134 2
*Pas besoin d'objet %m1:8 quand il n'y a pas d'objet %m9:16
         MOTERR(1:8)='ELIM   '
         MOTERR(9:16)='RIGIDITE'
         CALL ERREUR(134)
         GOTO 9999
      ENDIF
*
* Quand il y a un champ de conditions aux limites donné,
* il est hasardeux d'essayer d'utiliser l'élimination des
* dépendances en même temps
*
      IF (MRIGID.NE.0.AND.KCLIM.NE.0.AND.NELIM.GT.0) THEN
* 135 2
*Incompatibilité entre l'objet %m1:8 et l'objet %m9:16
         MOTERR(1:8)='ELIM   '
         MOTERR(9:16)='CLIM    '
         CALL ERREUR(135)
         GOTO 9999
      ENDIF
*
* Certaines options ne sont pas nécessaires pour le multigrille
* et sont changées brutalement ici.
*
      IF (KTYPI.EQ.7.OR.KTYPI.EQ.8.OR.KTYPI.EQ.10.OR.KTYPI.EQ.11) THEN
         KPREC=0
* S'il n'y a pas eu de tentative forte de l'utilisateur de fournir ce
* paramètre.
         IF (.NOT.LMRENU) THEN
            MRENU='RIEN'
         ENDIF
      ENDIF
*
* Lorsque la matrice entrée est une rigidité et que l'on n'a pas de
* KCLIM qui a été donné, ni de préconditionneur type ILUT avec pivoting
* (qui impose une modification de la numérotation non encore gérée),
* on va utiliser l'assemblage de RESOU...
*
      IF (MRIGID.NE.0.AND.KCLIM.EQ.0.AND.KPREC.NE.7.AND.KPREC.NE.8) THEN
* ...s'il n'y a pas eu de tentative forte de l'utilisateur de fournir ce
* paramètre...et si la matrice ne contient pas simultanément d'inconnues
* normales et de multiplicateurs de Lagrange non reconnus par RESOU (la
* pression)
* Ceux-ci ont un nom commencant par 'LX', mais pas le type 22 pour le
* maillage
         IF (.NOT.LMETAS) THEN
            LNORMA=.FALSE.
            LMUANO=.FALSE.
            SEGACT MRIGID
            NRIG=COERIG(/1)
            DO 10 IRIG=1,NRIG
               MELEME=IRIGEL(1,IRIG)
               DESCR=IRIGEL(3,IRIG)
               SEGACT MELEME
               SEGACT DESCR
               NLIGRP=LISINC(/2)
               IF (ITYPEL.NE.22) THEN
                  DO ILIGRP=1,NLIGRP
                     IF (LISINC(ILIGRP)(1:2).EQ.'LX') THEN
                        LMUANO=.TRUE.
                     ELSE
                        LNORMA=.TRUE.
                     ENDIF
                  ENDDO
               ENDIF
               SEGDES MELEME
               SEGDES DESCR
               IF (LMUANO.AND.LNORMA) GOTO 20
 10         CONTINUE
            METASS=6
 20         CONTINUE
            SEGDES MRIGID
         ENDIF
      ENDIF
*
* Impressions de vérification éventuelles
*
      IF (IMPR.GT.2) THEN
         WRITE(IOIMP,*) 'KRES : following data were read'
         WRITE(IOIMP,*) '  Objects :'
         WRITE(IOIMP,*) '    MATRIK=',MATRIK,' MATASS=',MATASS,
     $        ' MAPREC=',MAPREC,' MRIGID=',MRIGID
         WRITE(IOIMP,*) '    MTINV =',MTINV
         WRITE(IOIMP,*) '    KCLIM =',KCLIM, ' KSMBR =',KSMBR,
     $        ' MCHINI=',MCHINI
         WRITE(IOIMP,*) '  General options :'
         WRITE(IOIMP,*) '    KTYPI =',KTYPI, ' KPREC =',KPREC
         WRITE(IOIMP,*) '    MRENU =',MRENU, ' MMULAG=',MMULAG
         WRITE(IOIMP,*) '    ISCAL =',ISCAL, ' INORMU=',INORMU
         write(ioimp,*) '    IOUBL =',IOUBL
         WRITE(IOIMP,*) '    IMPR  =',IMPR,  ' IMPINV=',IMPINV
         WRITE(IOIMP,*) '    METASS=',METASS,' LTIME =',LTIME
         WRITE(IOIMP,*) '    NELIM =',NELIM ,' MLAG1 =',MLAG1
         WRITE(IOIMP,*) '    MLAG2 =',MLAG2
         WRITE(IOIMP,*) '  Iterative methods :'
         WRITE(IOIMP,*) '    ITER  =',ITER,  ' RESID =',RESID
         WRITE(IOIMP,*) '    BRTOL =',BRTOL, ' IRSTRT=',IRSTRT
         WRITE(IOIMP,*) '    LBCG  =',LBCG,  ' ICALRS=',ICALRS
         WRITE(IOIMP,*) '    IDDOT =',IDDOT, ' IMVEC =',IMVEC
         WRITE(IOIMP,*) '  AGMG :'
         WRITE(IOIMP,*) '    IORINC =',IORINC,' LDUMP =',LDUMP
         WRITE(IOIMP,*) '    ISMOOT =',ISMOOT
         WRITE(IOIMP,*) '  Preconditioners  :'
         WRITE(IOIMP,*) '    RXMILU=',RXMILU,' XLFIL =',XLFIL
         WRITE(IOIMP,*) '    XDTOL =',XDTOL, ' XSPIV =',XSPIV
         WRITE(IOIMP,*) '    RXILUP=',RXILUP
      ENDIF
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine prkres'
      RETURN
*
* End of subroutine PRKRES
*
      END
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales