Télécharger la plaquette Cast3M


fr en

Télécharger kres5.eso

Retour à la liste

Numérotation des lignes : 

kres5

  1. C KRES5     SOURCE    GOUNAND   25/03/24    21:15:05     12216          
  2.       SUBROUTINE KRES5(MATRIK,KCLIM,KSMBR,KTYPI,
  3.      $     MCHINI,ITER,RESID,
  4.      $     BRTOL,IRSTRT,LBCG,ICALRS,
  5.      $     MAPREC,KPREC,
  6.      $     RXMILU,RXILUP,XLFIL,XDTOL,XSPIV,
  7.      $     ISCAL,
  8.      $     KTIME,LTIME,IDDOT,IMVEC,IORINC,
  9.      $     MCHSOL,LRES,LNMV,ICVG,
  10.      $     IMPR,IRET)
  11.       IMPLICIT REAL*8 (A-H,O-Z)
  12.       IMPLICIT INTEGER (I-N)
  13. C***********************************************************************
  14. C NOM         : KRES5
  15. C DESCRIPTION : Résolution d'un système par une méthode itérative
  16. C               (type gradient conjugué).
  17. C
  18. C
  19. C LANGAGE     : ESOPE
  20. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  21. C               mél : gounand@semt2.smts.cea.fr
  22. C***********************************************************************
  23. C APPELES          : VERMAT, MEXINI, MESMBR, MELIM, INFMAT,
  24. C                    MEIDIA, PRDILU, PRILU, PRMILU, PRILUT,
  25. C                    PRCG, PRBCGS, PRBCS2, PRGMR,
  26. C                    XDISP
  27. C APPELE PAR       : KRES2
  28. C***********************************************************************
  29. C ENTREES            : MATRIK, KCLIM, KSMBR, KTYPI, MCHINI, ITER, RESID,
  30. C                      BRTOL, IRSTRT, MAPREC, KPREC, RXMILU, XLFIL,
  31. C                      XDTOL
  32. C ENTREES/SORTIES    : -
  33. C SORTIES            : MCHSOL, LRES
  34. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  35. C***********************************************************************
  36. C VERSION    : v1, 14/04/2000, version initiale
  37. C HISTORIQUE : v1, 14/04/2000, création
  38. C HISTORIQUE : 06/04/04 : Scaling
  39. C HISTORIQUE : 08/04/04 : ajout ILUTP
  40. C HISTORIQUE :
  41. C***********************************************************************
  42. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  43. C en cas de modification de ce sous-programme afin de faciliter
  44. C la maintenance !
  45. C***********************************************************************
  46.  
  47. -INC PPARAM
  48. -INC CCOPTIO
  49. -INC SMLENTI
  50.       POINTEUR LNMV.MLENTI
  51.       POINTEUR ATYP.MLENTI
  52.       POINTEUR ANOD.MLENTI
  53. -INC SMLREEL
  54.       POINTEUR LRES.MLREEL
  55. -INC SMCHPOI
  56.       POINTEUR KCLIM.MCHPOI
  57.       POINTEUR KSMBR.MCHPOI
  58.       POINTEUR MCHINI.MCHPOI
  59.       POINTEUR MCHSOL.MCHPOI
  61.       POINTEUR MAPREC.MATRIK
  62.       POINTEUR INCX.IZA
  63.       POINTEUR KS2B.IZA
  64.       POINTEUR KMORS.PMORS
  65.       POINTEUR KISA.IZA
  66.       POINTEUR AMORS.PMORS
  67.       POINTEUR AISA.IZA
  68.       POINTEUR NORMP.IZA
  69.       POINTEUR NORMD.IZA
  70. *
  71. *     .. Parameters
  72.       REAL*8     ZERO      ,ONE
  73.       PARAMETER (ZERO=0.0D0,ONE=1.0D0)
  74. *     Paramètre m du GMRES(m)
  75.       INTEGER IRSTRT
  76.       INTEGER ITER,IVARI
  77.       REAL*8 BRTOL,RESID,RXMILU,RXILUP
  78. *
  79.       REAL*8 XLFIL,XDTOL
  80.       INTEGER KPREC
  81.       INTEGER KTYPI
  82. C      LOGICAL LCLZER
  83.       LOGICAL LRACOU
  84.       LOGICAL LFIRST
  85. C
  86.       INTEGER IMPR,IRET
  87. C     Tableau de correspondance : entier <-> mot
  88. C     pour le type d'inversion
  89.       INTEGER NBTYPI,LNTYPI
  90.       PARAMETER (NBTYPI=11)
  91.       PARAMETER (LNTYPI=18)
  92.       CHARACTER*(LNTYPI) LTYPI(NBTYPI)
  93. C     Tableau de correspondance : entier <-> mot
  94. C     pour le type de préconditionnement (cas d'une méthode itérative)
  95.       INTEGER NBPREC,LNPREC
  96.       PARAMETER (NBPREC=11)
  97.       PARAMETER (LNPREC=8)
  98.       CHARACTER*(LNPREC) LPREC(NBPREC)
  99. -INC SMTABLE
  100.       POINTEUR KTIME.MTABLE
  101.       DIMENSION ITTIME(4)
  102.       CHARACTER*8 CHARI
  103.       CHARACTER*1 CCOMP
  104.       LOGICAL LTIME,LOGII
  105. C
  106. C Initialisation des tableaux
  107. C
  108.       DATA LTYPI/'Choleski          ',
  109.      $     'Conjugate Gradient',
  110.      $     'BiCGSTAB G        ',
  111.      $     'BiCGSTAB(l) G     ',
  112.      $     'GMRES(m)          ',
  113.      $     'CGS-Neumaier      ',
  114.      $     'Multigrid FCG     ',
  115.      $     'Multigrid GCR(m)  ',
  116.      $     'Bi-CG             ',
  117.      $     'AGMG FCG Stokes   ',
  118.      $     'AGMG GCR(m) NS    '/
  119.       DATA LPREC/'None    ',
  120.      $     'Jacobi  ',
  121.      $     'D-ILU   ',
  122.      $     'ILU(0)  ',
  123.      $     'MILU(0) ',
  124.      $     'ILUT    ',
  125.      $     'ILUT2   ',
  126.      $     'ILUTP   ',
  127.      $     'ILUTP+0 ',
  128.      $     'ILU0-PV ',
  129.      $     'ILU0-PVf'/
  130.  
  131.       IVALI=0
  132.       XVALI=0.D0
  133.       LOGII=.FALSE.
  134.       IRETI=0
  135.       XVALR=0.D0
  136.       IOBRE=0
  137.       IRETR=0
  138. *
  139. * Executable statements
  140. *
  141.       ICVG=0
  142.       IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans kres5.eso'
  143. C Batterie de tests
  144. C
  145. C      KTYPI : Méthode d'inversion du système (cf. LTYPI)
  146. C                   1 : résolution directe (Choleski)
  147. C                   2 : Gradient Conjugué
  148. C                   3 : Bi-Gradient Conjugué Stabilisé (BiCGSTAB)
  149. C                   4 : BiCGSTAB(2)
  150. C                   5 : GMRES(m)
  151. C                   6 : CGS
  152. C                   7 : Multigrille symétrique
  153. C                   8 : Multigrille non symétrique
  154. C                   9 : BiCG
  155.       IF (KTYPI.LT.2.OR.KTYPI.GT.NBTYPI) THEN
  156.          WRITE(IOIMP,*) 'KTYPI incorrect (2..',NBTYPI,') :',KTYPI
  157.          GOTO 9999
  158.       ENDIF
  159. * Pas de préconditionnement en cas de multigrille
  160. C        - Type de préconditionnement : (cf. LPREC)
  161. C                   0 : pas de préconditionnement
  162. C                   1 : préconditionnement par la diagonale
  163. C                   2 : préconditionnement D-ILU
  164. C                   3 : préconditionnement ILU(0) (Choleski)
  165. C                   4 : préconditionnement MILU(0) (Choleski modifié)
  166. C                   5 : préconditionnement ILUT (dual truncation)
  167. C                   6 : préconditionnement ILUT2 (une variante du
  168. C                       précédent qui remplit mieux la mémoire et
  169. C                       fonctionne mieux quelquefois)
  170. C                   7 : préconditionnement ILUTP
  171. C                   8 : préconditionnement ILUTP version Goon
  172. C                   9 : préconditionnement ILU-PV
  173. C                   10 : préconditionnement ILU-PVf
  174.       IF (KPREC.LT.0.OR.KPREC.GT.NBPREC-1) THEN
  175.          WRITE(IOIMP,*) 'PRECOND ',
  176.      $           'incorrect (0..',NBPREC-1,') :',KPREC
  177.          GOTO 9999
  178.       ENDIF
  179. C
  180. C On vérifie que la matrice est correctement assemblée
  181. C
  182.       CALL VERMAT(MATRIK,IMPR,IRET)
  183.       IF (IRET.NE.0) GOTO 9999
  184. C
  185. C On transforme le chpoint estimation initiale de l'inconnue en vecteur
  186. C estimation initiale de l'inconnue
  187. C In MEXINI : SEGINI INCX
  188.       CALL MEXINI(MATRIK,MCHINI,
  189.      $     INCX,
  190.      $     IMPR,IRET)
  191.       IF (IRET.NE.0) GOTO 9999
  192. C
  193. C On transforme le chpoint second membre en vecteur second membre
  194. C In MESMBR : SEGINI KS2B
  195.       CALL MESMBR(MATRIK,KSMBR,
  196.      $     KS2B,
  197.      $     IMPR,IRET)
  198.       IF (IRET.NE.0) GOTO 9999
  199. C
  200. C On applique les conditions aux limites
  201. C
  202.       LRACOU=(KCLIM.EQ.0)
  203. *      LRACOU=.FALSE.
  204. *      WRITE(IOIMP,*) 'LRACOU=',LRACOU
  205.       IF (LRACOU) THEN
  206.          SEGACT MATRIK
  207.          AMORS=MATRIK.KIDMAT(4)
  208.          AISA=MATRIK.KIDMAT(5)
  209.          SEGDES MATRIK
  210.       ELSE
  211. C
  212. C In MELIM : SEGINI AMORS
  213. C            SEGINI AISA
  214.          CALL MELIM(MATRIK,KCLIM,
  215.      $        INCX,KS2B,
  216.      $        AMORS,AISA,
  217.      $        IMPR,IRET)
  218.          IF (IRET.NE.0) GOTO 9999
  219.       ENDIF
  220. C
  221.       LFIRST=.FALSE.
  222.       IF (ISCAL.GT.0) THEN
  223.          IF (LRACOU) THEN
  224.             SEGACT MATRIK
  225.             NORMP=MATRIK.KKMMT(4)
  226.             NORMD=MATRIK.KKMMT(5)
  227.             SEGDES MATRIK
  228.             IF (NORMP.EQ.0.AND.NORMD.EQ.0) THEN
  229.                LFIRST=.TRUE.
  230.             ENDIF
  231.          ELSE
  232.             NORMP=0
  233.             NORMD=0
  234.          ENDIF
  235.          IF (NORMP.EQ.0.OR.NORMD.EQ.0) THEN
  236. C Calcul des normes primales (colonnes) et duales (lignes)
  237. C de la matrice. Norme = norme L2, soit :
  238. C {\sum_{i ou j} a_{ij}^2}^{1/2}
  239. C
  240.             CALL NORMAT(AMORS,AISA,ISCAL,NORMP,NORMD,IMPR,IRET)
  241.             IF (IRET.NE.0) GOTO 9999
  242. C
  243. C On norme la matrice : attention modification...
  244. C
  245.             CALL NORMAM(AMORS,AISA,NORMP,NORMD,IMPR,IRET)
  246.             IF (IRET.NE.0) GOTO 9999
  247.          ENDIF
  248. C
  249. C On norme le second membre : attention modification...
  250. C
  251.          CALL NORMV2(KS2B,NORMD,IMPR,IRET)
  252.          IF (IRET.NE.0) GOTO 9999
  253. C
  254. C On dénorme l'inconnue X : attention modification...
  255. C
  256.          CALL NORMV1(INCX,NORMP,IMPR,IRET)
  257.          IF (IRET.NE.0) GOTO 9999
  258.       ELSE
  259.          NORMP=0
  260.          NORMD=0
  261.       ENDIF
  262. C
  263. C On donne des infos sur la matrice
  264. C
  265.       CALL INFMAT(AMORS,AISA,IMPR,IRET)
  266.       IF (IRET.NE.0) GOTO 9999
  267. C
  268. C     ON CHOISIT LE TYPE D'INVERSION
  269. C
  270. C  Méthodes de gradient conjugué
  271. C
  272. C  KTYPI = 2 : Gradient conjugué (CG)
  273. C  KTYPI = 3 : Bi-Gradient conjugué stabilisé (BiCGSTAB)
  274. C  KTYPI = 4 : BiCGSTAB(2)
  275. C  KTYPI = 5 : GMRES(m)
  276. C  KTYPI = 6 : CGS
  277. C  KTYPI = 7 : Algebraic Multigrid FCG
  278. C  KTYPI = 8 : Algebraic Multigrid GCR(m)
  279. C  KTYPI = 9 : BiCG
  280. C  KTYPI = 10 : Algebraic Multigrid FCG Stokes
  281. C  KTYPI = 11 : Algebraic Multigrid GCR(m) Navier-Stokes
  282. C
  283. C  KPREC = 0 : pas de préconditionnement
  284. C  KPREC = 1 : préconditionnement par la diagonale
  285. C  KPREC = 2 : préconditionnement par factorisation incomplete
  286. C              D-ILU
  287. C  KPREC = 3 : préconditionnement par factorisation incomplete
  288. C              ILU(0) (i.e. Crout)
  289. C  KPREC = 4 : préconditionnement par factorisation incomplete
  290. C              modifiée MILU(0) (i.e. Crout)
  291. C  KPREC = 5 : préconditionnement par factorisation incomplete
  292. C              ILUT (dual truncation strategy)
  293. C  KPREC = 6 : préconditionnement ILUT2 (une variante du
  294. C              précédent qui remplit mieux la mémoire et
  295. C              fonctionne mieux quelquefois)
  296. C  KPREC = 7 : préconditionnement ILUTP
  297. C  KPREC = 8 : préconditionnement ILUTPGOO
  298. C  KPREC = 9 : préconditionnement ILU-PV
  299. C  KPREC = 10 : préconditionnement ILU-PV filtré
  300.       IF(KTYPI.GE.2.AND.KTYPI.LE.NBTYPI)THEN
  301.          IF (IMPR.GT.1) THEN
  302.             IF (IDDOT.EQ.0) CCOMP=' '
  303.             IF (IDDOT.EQ.1) CCOMP='c'
  304.             IF (KTYPI.EQ.5.OR.KTYPI.EQ.8.OR.KTYPI.EQ.11) THEN
  305.                WRITE(IOIMP,*) CCOMP,LTYPI(KTYPI),' (m=',IRSTRT,')'
  306.             ELSEIF (KTYPI.EQ.4) THEN
  307.                WRITE(IOIMP,*) CCOMP,LTYPI(KTYPI),' (l=',LBCG,')'
  308.             ELSE
  309.                WRITE(IOIMP,*) CCOMP,LTYPI(KTYPI)
  310.             ENDIF
  311.             IF (KPREC.EQ.4) THEN
  312.                WRITE(IOIMP,110) ' ',LPREC(KPREC+1),' (r=',RXMILU,')'
  313.  110           FORMAT (3A,D9.2,A)
  314.             ELSEIF (KPREC.GE.5.AND.KPREC.LE.6) THEN
  315.                WRITE(IOIMP,111) ' ',LPREC(KPREC+1),' (lfil=',XLFIL,
  316.      $                 ' droptol=',XDTOL,')'
  317.  111           FORMAT (3A,D9.2,A,D9.2,A)
  318.             ELSEIF (KPREC.GE.7.AND.KPREC.LE.8) THEN
  319.                WRITE(IOIMP,112) ' ',LPREC(KPREC+1),' (lfil=',XLFIL,
  320.      $              ' droptol=',XDTOL,' pivtol=',XSPIV,
  321.      $              ')'
  322.  112           FORMAT (3A,D9.2,A,D9.2,A,D9.2,A,I4,A)
  323.             ELSEIF (KPREC.EQ.10) THEN
  324.                WRITE(IOIMP,110) ' ',LPREC(KPREC+1),' (r=',RXILUP,')'
  325.             ELSE
  326.                WRITE(IOIMP,*) LPREC(KPREC+1)
  327.             ENDIF
  328.          ENDIF
  329.          IF (LTIME) THEN
  330.             call timespv(ittime,oothrd)
  331.             ITI1=(ITTIME(1)+ITTIME(2))/10
  332.          ENDIF
  333. C
  334. C     Construction (éventuelle) du préconditionneur
  335. C
  336. * Gestion du CTRL-C
  337.          if (ierr.NE.0) return
  338.          IF (KPREC.EQ.1) THEN
  339.             CALL MEIDIA(AMORS,AISA,MAPREC,IMPR,IRET)
  340.             IF (IRET.NE.0) GOTO 9999
  341.          ELSEIF (KPREC.EQ.2) THEN
  342.             CALL PRDILU(AMORS,AISA,MAPREC,IMPR,IRET)
  343.             IF (IRET.NE.0) GOTO 9999
  344.          ELSEIF (KPREC.EQ.3) THEN
  345.             CALL PRILU0(AMORS,AISA,MAPREC,IMPR,IRET)
  346.             IF (IRET.NE.0) GOTO 9999
  347.          ELSEIF (KPREC.EQ.4) THEN
  348.             CALL PRMILU(AMORS,AISA,MAPREC,RXMILU,IMPR,IRET)
  349.             IF (IRET.NE.0) GOTO 9999
  350.          ELSEIF (KPREC.GE.5.AND.KPREC.LE.6) THEN
  351.             IVARI=KPREC-5
  352.             CALL PRILUT(AMORS,AISA,MAPREC,XLFIL,XDTOL,IVARI,
  353.      $           IMPR,IRET)
  354.             IF (IRET.NE.0) GOTO 9999
  355. *            WRITE(IOIMP,*) 'PRILUT !'
  356. *        ELSEIF (KPREC.GE.7.AND.KPREC.LE.9) THEN
  357.          ELSEIF (KPREC.GE.7.AND.KPREC.LE.8) THEN
  358. * Ici, on pivote les colonnes lors de la construction du
  359. * préconditionneur...
  360. * On modifiera donc IDMATP et INCX et NORMP
  361.             IF (KPREC.EQ.7) THEN
  362.                IVARI=0
  363.             ELSEIF (KPREC.EQ.8) THEN
  364.                IVARI=2
  365.             ENDIF
  366.             CALL PRILTP(AMORS,AISA,MAPREC,XLFIL,XDTOL,XSPIV,
  367.      $           IVARI,
  368.      $           INCX,NORMP,LRACOU,
  369.      $           IMPR,IRET)
  370.             IF (IRET.NE.0) GOTO 9999
  371.          ELSEIF (KPREC.EQ.9.OR.KPREC.EQ.10) THEN
  372.             CALL PRILUP(AMORS,AISA,MAPREC,RXILUP,KPREC-9,IMPR,IRET)
  373.             IF (IRET.NE.0) GOTO 9999
  374.          ELSEIF (KPREC.NE.0) THEN
  375.             WRITE(IOIMP,*) 'Erreur de programmation'
  376.             GOTO 9999
  377.          ENDIF
  378.          IF (LTIME) THEN
  379.             call timespv(ittime,oothrd)
  380.             ITI2=(ITTIME(1)+ITTIME(2))/10
  381.          ENDIF
  382. C
  383. C Nettoyage des zéros stockés (utilité ?)
  384. C
  385.          IF (LFIRST) THEN
  386. *            IIMPR=IMPR
  387. *            IMPR=6
  388.             CALL CLMORS(AMORS,AISA,IMPR,IRET)
  389.             IF (IRET.NE.0) GOTO 9999
  390. *            IMPR=IIMPR
  391.          ENDIF
  392. *         SEGPRT, AMORS
  393. *         SEGPRT, AISA
  394. C
  395. C     Résolution itérative proprement dite
  396. C
  397. * Gestion du CTRL-C
  398.          if (ierr.NE.0) return
  399.          IF (LTIME) THEN
  400.             call timespv(ittime,oothrd)
  401.             ITI3=(ITTIME(1)+ITTIME(2))/10
  402.          ENDIF
  403.          INMV=0
  404.          IF (KTYPI.EQ.2) THEN
  405.             CALL PRCG2(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX,
  406.      $           ITER,INMV,RESID,KPREC,BRTOL,ICALRS,IDDOT,IMVEC,
  407.      $           IMPR,IRET)
  408.          ELSEIF (KTYPI.EQ.3) THEN
  409.             LBCG=1
  410.             CALL PRBCGG(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX,
  411.      $           ITER,INMV,RESID,KPREC,BRTOL,LBCG,ICALRS,IDDOT,IMVEC,
  412.      $           IMPR,IRET)
  413.          ELSEIF (KTYPI.EQ.4) THEN
  414.             CALL PRBCGG(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX,
  415.      $           ITER,INMV,RESID,KPREC,BRTOL,LBCG,ICALRS,IDDOT,IMVEC,
  416.      $           IMPR,IRET)
  417.          ELSEIF (KTYPI.EQ.5) THEN
  418.             CALL PRGMR2(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX,
  419.      $           ITER,INMV,RESID,KPREC,IRSTRT,ICALRS,IDDOT,IMVEC,
  420.      $           IMPR,IRET)
  421.          ELSEIF (KTYPI.EQ.6) THEN
  422.             CALL PRCGSN(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX,
  423.      $           ITER,INMV,RESID,KPREC,BRTOL,ICALRS,IDDOT,IMVEC,
  424.      $           IMPR,IRET)
  425.          ELSEIF (KTYPI.EQ.7.OR.KTYPI.EQ.8.OR.KTYPI.EQ.10.OR.KTYPI.EQ.11)
  426.      $           THEN
  427.             CALL INCTYP(MATRIK,IORINC,
  428.      $           ATYP,ANOD,
  429.      $           IMPR,IRET)
  430.             IF (IRET.NE.0) GOTO 9999
  431.             IF (KTYPI.EQ.7) THEN
  432.                NREST=1
  433.             ELSEIF (KTYPI.EQ.8) THEN
  434.                NREST=IRSTRT
  435.             ELSEIF (KTYPI.EQ.10) THEN
  436.                NREST=-1
  437.             ELSEIF (KTYPI.EQ.11) THEN
  438.                NREST=-IRSTRT
  439.             ELSE
  440.                CALL ERREUR(5)
  441.                GOTO 9999
  442.             ENDIF
  443. *            WRITE(IOIMP,*) 'Appel de pragmg'
  444.             CALL PRAGMG(AMORS,ATYP,ANOD,AISA,KS2B,MATRIK,MAPREC,LRES
  445.      $           ,LNMV,INCX,ITER,INMV,RESID,KPREC,NREST,ICALRS,IDDOT
  446.      $           ,IMVEC,KTIME,LTIME,IMPR,IRET)
  447.             SEGSUP ATYP
  448.             SEGSUP ANOD
  449.          ELSEIF (KTYPI.EQ.9) THEN
  450.             CALL PRBCG(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX,
  451.      $           ITER,INMV,RESID,KPREC,BRTOL,ICALRS,IDDOT,IMVEC,
  452.      $           IMPR,IRET)
  453.          ELSE
  454.             WRITE(IOIMP,*) 'KTYPI=',KTYPI,' incorrect'
  455.             GOTO 9999
  456.          ENDIF
  457. * Gestion du CTRL-C
  458.          if (ierr.NE.0) return
  459. C  IRET<0 : 'vrai erreur' ou breakdown (dans le cas de BiCGSTAB)
  460. C  IRET>0 : l'itération n'a pas convergé mais on veut
  461. C           quand meme la solution calculée
  462.          ICVG=IRET
  463.          IF (IRET.GT.0) THEN
  464.             WRITE(IOIMP,*) 'Convergence to tolerance not achieved : ',
  465.      $           'ITER=',ITER,' INMV=',INMV,' RESID=',RESID
  466.          ELSEIF (IRET.EQ.0) THEN
  467.             IF (IMPR.GT.0) THEN
  468.                WRITE(IOIMP,*) 'ITER=',ITER,' INMV=',INMV,' RESID=',RESID
  469.             ENDIF
  470.          ELSEIF (IRET.LT.0) THEN
  471.             WRITE(IOIMP,*) 'Error or breakdown in iterative method'
  472.             GOTO 9999
  473.          ENDIF
  474.          IF (LTIME) THEN
  475.             call timespv(ittime,oothrd)
  476.             ITI4=(ITTIME(1)+ITTIME(2))/10
  477.             ITP=ITI2-ITI1
  478.             ITR=ITI4-ITI3
  479.             CHARI='PRECONDI'
  480.             CALL ECCTAB(KTIME,'MOT     ',IVALI,XVALI,CHARI,LOGII,IRETI,
  481.      $                        'ENTIER  ',ITP,XVALR,CHARR,LOGIR,IRETR)
  482.             CHARI='RESOLUTI'
  483.             CALL ECCTAB(KTIME,'MOT     ',IVALI,XVALI,CHARI,LOGII,IRETI,
  484.      $                     'ENTIER  ',ITR,XVALR,CHARR,LOGIR,IRETR)
  485.          ENDIF
  486.       ELSE
  487.          WRITE(IOIMP,*) 'KTYPI=',KTYPI,' invalide (1..',NBTYPI,')'
  488.          GOTO 9999
  489.       ENDIF
  490.       IF (ISCAL.GT.0) THEN
  491. C
  492. C On dénorme le vecteur solution : attention modification...
  493. C
  494.          CALL NORMV2(INCX,NORMP,IMPR,IRET)
  495.          IF (IRET.NE.0) GOTO 9999
  496.          IF (LRACOU) THEN
  497.             SEGACT MATRIK*MOD
  498.             MATRIK.KKMMT(4)=NORMP
  499.             MATRIK.KKMMT(5)=NORMD
  500.             SEGDES MATRIK
  501.          ENDIF
  502.       ENDIF
  503. C
  504. C Transformation du vecteur-solution en chpoint
  505. C
  506.       CALL XDISP(MATRIK,INCX,MCHSOL,IMPR,IRET)
  507.       IF (IRET.NE.0) GOTO 9999
  508. C
  509. C Suppression des objets temporaires
  510. C
  511.       IF (LRACOU) THEN
  512.             SEGACT MATRIK*MOD
  513.             MATRIK.KIDMAT(4)=AMORS
  514.             MATRIK.KIDMAT(5)=AISA
  515.             SEGDES MATRIK
  516.       ELSE
  517.          SEGSUP,AMORS
  518.          SEGSUP,AISA
  519.       ENDIF
  520.       SEGSUP INCX
  521.       SEGSUP KS2B
  522. *
  523. * Normal termination
  524. *
  525.       IRET=0
  526.       RETURN
  527. *
  528. * Format handling
  529. *
  530. *
  531. * Error handling
  532. *
  533.  9999 CONTINUE
  534.       IRET=1
  535.       WRITE(IOIMP,*) 'An error was detected in kres5.eso'
  536.       RETURN
  537. *
  538. * End of KRES5
  539. *
  540.       END
  541.  
  542.  

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