Télécharger la plaquette Cast3M


fr en

Télécharger kres2.eso

Retour à la liste

Numérotation des lignes : 

kres2

  1. C KRES2     SOURCE    GOUNAND   22/08/25    21:15:05     11434          
  2.       SUBROUTINE KRES2()
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C*************************************************************************
  6. C     Operateur KRES
  7. C
  8. C     OBJET   : Resoud l'equation AX=B par différentes méthodes
  9. C               * directe (factorisation Choleski)
  10. C               * itérative (Gradient conjugué, BiCGSTAB,
  11. C                 GMRES(m)) avec différents préconditionneurs
  12. C                 diagonal (Jacobi), D-ILU, ILU(0) (Choleski
  13. C                 incomplet), MILU(0)
  14. C     SYNTAXE :   CHPO3 = KRES MA1 'TYPI' TAB1
  15. C                                  'CLIM' CHPO1
  16. C                                  'SMBR' CHPO2
  17. C                                  'IMPR' VAL1   ;
  18. C     Voir la notice pour plus de précisions.
  19. C
  20. C***********************************************************************
  21. C APPELES          : KRES3, KRES4, KRES5
  22. C APPELES (E/S)    : LIROBJ, ECROBJ, ERREUR, LIRMOT, LIRENT, LIRTAB,
  23. C                    ACME, ACMO, ACMM, ACMF, ECMO
  24. C APPELES (UTIL.)  : QUETYP
  25. C APPELE PAR       : KOPS
  26. C***********************************************************************
  27. C***********************************************************************
  28. C HISTORIQUE : 26/10/98 : prise en compte du cas particulier
  29. C              où A est diagonale. C'est en fait assez pénible
  30. C              car on utilise le CHPOINT comme structure de
  31. C              données pour la matrice A et les vecteurs X,B,CLIM
  32. C HISTORIQUE : 09/02/99 : on peut utiliser le préconditionnement d'une
  33. C                         autre matrice que celle que l'on inverse
  34. C HISTORIQUE : 01/06/99 : on modifie la partie résolution itérative
  35. C                         en effet, lors de l'imposition des CL. de
  36. C                         Dirichlet, on changeait les valeurs de la
  37. C                         matrice Morse.
  38. C                         Ceci n'est pas bon lorsqu'on veut utiliser la
  39. C                         matrice assemblée pour plusieurs pas de temps.
  40. C                         On travaille maintenant sur une copie.
  41. C HISTORIQUE : 20/12/99 :  reprogrammation de l'assemblage
  42. C      Le nouvel assemblage n'est, pour l'instant effectif que
  43. C      lorsqu'une méthode itérative est sélectionnée (-> fabrication
  44. C      d'une matrice Morse). Le nouvel assemblage est plus performant
  45. C      (temps de calcul, utilisation de la mémoire) et plus général (cas
  46. C      particuliers à peu près supprimés) que le précédent.
  47. C HISTORIQUE : 05/01/00 : On ne supprime plus les 0.D0 de la matrice
  48. C      assemblée (cf. clmors appelé par melim). Ceci pour ne plus avoir
  49. C      perte éventuelle de symétrie de la matrice assemblée. Cela permet
  50. C      aussi de ne plus dupliquer la matrice assemblée.
  51. C HISTORIQUE : 13/01/00 : Mise en conformité du solveur direct avec le
  52. C      nouvel assemblage.
  53. C HISTORIQUE : 22/03/00 : Rajout des préconditionneurs ILUT
  54. C HISTORIQUE : 13/04/00 : Séparation Lecture des données
  55. C                                    Ecriture des résultats (kres2)
  56. C                         Assemblage            kres3
  57. C                         Méthode directe       kres4
  58. C                         Méthodes itératives   kres5
  59. C HISTORIQUE : 06/04/04 : Renumérotation (double mult.)
  60. C HISTORIQUE : 06/04/04 : Scaling
  61. C HISTORIQUE : 08/04/04 : ajout ILUTP
  62. C HISTORIQUE : 09/02/06 : ajout nb prod matrice vecteur (NMATVEC)
  63. C                         simplification du code
  64. C HISTORIQUE : 22/02/06 : Gros nettoyage au niveau de l'entrée des
  65. C                         arguments (Nouvelle syntaxe)
  66. C HISTORIQUE : 08/2011  : En vue de la suppression de l'objet MATRIK
  67. C                         on utilise l'assemblage de RESOU.
  68. C HISTORIQUE : 04/2019  : remplacement de NOEL par NELIM
  69. C     Idéalement, il faudrait reprendre ce que Pierre a fait dans
  70. C     RESOU dans les fiches 10[0,1]?? et avec MREM.En vue de la
  71. C     suppression de l'objet MATRIK
  72. C
  73. C***********************************************************************
  74. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  75. C en cas de modification de ce sous-programme afin de faciliter
  76. C la maintenance !
  77. C***********************************************************************
  78.  
  79. -INC PPARAM
  80. -INC CCOPTIO
  81. -INC SMLREEL
  82.       POINTEUR LRES.MLREEL
  83. -INC SMLENTI
  84.       POINTEUR LNMV.MLENTI
  85. -INC SMCHPOI
  86.       POINTEUR KCLIM.MCHPOI
  87.       POINTEUR KSMBR.MCHPOI
  88.       POINTEUR MCHINI.MCHPOI
  89.       POINTEUR MCHSOL.MCHPOI
  90. -INC SMTABLE
  91.       POINTEUR MTINV.MTABLE
  92.       POINTEUR KTIME.MTABLE
  93.       DIMENSION ITTIME(4)
  94.       CHARACTER*8 CHARI
  95. *  MATRIK est la matrice à inverser
  96. *  MAPREC est la matrice dont on utilise le préconditionnement
  97. *  MATASS est la matrice dont on utilise l'assemblage
  98. *         pour préconditionner celui de MATRIK
  100.       POINTEUR MAPREC.MATRIK
  101.       POINTEUR MATASS.MATRIK
  102. *STAT -INC SMSTAT
  103. C
  104.       CHARACTER*8 TYPE
  105. *     Paramètre m du GMRES(m)
  106.       INTEGER RESTRT
  107.       INTEGER ITER
  108.       REAL*8 BRTOL,RESID,RXMILU,RXILUP
  109. *
  110.       REAL*8 XLFIL,XDTOL
  111.       INTEGER KPREC
  112.       INTEGER NMATRI
  113.       INTEGER IP,KTYPI
  114.       INTEGER IMPINV,IIMPR
  115.       CHARACTER*4 MRENU,MMULAG
  116.       LOGICAL LRIG,LTIME,LDETR,LDEPE,LASRIG,LDMULT,LOGII
  117.       INTEGER IMPR,IRET
  118. C
  119. C  Lecture des arguments et mise à défaut des optionnels ()
  120. C
  121. C  MATRIK : La matrice lue en entrée au format MATRIK
  122. C  MTINV  : L'éventuelle table d'inversion (obsolète)
  123. C  IMPR   : Niveau d'impression solveur direct
  124. C  KCLIM  : Chpoint éventuel de conditions aux limites de Dirichlet
  125. C  KSMBR  : Chpoint second membre
  126. C  KTYPI  : Type de méthode de résolution
  127. C  MATASS : Matrice utilisée pour préconditionner l'assemblage
  128. C  MAPREC : Matrice utilisée pour préconditionner la construction du
  129. C           préconditionneur
  130. C  MRENU  : Type de renumérotation
  131. C  MMULAG : Placement des multiplicateurs de Lagrange
  132. C  ISCAL  : Scaling de la matrice
  133. C  IOUBL  : Oubli des matrices élémentaires ?
  134. C  IMPINV : Niveau d'impression solveur itératif
  135. C  MCHINI : Chpoint estimation de l'inconnue
  136. C  ITER   : Nombre maxi d'itérations à effectuer
  137. C  RESID  : Norme L2 maxi du résidu
  138. C  BRTOL  : Breakdown tolerance pour les méthodes de type Bi-CG
  139. C  IRSTRT : Paramètre m de redémarrage pour GMRES
  140. C  KPREC  : Type du préconditionneur
  141. C  RXMILU : Paramètre de relaxation pour MILU(0)
  142. C  RXILUP : Paramètre de filtre pour ILU(0)-PV
  143. C  XLFIL  : Paramètre de remplissage pour les préconditionneurs ILUT
  144. C  XDTOL  : Drop tolerance pour les préconditionneurs ILUT
  145. C  XSPIV  : Sensibilité du pivoting pour les préconditionneurs ILUTP
  146. C  LBCG   : le l dans BicgStab(l)
  147. C  ICALRS : façon de calculer le résidu
  148. C  METASS : Méthode d'assemblage
  149. C  LTIME  : construit une table avec des statistiques temporelles
  150. C           si vrai
  151. C  LDEPE  : élimine les dépendances si VRAI
  152. C           et matrice d'entrée RIGIDITE
  153. C  IDDOT  : 0 => utilisation du produit scalaire normal dans les
  154. C                méthodes itératives
  155. C           1 => utilisation du produit scalaire compensé
  156. *      IMPR=4
  157.  
  158.       IVALI=0
  159.       XVALI=0.D0
  160.       LOGII=.FALSE.
  161.       IRETI=0
  162.       XVALR=0.D0
  163. *inutile      IOBRE=0
  164.       IRETR=0
  165.  
  166.       IMPR=0
  167. *      WRITE(IOIMP,*) 'coucou kres2'
  168. *
  169. *STAT       CALL INMSTA(MSTAT,IMPR)
  170. *
  171.       CALL PRKRES(MATRIK,MTINV,IMPR,KCLIM,KSMBR,KTYPI,MATASS,MAPREC,
  172.      $     MRENU,MMULAG,ISCAL,INORMU,IOUBL,IMPINV,MCHINI,ITER,RESID
  173.      $     ,BRTOL,IRSTRT,KPREC,RXMILU,RXILUP,XLFIL,XDTOL,XSPIV,LBCG
  174.      $     ,ICALRS,METASS,LTIME,LDEPE,MRIGID,IDDOT,IMVEC,IRET)
  175.       IF (IRET.NE.0) GOTO 9999
  176.       IMPR=MAX(IMPR,IMPINV)
  177. *
  178. * Préparation de la matrice et du second membre
  179. * suivant les cas
  180. *
  181. * LASRIG=.TRUE. on utilise l'assemblage de RESOU
  182. * LDMULT=.TRUE. on dédouble les multiplicateurs de Lagrange
  183. * LDEPE=.TRUE. On fait l'élimination des relations
  184.  
  185.       LASRIG=(METASS.EQ.6)
  186. *     Pour l'instant, il faut toujours dédoubler les multiplicateurs
  187. *     quand on assemble avec l'assemblage de RESO car le traitement des
  188. *     multiplicateurs dans ldmt1 l'impose (simple multiplicateur non
  189. *     prévu)
  190.       LDMULT=LASRIG
  191.       MRIGI0=MRIGID
  192. * Nouveau separm gère la non élimination avec NOEL
  193.       IF (LDEPE) then
  194. *     noel=0
  195.          nelim=1
  196.       ELSE
  197. *     noel=1
  198.          nelim=0
  199.       ENDIF
  200. *dbg      write(ioimp,*) 'LASRIG=',LASRIG
  201. *dbg      write(ioimp,*) 'LDMULT=',LDMULT
  202. *dbg      write(ioimp,*) 'LDEPE=',LDEPE,' NELIM=',NELIM
  203.  
  204.       IF (MRIGID.NE.0) THEN
  205. *old         IF (LDEPE) THEN
  206.             KSMBR0=KSMBR
  207. *old            CALL KRES6(MRIGID,KSMBR,IDEPE,
  208. *old     $           MRIGIC,KSMBRC,KSMBR0,KSMBR1)
  209.             CALL KRES6(MRIGID,KSMBR,LDMULT,NELIM,
  210.      $           MRIGIC,KSMBRC,KSMBR1)
  211.             IF (IERR.NE.0) RETURN
  212.             MRIGID=MRIGIC
  213.             KSMBR=KSMBRC
  214. *old         ENDIF
  215.          IF (LASRIG) THEN
  216. * Gestion de la normalisation
  217.             NORICO=NORINC
  218.             NORIDO=NORIND
  219.             IF (ISCAL.EQ.0) THEN
  220.                NORINC=0
  221.                NORIND=0
  222.             ELSE
  223.                NORINC=-1
  224.                NORIND=0
  225.             ENDIF
  226. * Gestion de la renumérotation
  227.             NUCROO=NUCROU
  228.             IF (MRENU.EQ.'RIEN') THEN
  229.                NUCROU=-1
  230. * La renumérotation sera en fait Reverse Cuthill-McKee dans NUMOPT
  231.             ELSEIF (MRENU.EQ.'SLOA') THEN
  232.                NUCROU=1
  233. * La renumérotation sera en fait Nested Dissection dans NUMOPT
  234.             ELSEIF (MRENU.EQ.'GIPR'.OR.MRENU.EQ.'GIBA') THEN
  235.                NUCROU=2
  236.             ELSE
  237.                WRITE(IOIMP,*) 'MRENU=',MRENU
  238.                CALL ERREUR(5)
  239.                RETURN
  240.             ENDIF
  241.             CALL KRES8(MRIGID,KSMBR,INORMU,
  242.      $           KTYPI,ITER,RESID,ICALRS,IRSTRT,LBCG,BRTOL,IDDOT,IMVEC,
  243.      $           KPREC,RXMILU,RXILUP,XLFIL,XDTOL,XSPIV,
  244.      $           KTIME,LTIME,
  245.      $           MCHSOL,LRES,LNMV,ICVG,IMPR)
  246.             IF (IERR.NE.0) RETURN
  247. * Gestion de la normalisation
  248.             NORINC=NORICO
  249.             NORIND=NORIDO
  250.             NUCROU=NUCROO
  251.             IF (LTIME) CALL ECROBJ('TABLE   ',KTIME)
  252.             IF (MTINV.NE.0) THEN
  253.                CALL ECMO(MTINV,'CVGOK','ENTIER',ICVG)
  254.                IF (LRES.NE.0) CALL ECMO(MTINV,'CONVINV','LISTREEL',LRES)
  255.                IF (LNMV.NE.0) CALL ECMO(MTINV,'NMATVEC','LISTENTI',LNMV)
  256.             ENDIF
  257. * On décondense si nécessaire
  258. *
  259. *            write (6,*) ' resou - mchsol '
  260. *            call ecchpo(mchsol,0)
  261. *            call mucpri(mchsol,mrigid,iresi)
  262. *            write (6,*) ' kres - iresi '
  263. *            call ecchpo(iresi,0)
  264. *      WRITE(IOIMP,*) 'Avant KRES7'
  265. *old            IF (MRIGI0.NE.0.AND.LDEPE) THEN
  266.             IF (MRIGI0.NE.0) THEN
  267.                MSOLC=MCHSOL
  268.                IDTARG=1
  269. * On détruit MSOLC dans KRES7
  270.                CALL KRES7(MSOLC,MRIGI0,KSMBR0,KSMBR1,IDTARG,
  271.      $              MCHSOL)
  272.                IF (IERR.NE.0) RETURN
  273.             ENDIF
  274.             CALL ECROBJ('CHPOINT ',MCHSOL)
  275.             RETURN
  276.          ELSE
  277.             CALL ECROBJ('RIGIDITE',MRIGID)
  278.             CALL RIMA
  279.             IF (IERR.NE.0) GOTO 9999
  280.             CALL MACHI2(1)
  281.             IF (IERR.NE.0) GOTO 9999
  282.             CALL LIROBJ('MATRIK',MATRIK,1,IRET)
  283.             IF(IRET.EQ.0) GOTO 9999
  284.  
  285. * Changement des noms d'inconnues du second membre
  286.             IF (KSMBR.NE.0) THEN
  287.                CALL ECROBJ('CHPOINT ',KSMBR)
  288.                CALL MACHI2(1)
  289.                CALL LIROBJ('CHPOINT ',KSMBR,1,IRET)
  290.                IF (IRET.EQ.0) GOTO 9999
  291.             ENDIF
  292.          ENDIF
  293. *         write (6,*) ' le vecteur  2'
  294. *         call ecchpo(ksmbr,0)
  295. *         write (6,*) ' la matrice  2'
  296. *         call ecrent(5)
  297. *         call ecmatk(matrik)
  298.       ENDIF
  299. *
  300.       SEGACT MATRIK
  301.       NMATRI=IRIGEL(/2)
  302.       IF(NMATRI.EQ.0)THEN
  303. C% Résolution impossible : la matrice de RIGIDITE est vide
  304.          CALL ERREUR(727)
  305.          RETURN
  306.       ENDIF
  307.       SEGDES MATRIK
  308.       IF (MATASS.EQ.0) MATASS=MATRIK
  309.       IF (MAPREC.EQ.0) MAPREC=MATRIK
  310. *      WRITE(IOIMP,*) 'Sortie de prkres'
  311. *      WRITE(IOIMP,*) 'IOUBL=',IOUBL
  312. C
  313.       IF (LTIME) THEN
  314.          CALL CRTABL(KTIME)
  315.          call timespv(ittime,oothrd)
  316.          ITI1=(ITTIME(1)+ITTIME(2))/10
  317.       ELSE
  318.          KTIME=0
  319.       ENDIF
  320. *STAT       CALL PRMSTA('Lectures',MSTAT,IMPR)
  321. *
  322. C
  323. C Assemblage proprement dit
  324. C
  325.       IIMPR=0
  326.       CALL KRES3(MATRIK,MATASS,MRENU,MMULAG,METASS,
  327.      $     KTIME,LTIME,
  328.      $     IIMPR,IRET)
  329. * Gestion du CTRL-C
  330.       if (ierr.NE.0) return
  331.       IF (IRET.NE.0) GOTO 9999
  332. *!      WRITE(IOIMP,*) 'Aprés assemblage'
  333. *!      CALL ECRENT(5)
  334. *!      CALL ECROBJ('MATRIK  ',MATRIK)
  335. *!      CALL PRLIST
  336.       IF (LTIME) THEN
  337.          call timespv(ittime,oothrd)
  338.          ITI2=(ITTIME(1)+ITTIME(2))/10
  339.       ENDIF
  340. *STAT       CALL PRMSTA('Assemblage',MSTAT,IMPR)
  341. *
  342. * "Oubli" des valeurs des matrice élémentaires
  343. * On met les tableaux de LIZAFM à 0 => à MENAGE de les supprimmer
  344. * si besoin est.
  345. *
  346.       IOUBD=MOD(IOUBL,10)
  347. *!      WRITE(IOIMP,*) 'IOUBD=',IOUBD
  348.       IF (IOUBD.EQ.1) THEN
  349.          CALL OUBIMA(MATRIK,IMPR,IRET)
  350.          IF (IRET.NE.0) GOTO 9999
  351.          IF (IMPR.GT.2) THEN
  352.             WRITE(IOIMP,*) 'Oubli des mat. elem.'
  353.          ENDIF
  354.       ELSEIF (IOUBD.EQ.2) THEN
  355.          call ooohor(0)
  356.          SEGACT MATRIK*MOD
  357.          LDETR=.FALSE.
  358.          NMATE=IRIGEL(/2)
  359.          DO IMATE=1,NMATE
  360.             IMATRI=IRIGEL(4,IMATE)
  361.             SEGACT IMATRI*MOD
  362.             NSOUM =LIZAFM(/1)
  363.             NTOTIN=LIZAFM(/2)
  364.             DO ITOTIN=1,NTOTIN
  365.                DO ISOUM=1,NSOUM
  366.                   IZAFM=LIZAFM(ISOUM,ITOTIN)
  367.                   IF (IZAFM.NE.0) THEN
  368.                      LDETR=.TRUE.
  369.                      SEGSUP IZAFM
  370.                      LIZAFM(ISOUM,ITOTIN)=0
  371.                   ENDIF
  372.                ENDDO
  373.             ENDDO
  374.             SEGDES IMATRI
  375.          ENDDO
  376.          IF (IMPR.GT.2.AND.LDETR) THEN
  377.             WRITE(IOIMP,*) 'Destruction des mat. elem.'
  378.          ENDIF
  379.       ELSEIF (IOUBD.NE.0) THEN
  380.          WRITE(IOIMP,*) 'IOUBL=',IOUBL, ' non prevu'
  381.          GOTO 9999
  382.       ENDIF
  383. *STAT       CALL PRMSTA('Oubli',MSTAT,IMPR)
  384. *!      WRITE(IOIMP,*) 'Aprés oubli'
  385. C
  386. C Méthode directe
  387. C
  388.       IF (KTYPI.EQ.1) THEN
  389.          CALL KRES4(MATRIK,KCLIM,KSMBR,
  390.      $        ISCAL,
  391.      $        MCHSOL,
  392.      $        IMPR,IRET)
  393.          if (ierr.ne.0) return
  394.          IF (IRET.NE.0) GOTO 9999
  395. *STAT       CALL PRMSTA('Methode directe',MSTAT,IMPR)
  396. C
  397. C Méthodes itératives
  398. C
  399.       ELSE
  400. C
  401.          CALL KRES5(MATRIK,KCLIM,KSMBR,KTYPI,
  402.      $        MCHINI,ITER,RESID,
  403.      $        BRTOL,IRSTRT,LBCG,ICALRS,
  404.      $        MAPREC,KPREC,
  405.      $        RXMILU,RXILUP,XLFIL,XDTOL,XSPIV,
  406.      $        ISCAL,
  407.      $        KTIME,LTIME,IDDOT,IMVEC,
  408.      $        MCHSOL,LRES,LNMV,ICVG,
  409.      $        IMPR,IRET)
  410.          if (ierr.ne.0) return
  411.          IF (IRET.NE.0) GOTO 9999
  412. *STAT       CALL PRMSTA('Methode iterative',MSTAT,IMPR)
  413.          IF (MTINV.NE.0) THEN
  414.             CALL ECMO(MTINV,'CVGOK','ENTIER',ICVG)
  415.             CALL ECMO(MTINV,'CONVINV','LISTREEL',LRES)
  416.             CALL ECMO(MTINV,'NMATVEC','LISTENTI',LNMV)
  417.          ENDIF
  418.       ENDIF
  419.       IF (LTIME) THEN
  420.          call timespv(ittime,oothrd)
  421.          ITI3=(ITTIME(1)+ITTIME(2))/10
  422.          CHARI='ASS+RENU'
  423.          CALL ECCTAB(KTIME,'MOT     ',IVALI,XVALI,CHARI,LOGII,IRETI,
  424.      $                     'ENTIER  ',ITI2-ITI1,XVALR,CHARR,LOGIR,IRETR)
  425.          CHARI='PRE+RESO'
  426.          CALL ECCTAB(KTIME,'MOT     ',IVALI,XVALI,CHARI,LOGII,IRETI,
  427.      $                     'ENTIER  ',ITI3-ITI2,XVALR,CHARR,LOGIR,IRETR)
  428.          CHARI='TOTAL   '
  429.          CALL ECCTAB(KTIME,'MOT     ',IVALI,XVALI,CHARI,LOGII,IRETI,
  430.      $                     'ENTIER  ',ITI3-ITI1,XVALR,CHARR,LOGIR,IRETR)
  431.          SEGDES KTIME
  432.          CALL ECROBJ('TABLE   ',KTIME)
  433.       ENDIF
  434.       IOUBE=IOUBL/10
  435. *!      WRITE(IOIMP,*) 'IOUBE=',IOUBE
  436.       IF (IOUBE.GE.1) THEN
  437.          call ooohor(0)
  438.          SEGACT MATRIK*MOD
  439.          IF (IOUBE.EQ.2) THEN
  440.             PMORS=KIDMAT(4)
  441.             IF (PMORS.NE.0) THEN
  442.                IF (IMPR.GT.2) THEN
  443.                   WRITE(IOIMP,*) 'Destruction du profil morse'
  444.                ENDIF
  445.                SEGSUP PMORS
  446.                KIDMAT(4)=0
  447.             ENDIF
  448.          ENDIF
  449.          IZA=KIDMAT(5)
  450.          IF (IZA.NE.0) THEN
  451.             IF (IMPR.GT.2) THEN
  452.                WRITE(IOIMP,*) 'Destruction des valeurs morses'
  453.             ENDIF
  454.             SEGSUP IZA
  455.             KIDMAT(5)=0
  456.          ENDIF
  457.          PMORS=KIDMAT(6)
  458.          IF (PMORS.NE.0) THEN
  459.             IF (IMPR.GT.2) THEN
  460.                WRITE(IOIMP,*) 'Destruction du profil du precon'
  461.             ENDIF
  462.             SEGSUP PMORS
  463.             KIDMAT(6)=0
  464.          ENDIF
  465.          IZA=KIDMAT(7)
  466.          IF (IZA.NE.0) THEN
  467.             IF (IMPR.GT.2) THEN
  468.                WRITE(IOIMP,*) 'Destruction des valeurs du precon'
  469.             ENDIF
  470.             SEGSUP IZA
  471.             KIDMAT(7)=0
  472.          ENDIF
  473.          SEGDES MATRIK
  474.       ELSEIF (IOUBE.NE.0) THEN
  475.          WRITE(IOIMP,*) 'IOUBL=',IOUBL, ' non prevu'
  476.          GOTO 9999
  477.       ENDIF
  478. *
  479. * On décondense si nécessaire
  480. *
  481. *            write (6,*) ' resou - mchsol '
  482. *            call ecchpo(mchsol,0)
  483. *            call mucpri(mchsol,mrigid,iresi)
  484. *            write (6,*) ' kres - iresi '
  485. *            call ecchpo(iresi,0)
  486. *      WRITE(IOIMP,*) 'Avant KRES7'
  487.       IF (MRIGI0.NE.0.AND.LDEPE) THEN
  488.          MSOLC=MCHSOL
  489. *         CALL KRES7(MRIGID,IDEPE,KSMBR0,KSMBR1,
  490. *     $        MSOLC,
  491. *     $        MCHSOL)
  492.          CALL KRES7(MSOLC,MRIGI0,KSMBR0,KSMBR1,1,
  493.      $        MCHSOL)
  494.          IF (IERR.NE.0) RETURN
  495.       ENDIF
  496.       CALL ECROBJ('CHPOINT ',MCHSOL)
  497. *STAT       CALL SUMSTA(MSTAT,IMPR)
  498. *
  499. * Normal termination
  500. *
  501.       RETURN
  502. *
  503. * Format handling
  504. *
  505. *
  506. * Error handling
  507. *
  508.  9999 CONTINUE
  509.       WRITE(IOIMP,*) 'An error was detected in kres2.eso'
  510. *  153 2
  511. * Opération illicite dans ce contexte
  512.       CALL ERREUR(153)
  513.       RETURN
  514. *
  515. * End of KRES2
  516. *
  517.       END
  518.  
  519.  

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