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

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