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

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