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

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