Télécharger la plaquette Cast3M


fr en

Télécharger prkres.eso

Retour à la liste

Numérotation des lignes : 

prkres

  1. C PRKRES    SOURCE    CB215821  20/11/25    13:36:59     10792          
  2.       SUBROUTINE PRKRES(MATRIK,MTINV,IMPR,KCLIM,KSMBR,KTYPI,MATASS,
  3.      $     MAPREC,
  4.      $     MRENU,MMULAG,ISCAL,INORMU,IOUBL,IMPINV,MCHINI,ITER,RESID,
  5.      $     BRTOL,IRSTRT,KPREC,RXMILU,RXILUP,XLFIL,XDTOL,XSPIV,LBCG,
  6.      $     ICALRS,METASS,LTIME,LDEPE,MRIGID,IDDOT,IMVEC,IRET)
  7.       IMPLICIT REAL*8 (A-H,O-Z)
  8.       IMPLICIT INTEGER (I-N)
  9. C***********************************************************************
  10. C NOM         : PRKRES
  11. C DESCRIPTION :
  12. C  Lecture des arguments et mise à défaut des optionnels ()
  13. C
  14. C  MATRIK : La matrice lue en entrée au format MATRIK
  15. C  MTINV  : L'éventuelle table d'inversion (obsolète)
  16. C  IMPR   : Niveau d'impression solveur direct
  17. C  KCLIM  : Chpoint éventuel de conditions aux limites de Dirichlet
  18. C  KSMBR  : Chpoint second membre
  19. C  KTYPI  : Type de méthode de résolution
  20. C  MATASS : Matrice utilisée pour préconditionner l'assemblage
  21. C  MAPREC : Matrice utilisée pour préconditionner la construction du
  22. C           préconditionneur
  23. C  MRENU  : Type de renumérotation
  24. C  MMULAG : Placement des multiplicateurs de Lagrange
  25. C  ISCAL  : Scaling de la matrice
  26. C  INORMU : Mise à l'échelle des multiplicateurs de Lagrange      
  27. C  IOUBL  : Oubli des matrices élémentaires ?
  28. C  IMPINV : Niveau d'impression solveur itératif
  29. C  MCHINI : Chpoint estimation de l'inconnue
  30. C  ITER   : Nombre maxi d'itérations à effectuer
  31. C  RESID  : Norme L2 maxi du résidu
  32. C  BRTOL  : Breakdown tolerance pour les méthodes de type Bi-CG
  33. C  IRSTRT : Paramètre m de redémarrage pour GMRES
  34. C  KPREC  : Type du préconditionneur
  35. C  RXMILU : Paramètre de relaxation pour MILU(0)
  36. C  RXILUP : Paramètre de filtre pour ILU(0)-PV
  37. C  XLFIL  : Paramètre de remplissage pour les préconditionneurs ILUT
  38. C  XDTOL  : Drop tolerance pour les préconditionneurs ILUT
  39. C  XSPIV  : Sensibilité du pivoting pour les préconditionneurs ILUTP
  40. C  LBCG   : le l dans BicgStab(l)
  41. C  ICALRS : façon de calculer le résidu
  42. C  METASS : méthode d'assemblage
  43. C  LTIME  : construit une table avec des statistiques temporelles
  44. C           si vrai
  45. C  LDEPE  : élimine les dépendances si VRAI
  46. C           et matrice d'entrée RIGIDITE
  47. C  IDDOT  : 0 => utilisation du produit scalaire normal dans les
  48. C                méthodes itératives
  49. C           1 => utilisation du produit scalaire compensé
  50. C  IMVEC  : 0, pas de parallélisme pour les produits matrice-vecteur
  51. C           1, parallélisme stratégie 1, entrelace les lignes.
  52. C           2, parallélisme stratégie 2, groupe les lignes.
  53. C           Par defaut : 2
  54. C
  55. C LANGAGE     : ESOPE
  56. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  57. C               mél : gounand@semt2.smts.cea.fr
  58. C***********************************************************************
  59. C APPELES          :
  60. C APPELES (E/S)    :
  61. C APPELES (BLAS)   :
  62. C APPELES (CALCUL) :
  63. C APPELE PAR       :
  64. C***********************************************************************
  65. C SYNTAXE GIBIANE    :
  66. C ENTREES            :
  67. C ENTREES/SORTIES    :
  68. C SORTIES            :
  69. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  70. C***********************************************************************
  71. C VERSION    : v1, 22/02/2006, version initiale
  72. C HISTORIQUE : v1, 22/02/2006, création
  73. C HISTORIQUE :
  74. C HISTORIQUE :
  75. C***********************************************************************
  76. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  77. C en cas de modification de ce sous-programme afin de faciliter
  78. C la maintenance !
  79. C***********************************************************************
  80. -INC CCREEL
  81.  
  82. -INC PPARAM
  83. -INC CCOPTIO
  84. -INC SMCHPOI
  85.       POINTEUR KCLIM.MCHPOI
  86.       POINTEUR KSMBR.MCHPOI
  87.       POINTEUR MCHINI.MCHPOI
  88.       POINTEUR MCHSOL.MCHPOI
  89. -INC SMTABLE
  90.       POINTEUR MTINV.MTABLE
  91. *-INC SMMATRIK
  92. *      POINTEUR MAPREC.MATRIK
  93. *      POINTEUR MATASS.MATRIK
  94. -INC SMRIGID
  95. -INC SMELEME
  96. *
  97.       INTEGER KTYPI,ISCAL,INORMU,IOUBL,IMPINV,ITER,IRSTRT,KPREC
  98.       REAL*8 RESID,BRTOL,RXMILU,RXILUP,XLFIL,XDTOL,XSPIV
  99.       CHARACTER*4 MRENU,MMULAG
  100. *
  101.       CHARACTER*8 TYPI,TYPR,TYP2,BLAN,TYPE,MTYP
  102.       CHARACTER*8 TYTABL,TYLMOT,TYCHPO,TYMOT,TYENT,TYFLO,TYLENT
  103.       CHARACTER*8 TYMATK,TYRIGI,INDTAB,TYLOG
  104. *
  105.       INTEGER IBID,IVAL,IOBJ
  106.       REAL*8 XBID,XVAL
  107.       CHARACTER*4 CBID,CVAL
  108.       LOGICAL LBID,LVAL,LTIME,LMRENU,LMETAS,LDEPE,LLDEPE
  109.       LOGICAL LMUANO,LNORMA
  110. *
  111.       INTEGER IMPR,IRET
  112.       PARAMETER (NMOT=31)
  113.       CHARACTER*8 MOTSCL(NMOT),TYARG(NMOT)
  114. C     CALL PRKRES(MATRIK,MTINV,IMPR,KCLIM,KSMBR,KTYPI,MATASS,MAPREC,
  115. C    $     MRENU,MMULAG,ISCAL,INORMU,IOUBL,IMPINV,MCHINI,ITER,RESID,BRTOL,
  116. C    $     IRSTRT,KPREC,RXMILU,XLFIL,XDTOL,XSPIV,IMPR,IRET)
  117.       DATA MOTSCL/
  118.      $     'IMPR    ','TYPI    ','CLIM    ','SMBR    ','TYPINV  ',
  119.      $     'MATASS  ','MAPREC  ','TYRENU  ','PCMLAG  ','SCALING ',
  120.      $     'SCALAG  ',
  121.      $     'OUBMAT  ','IMPINV  ','XINIT   ','NITMAX  ','RESID   ',
  122.      $     'BCGSBTOL','GMRESTRT','PRECOND ','MILURELX','ILUTLFIL',
  123.      $     'ILUTDTOL','ILUTPPIV','LBCG    ','CALRES  ','METASS  ',
  124.      $     'LTIME   ','LDEPE   ','ILUPRELX','IDDOT   ','IMVEC   '/
  125.       DATA TYARG/
  126.      $     'ENTIER  ','TABLE   ','CHPOINT ','CHPOINT ','ENTIER  ',
  127.      $     'MATRIK  ','MATRIK  ','MOT     ','MOT     ','ENTIER  ',
  128.      $     'ENTIER  ',
  129.      $     'ENTIER  ','ENTIER  ','CHPOINT ','ENTIER  ','FLOTTANT',
  130.      $     'FLOTTANT','ENTIER  ','ENTIER  ','FLOTTANT','FLOTTANT',
  131.      $     'FLOTTANT','FLOTTANT','ENTIER  ','ENTIER  ','ENTIER  ',
  132.      $     'LOGIQUE ','LOGIQUE ','FLOTTANT','ENTIER  ','ENTIER  '/
  133.       DATA TYTABL,TYCHPO,TYMOT,TYENT,TYFLO,TYMATK,TYRIGI,BLAN,TYLOG/
  134.      $     'TABLE   ','CHPOINT ','MOT     ','ENTIER  ','FLOTTANT',
  135.      $     'MATRIK  ','RIGIDITE','        ','LOGIQUE '
  136.      $     /
  137. *
  138. * Executable statements
  139. *
  140.       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans prkres.eso'
  141. *
  142. * Lecture de la matrice
  143. *
  144.       TYPE=BLAN
  145.       CALL QUETYP(TYPE,1,IRET)
  146.       IF (IRET.EQ.0) GOTO 9999
  147.       IF (TYPE.EQ.TYRIGI) THEN
  148.          MATRIK=0
  149.          CALL LIROBJ(TYPE,MRIGID,1,IRET)
  150. *         WRITE(IOIMP,*) 'Ap MACHI2'
  151. *         WRITE(IOIMP,*) 'Non implémenté'
  152. *         GOTO 9999
  153.       ELSE
  154.          MRIGID=0
  155.          TYPE=TYMATK
  156.          CALL LIROBJ(TYPE,MATRIK,1,IRET)
  157.          IF(IRET.EQ.0) GOTO 9999
  158.       ENDIF
  159. *
  160. * Lecture du second membre éventuel
  161. *
  162.       KSMBR=0
  163.       CALL QUETYP(TYPE,1,IRET)
  164.       IF (TYPE.EQ.TYCHPO) THEN
  165.          CALL LIROBJ(TYPE,KSMBR,1,IRET)
  166.          IF(IRET.EQ.0) GOTO 9999
  167.       ENDIF
  168. *
  169. * Valeurs par défaut
  170. *
  171. C     CALL PRKRES(MATRIK,MTINV,IMPR,KCLIM,KSMBR,KTYPI,MATASS,MAPREC,
  172. C    $     MRENU,MMULAG,ISCAL,IOUBL,IMPINV,MCHINI,ITER,RESID,BRTOL,
  173. C    $     IRSTRT,KPREC,RXMILU,XLFIL,XDTOL,XSPIV,LBCG,IRET)
  174.       MTINV=0
  175.       IMPR=0
  176.       KCLIM=0
  177.       KTYPI=1
  178.       MATASS=MATRIK
  179.       MAPREC=MATRIK
  180.       MRENU='SLOA'
  181.       LMRENU=.FALSE.
  182.       MMULAG='APR2'
  183.       ISCAL=0
  184.       INORMU=1
  185.       IF (MRIGID.NE.0) THEN
  186.          IOUBL=1
  187.       ELSE
  188.          IOUBL=0
  189.       ENDIF
  190.       IMPINV=0
  191.       MCHINI=0
  192.       ITER=2000
  193.       RESID=1.D-10
  194.       BRTOL=1.D-40
  195.       IRSTRT=50
  196.       KPREC=3
  197.       RXMILU=1.D0
  198.       RXILUP=0.5D0
  199.       XLFIL=2.D0
  200.       XDTOL=-1.D0
  201.       XSPIV=0.1D0
  202.       LBCG=4
  203.       ICALRS=0
  204.       METASS=5
  205.       LMETAS=.FALSE.
  206.       LTIME=.FALSE.
  207.       LDEPE=.TRUE.
  208.       LLDEPE=.FALSE.
  209.       IDDOT=0
  210.       IMVEC=2
  211.       ith=oothrd
  212.       IF(ITH.NE.0)THEN
  213.       IMVEC=0
  214.       ENDIF
  215. *
  216. * Boucle de lecture des arguments
  217. *
  218.  1    CONTINUE
  219.       CALL LIRMOT(MOTSCL,NMOT,IRAN,0)
  220.       IF(IRAN.EQ.0) GOTO 2
  221.       IF (IRAN.EQ.2) THEN
  222.          CALL LIRTAB('METHINV',MTINV,1,IRET)
  223.          IF (IRET.EQ.0) GOTO 9999
  224. *
  225. * Lectures des indices de table
  226. *
  227. *        WRITE(IOIMP,*) 'Lecture de la table'
  228.          DO I=1,NMOT
  229.             TYPI=TYMOT
  230.             TYPR=BLAN
  231.             TYPE=TYARG(I)
  232.             INDTAB=MOTSCL(I)
  233. *            WRITE(IOIMP,*) 'INDTAB=',INDTAB
  234.             CALL ACCTAB(MTINV,TYPI,IBID,XBID,INDTAB,LBID,IBID,
  235.      $           TYPR,IVAL,XVAL,CVAL,LVAL,IOBJ)
  236.             IF (IERR.NE.0) GOTO 9999
  237.             IF (TYPR.NE.TYPE) THEN
  238.                IF (TYPR.EQ.TYENT.AND.TYPE.EQ.TYFLO) THEN
  239.                   XVAL=IVAL
  240.                ELSEIF (TYPR.NE.BLAN) THEN
  241.                   WRITE(IOIMP,*) 'Index ',INDTAB,' : ',TYPR,
  242.      $                 ' type object instead of ',TYPE
  243.                   GOTO 9999
  244.                ENDIF
  245.             ENDIF
  246.             IF (TYPR.NE.BLAN) THEN
  247.                IF (I.EQ.1) THEN
  248.                   IMPR=IVAL
  249. * I.EQ.2 n'a pas de sens
  250.                ELSEIF (I.EQ.3) THEN
  251.                   KCLIM=IOBJ
  252.                ELSEIF (I.EQ.4) THEN
  253.                   KSMBR=IOBJ
  254.                ELSEIF (I.EQ.5) THEN
  255.                   KTYPI=IVAL
  256.                ELSEIF (I.EQ.6) THEN
  257.                   MATASS=IOBJ
  258.                ELSEIF (I.EQ.7) THEN
  259.                   MAPREC=IOBJ
  260.                ELSEIF (I.EQ.8) THEN
  261.                   MRENU=CVAL
  262.                   LMRENU=.TRUE.
  263.                ELSEIF (I.EQ.9) THEN
  264.                   MMULAG=CVAL
  265.                ELSEIF (I.EQ.10) THEN
  266.                   ISCAL=IVAL
  267.                ELSEIF (I.EQ.11) THEN
  268.                   INORMU=IVAL
  269.                ELSEIF (I.EQ.12) THEN
  270.                   IOUBL=IVAL
  271.                ELSEIF (I.EQ.13) THEN
  272.                   IMPINV=IVAL
  273.                ELSEIF (I.EQ.14) THEN
  274.                   MCHINI=IOBJ
  275.                ELSEIF (I.EQ.15) THEN
  276.                   ITER=IVAL
  277.                ELSEIF (I.EQ.16) THEN
  278.                   RESID=XVAL
  279.                ELSEIF (I.EQ.17) THEN
  280.                   BRTOL=XVAL
  281.                ELSEIF (I.EQ.18) THEN
  282.                   IRSTRT=IVAL
  283.                ELSEIF (I.EQ.19) THEN
  284.                   KPREC=IVAL
  285.                ELSEIF (I.EQ.20) THEN
  286.                   RXMILU=XVAL
  287.                ELSEIF (I.EQ.21) THEN
  288.                   XLFIL=XVAL
  289.                ELSEIF (I.EQ.22) THEN
  290.                   XDTOL=XVAL
  291.                ELSEIF (I.EQ.23) THEN
  292.                   XSPIV=XVAL
  293.                ELSEIF (I.EQ.24) THEN
  294.                   LBCG=IVAL
  295.                ELSEIF (I.EQ.25) THEN
  296.                   ICALRS=IVAL
  297.                ELSEIF (I.EQ.26) THEN
  298.                   METASS=IVAL
  299.                   LMETAS=.TRUE.
  300.                ELSEIF (I.EQ.27) THEN
  301.                   LTIME=LVAL
  302.                ELSEIF (I.EQ.28) THEN
  303.                   LDEPE=LVAL
  304. * On l'avait oublié ?                  
  305.                   LLDEPE=.TRUE.
  306.                ELSEIF (I.EQ.29) THEN
  307.                   RXILUP=XVAL
  308.                ELSEIF (I.EQ.30) THEN
  309.                   IDDOT=IVAL
  310.                ELSEIF (I.EQ.31) THEN
  311.                   IMVEC=IVAL
  312.                ELSE
  313.                   WRITE(IOIMP,*) 'Programing error'
  314.                   CALL ERREUR(5)
  315.                   GOTO 9999
  316.                ENDIF
  317.             ENDIF
  318.          ENDDO
  319.       ELSE
  320.          TYPE=TYARG(IRAN)
  321.          IF (TYPE.EQ.TYENT) THEN
  322.             CALL LIRENT(IVAL,1,IRET)
  323.          ELSEIF (TYPE.EQ.TYFLO) THEN
  324.             CALL LIRREE(XVAL,1,IRET)
  325.          ELSEIF (TYPE.EQ.TYMOT) THEN
  326.             CALL LIRCHA(CVAL,1,IRET)
  327.          ELSEIF (TYPE.EQ.TYLOG) THEN
  328.             CALL LIRLOG(LVAL,1,IRET)
  329.          ELSE
  330.             CALL LIROBJ(TYPE,IOBJ,1,IRET)
  331.          ENDIF
  332.          IF (IRET.EQ.0) GOTO 9999
  333.          IF (IRAN.EQ.1) THEN
  334.             IMPR=IVAL
  335. * I.EQ.2 n'a pas de sens
  336.          ELSEIF (IRAN.EQ.3) THEN
  337.             KCLIM=IOBJ
  338.          ELSEIF (IRAN.EQ.4) THEN
  339.             KSMBR=IOBJ
  340.          ELSEIF (IRAN.EQ.5) THEN
  341.             KTYPI=IVAL
  342.          ELSEIF (IRAN.EQ.6) THEN
  343.             MATASS=IOBJ
  344.          ELSEIF (IRAN.EQ.7) THEN
  345.             MAPREC=IOBJ
  346.          ELSEIF (IRAN.EQ.8) THEN
  347.             MRENU=CVAL
  348.             LMRENU=.TRUE.
  349.          ELSEIF (IRAN.EQ.9) THEN
  350.             MMULAG=CVAL
  351.          ELSEIF (IRAN.EQ.10) THEN
  352.             ISCAL=IVAL
  353.          ELSEIF (IRAN.EQ.11) THEN
  354.             INORMU=IVAL
  355.          ELSEIF (IRAN.EQ.12) THEN
  356.             IOUBL=IVAL
  357.          ELSEIF (IRAN.EQ.13) THEN
  358.             IMPINV=IVAL
  359.          ELSEIF (IRAN.EQ.14) THEN
  360.             MCHINI=IOBJ
  361.          ELSEIF (IRAN.EQ.15) THEN
  362.             ITER=IVAL
  363.          ELSEIF (IRAN.EQ.16) THEN
  364.             RESID=XVAL
  365.          ELSEIF (IRAN.EQ.17) THEN
  366.             BRTOL=XVAL
  367.          ELSEIF (IRAN.EQ.18) THEN
  368.             IRSTRT=IVAL
  369.          ELSEIF (IRAN.EQ.19) THEN
  370.             KPREC=IVAL
  371.          ELSEIF (IRAN.EQ.20) THEN
  372.             RXMILU=XVAL
  373.          ELSEIF (IRAN.EQ.21) THEN
  374.             XLFIL=XVAL
  375.          ELSEIF (IRAN.EQ.22) THEN
  376.             XDTOL=XVAL
  377.          ELSEIF (IRAN.EQ.23) THEN
  378.             XSPIV=XVAL
  379.          ELSEIF (IRAN.EQ.24) THEN
  380.             LBCG=IVAL
  381.          ELSEIF (IRAN.EQ.25) THEN
  382.             ICALRS=IVAL
  383.          ELSEIF (IRAN.EQ.26) THEN
  384.             METASS=IVAL
  385.             LMETAS=.TRUE.
  386.          ELSEIF (IRAN.EQ.27) THEN
  387.             LTIME=LVAL
  388.          ELSEIF (IRAN.EQ.28) THEN
  389.             LDEPE=LVAL
  390.             LLDEPE=.TRUE.
  391.          ELSEIF (IRAN.EQ.29) THEN
  392.             RXILUP=XVAL
  393.          ELSEIF (IRAN.EQ.30) THEN
  394.             IDDOT=IVAL
  395.          ELSEIF (IRAN.EQ.31) THEN
  396.             IMVEC=IVAL
  397.          ELSE
  398.             WRITE(IOIMP,*) 'Programing error 2'
  399.             CALL ERREUR(5)
  400.             GOTO 9999
  401.          ENDIF
  402.       ENDIF
  403.       GOTO 1
  404. *
  405. * Fin des lectures
  406. *
  407.  2    CONTINUE
  408. C      MTYP=TYMATK
  409. C      CALL ECRENT(6)
  410. C      CALL ECROBJ(MTYP,MATRIK)
  411. C      CALL PRLIST
  412. C      MTYP=TYCHPO
  413. C      CALL ECROBJ(MTYP,KSMBR)
  414. C      CALL PRLIST
  415. *
  416. * Vérification de la validité de certains paramètres
  417. *
  418. C     CALL PRKRES(MATRIK,MTINV,IMPR,KCLIM,KSMBR,KTYPI,MATASS,MAPREC,
  419. C    $     MRENU,MMULAG,ISCAL,IOUBL,IMPINV,MCHINI,ITER,RESID,BRTOL,
  420. C    $     IRSTRT,KPREC,RXMILU,XLFIL,XDTOL,XSPIV,LBCG,IRET)
  421. C   41 2
  422. C %m1:8 = %r1 inférieur à %r2
  423. C   42 2
  424. C %m1:8 = %r1 non compris entre %r2 et %r3
  425. C   43 2
  426. C %m1:8 = %r1 supérieur à %r2
  427.       IINF=0
  428.       ISUP=2
  429.       IF (ISCAL.LT.IINF.OR.ISCAL.GT.ISUP) THEN
  430.          MOTERR(1:8)=MOTSCL(10)
  431.          REAERR(1)=ISCAL
  432.          REAERR(2)=IINF
  433.          REAERR(3)=ISUP
  434.          CALL ERREUR(42)
  435.          GOTO 9999
  436.       ENDIF
  437.       IINF=0
  438.       ISUP=1
  439.       IF (INORMU.LT.IINF.OR.INORMU.GT.ISUP) THEN
  440.          MOTERR(1:8)=MOTSCL(10)
  441.          REAERR(1)=INORMU
  442.          REAERR(2)=IINF
  443.          REAERR(3)=ISUP
  444.          CALL ERREUR(42)
  445.          GOTO 9999
  446.       ENDIF
  447.       IINF=0
  448.       ISUP=22
  449.       IF (IOUBL.LT.IINF.OR.IOUBL.GT.ISUP) THEN
  450.          MOTERR(1:8)=MOTSCL(11)
  451.          REAERR(1)=IOUBL
  452.          REAERR(2)=IINF
  453.          REAERR(3)=ISUP
  454.          CALL ERREUR(42)
  455.          GOTO 9999
  456.       ENDIF
  457.       IINF=0
  458.       IF (ITER.LT.IINF) THEN
  459.          MOTERR(1:8)=MOTSCL(14)
  460.          REAERR(1)=ITER
  461.          REAERR(2)=IINF
  462.          CALL ERREUR(41)
  463.          GOTO 9999
  464.       ENDIF
  465.       XINF=XZERO
  466.       IF (RESID.LT.XINF-XZPREC) THEN
  467.          MOTERR(1:8)=MOTSCL(15)
  468.          REAERR(1)=RESID
  469.          REAERR(2)=XINF
  470.          CALL ERREUR(41)
  471.          GOTO 9999
  472.       ENDIF
  473.       XINF=XZERO
  474.       IF (BRTOL.LT.XINF-XZPREC) THEN
  475.          MOTERR(1:8)=MOTSCL(16)
  476.          REAERR(1)=BRTOL
  477.          REAERR(2)=XINF
  478.          CALL ERREUR(41)
  479.          GOTO 9999
  480.       ENDIF
  481.       IINF=1
  482.       IF (IRSTRT.LT.IINF) THEN
  483.          MOTERR(1:8)=MOTSCL(17)
  484.          REAERR(1)=IRSTRT
  485.          REAERR(2)=IINF
  486.          CALL ERREUR(41)
  487.          GOTO 9999
  488.       ENDIF
  489.       XINF=XZERO
  490.       XSUP=1.D0
  491.       IF (RXMILU.LT.XINF-XZPREC.OR.RXMILU.GT.XSUP+XZPREC) THEN
  492.          MOTERR(1:8)=MOTSCL(19)
  493.          REAERR(1)=RXMILU
  494.          REAERR(2)=XINF
  495.          REAERR(3)=XSUP
  496.          CALL ERREUR(42)
  497.          GOTO 9999
  498.       ENDIF
  499.       XINF=XZERO
  500.       IF (XLFIL.LT.XINF-XZPREC) THEN
  501.          MOTERR(1:8)=MOTSCL(20)
  502.          REAERR(1)=XLFIL
  503.          REAERR(2)=XINF
  504.          CALL ERREUR(41)
  505.          GOTO 9999
  506.       ENDIF
  507.       XSUP=XZERO
  508.       IF (XDTOL.GT.XSUP+XZPREC) THEN
  509.          MOTERR(1:8)=MOTSCL(21)
  510.          REAERR(1)=XDTOL
  511.          REAERR(2)=XSUP
  512.          CALL ERREUR(43)
  513.          GOTO 9999
  514.       ENDIF
  515.       XINF=XZERO
  516.       XSUP=1.D0
  517.       IF (XSPIV.LT.XINF-XZPREC.OR.XSPIV.GT.XSUP+XZPREC) THEN
  518.          MOTERR(1:8)=MOTSCL(22)
  519.          REAERR(1)=XSPIV
  520.          REAERR(2)=XINF
  521.          REAERR(3)=XSUP
  522.          CALL ERREUR(42)
  523.          GOTO 9999
  524.       ENDIF
  525.       IINF=1
  526.       IF (LBCG.LT.IINF) THEN
  527.          MOTERR(1:8)=MOTSCL(23)
  528.          REAERR(1)=LBCG
  529.          REAERR(2)=IINF
  530.          CALL ERREUR(41)
  531.          GOTO 9999
  532.       ENDIF
  533.       IINF=0
  534.       ISUP=1
  535.       IF (ICALRS.LT.IINF.OR.ICALRS.GT.ISUP) THEN
  536.          MOTERR(1:8)=MOTSCL(24)
  537.          REAERR(1)=ICALRS
  538.          REAERR(2)=IINF
  539.          REAERR(3)=ISUP
  540.          CALL ERREUR(42)
  541.          GOTO 9999
  542.       ENDIF
  543.       IINF=1
  544.       ISUP=6
  545.       IF (METASS.LT.IINF.OR.METASS.GT.ISUP) THEN
  546.          MOTERR(1:8)=MOTSCL(25)
  547.          REAERR(1)=METASS
  548.          REAERR(2)=IINF
  549.          REAERR(3)=ISUP
  550.          CALL ERREUR(42)
  551.          GOTO 9999
  552.       ENDIF
  553. C      XINF=XZERO
  554. C      IF (RXILUP.LT.XINF-XZPREC) THEN
  555. C         MOTERR(1:8)=MOTSCL(28)
  556. C         REAERR(1)=RXILUP
  557. C         REAERR(2)=XINF
  558. C         CALL ERREUR(41)
  559. C         GOTO 9999
  560. C      ENDIF
  561.       IINF=0
  562.       ISUP=1
  563.       IF (IDDOT.LT.IINF.OR.IDDOT.GT.ISUP) THEN
  564.          MOTERR(1:8)=MOTSCL(29)
  565.          REAERR(1)=IDDOT
  566.          REAERR(2)=IINF
  567.          REAERR(3)=ISUP
  568.          CALL ERREUR(42)
  569.          GOTO 9999
  570.       ENDIF
  571.       IINF=0
  572.       ISUP=2
  573.       IF (IMVEC.LT.IINF.OR.IMVEC.GT.ISUP) THEN
  574.          MOTERR(1:8)=MOTSCL(30)
  575.          REAERR(1)=IMVEC
  576.          REAERR(2)=IINF
  577.          REAERR(3)=ISUP
  578.          CALL ERREUR(42)
  579.          GOTO 9999
  580.       ENDIF
  581.  
  582. * S'il y a eu une tentative forte de l'utilisateur de fournir ce
  583. * paramètre.
  584.       IF (MRIGID.EQ.0.AND.LDEPE.AND.LLDEPE) THEN
  585. * 134 2
  586. *Pas besoin d'objet %m1:8 quand il n'y a pas d'objet %m9:16
  587.          MOTERR(1:8)='LDEPE   '
  588.          MOTERR(9:16)='RIGIDITE'
  589.          CALL ERREUR(134)
  590.          GOTO 9999
  591.       ENDIF
  592. *
  593. * Quand il y a un champ de conditions aux limites donné,
  594. * il est hasardeux d'essayer d'utiliser l'élimination des
  595. * dépendances en même temps
  596. *
  597.       IF (MRIGID.NE.0.AND.KCLIM.NE.0.AND.LDEPE) THEN
  598.          IF (LLDEPE) THEN
  599. * 135 2
  600. *Incompatibilité entre l'objet %m1:8 et l'objet %m9:16
  601.             MOTERR(1:8)='LDEPE   '
  602.             MOTERR(9:16)='CLIM    '
  603.             CALL ERREUR(135)
  604.             GOTO 9999
  605.          ELSE
  606.             LDEPE=.FALSE.
  607.          ENDIF
  608.       ENDIF
  609. *
  610. * Certaines options ne sont pas nécessaires pour le multigrille
  611. * et sont changées brutalement ici.
  612. *
  613.       IF (KTYPI.EQ.7.OR.KTYPI.EQ.8) THEN
  614.          KPREC=0
  615. * S'il n'y a pas eu de tentative forte de l'utilisateur de fournir ce
  616. * paramètre.
  617.          IF (.NOT.LMRENU) THEN
  618.             MRENU='RIEN'
  619.          ENDIF
  620.       ENDIF
  621. *
  622. * Lorsque la matrice entrée est une rigidité et que l'on n'a pas de
  623. * KCLIM qui a été donné, ni de préconditionneur type ILUT avec pivoting
  624. * (qui impose une modification de la numérotation non encore gérée),
  625. * on va utiliser l'assemblage de RESOU...
  626. *
  627.       IF (MRIGID.NE.0.AND.KCLIM.EQ.0.AND.KPREC.NE.7.AND.KPREC.NE.8) THEN
  628. * ...s'il n'y a pas eu de tentative forte de l'utilisateur de fournir ce
  629. * paramètre...et si la matrice ne contient pas simultanément d'inconnues
  630. * normales et de multiplicateurs de Lagrange non reconnus par RESOU (la
  631. * pression)
  632. * Ceux-ci ont un nom commencant par 'LX', mais pas le type 22 pour le
  633. * maillage
  634.          IF (.NOT.LMETAS) THEN
  635.             LNORMA=.FALSE.
  636.             LMUANO=.FALSE.
  637.             SEGACT MRIGID
  638.             NRIG=COERIG(/1)
  639.             DO 10 IRIG=1,NRIG
  640.                MELEME=IRIGEL(1,IRIG)
  641.                DESCR=IRIGEL(3,IRIG)
  642.                SEGACT MELEME
  643.                SEGACT DESCR
  644.                NLIGRP=LISINC(/2)
  645.                IF (ITYPEL.NE.22) THEN
  646.                   DO ILIGRP=1,NLIGRP
  647.                      IF (LISINC(ILIGRP)(1:2).EQ.'LX') THEN
  648.                         LMUANO=.TRUE.
  649.                      ELSE
  650.                         LNORMA=.TRUE.
  651.                      ENDIF
  652.                   ENDDO
  653.                ENDIF
  654.                SEGDES MELEME
  655.                SEGDES DESCR
  656.                IF (LMUANO.AND.LNORMA) GOTO 20
  657.  10         CONTINUE
  658.             METASS=6
  659.  20         CONTINUE
  660.             SEGDES MRIGID
  661.          ENDIF
  662.       ENDIF
  663. *
  664. * Impressions de vérification éventuelles
  665. *
  666.       IF (IMPR.GT.2) THEN
  667.          WRITE(IOIMP,*) 'KRES : following data were read'
  668.          WRITE(IOIMP,*) '  Objects :'
  669.          WRITE(IOIMP,*) '    MATRIK=',MATRIK,' MATASS=',MATASS,
  670.      $        ' MAPREC=',MAPREC,' MRIGID=',MRIGID
  671.          WRITE(IOIMP,*) '    MTINV =',MTINV
  672.          WRITE(IOIMP,*) '    KCLIM =',KCLIM, ' KSMBR =',KSMBR,
  673.      $        ' MCHINI=',MCHINI
  674.          WRITE(IOIMP,*) '  General options :'
  675.          WRITE(IOIMP,*) '    KTYPI =',KTYPI, ' KPREC =',KPREC
  676.          WRITE(IOIMP,*) '    MRENU =',MRENU, ' MMULAG=',MMULAG
  677.          WRITE(IOIMP,*) '    ISCAL =',ISCAL, ' INORMU=',INORMU
  678.          write(ioimp,*) '    IOUBL =',IOUBL
  679.          WRITE(IOIMP,*) '    IMPR  =',IMPR,  ' IMPINV=',IMPINV
  680.          WRITE(IOIMP,*) '    METASS=',METASS,' LTIME =',LTIME
  681.          WRITE(IOIMP,*) '    LDEPE =',LDEPE
  682.          WRITE(IOIMP,*) '  Iterative methods :'
  683.          WRITE(IOIMP,*) '    ITER  =',ITER,  ' RESID =',RESID
  684.          WRITE(IOIMP,*) '    BRTOL =',BRTOL, ' IRSTRT=',IRSTRT
  685.          WRITE(IOIMP,*) '    LBCG  =',LBCG,  ' ICALRS=',ICALRS
  686.          WRITE(IOIMP,*) '    IDDOT =',IDDOT, ' IMVEC =',IMVEC
  687.          WRITE(IOIMP,*) '  Preconditioners  :'
  688.          WRITE(IOIMP,*) '    RXMILU=',RXMILU,' XLFIL =',XLFIL
  689.          WRITE(IOIMP,*) '    XDTOL =',XDTOL, ' XSPIV =',XSPIV
  690.          WRITE(IOIMP,*) '    RXILUP=',RXILUP
  691.       ENDIF
  692. *
  693. * Normal termination
  694. *
  695.       IRET=0
  696.       RETURN
  697. *
  698. * Format handling
  699. *
  700. *
  701. * Error handling
  702. *
  703.  9999 CONTINUE
  704.       IRET=1
  705.       WRITE(IOIMP,*) 'An error was detected in subroutine prkres'
  706.       RETURN
  707. *
  708. * End of subroutine PRKRES
  709. *
  710.       END
  711.  
  712.  
  713.  
  714.  
  715.  
  716.  
  717.  
  718.  
  719.  
  720.  
  721.  
  722.  
  723.  
  724.  
  725.  
  726.  
  727.  
  728.  
  729.  
  730.  
  731.  
  732.  
  733.  

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