Esope source files

   1 : C KRES12    SOURCE    GOUNAND   11/10/07    21:15:51     7149           
   2 :       SUBROUTINE KRES12(KMORS,KIZA,ISMBR,
   3 :      $           KTIME,LTIME,
   4 :      $           INCX,LRES,LNMV,ICVG,IMPR,INODET)
   5 :       IMPLICIT REAL*8 (A-H,O-Z)
   6 :       IMPLICIT INTEGER (I-N)
   7 : C***********************************************************************
   8 : C NOM         : KRES12
   9 : C DESCRIPTION : - Méthode directe
  10 : C
  11 : C
  12 : C LANGAGE     : ESOPE
  13 : C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  14 : C               mél : gounand@semt2.smts.cea.fr
  15 : C***********************************************************************
  16 : C VERSION    : v1, 13/09/2011, version initiale
  17 : C HISTORIQUE : v1, 13/09/2011, création
  18 : C HISTORIQUE :
  19 : C HISTORIQUE :
  20 : C***********************************************************************
  21 : -INC CCOPTIO
  22 : -INC SMLENTI
  23 :       POINTEUR LNMV.MLENTI
  24 :       POINTEUR ATYP.MLENTI
  25 : -INC SMLREEL
  26 :       POINTEUR LRES.MLREEL
  27 : -INC SMMATRIK
  28 :       POINTEUR AMORS.PMORS
  29 :       POINTEUR AISA.IZA
  30 : -INC SMVECTD
  31 :       POINTEUR ISMBR.MVECTD
  32 :       POINTEUR INCX.MVECTD
  33 : -INC SMTABLE
  34 :       POINTEUR KTIME.MTABLE
  35 :       DIMENSION ITTIME(6)
  36 :       CHARACTER*8 CHARI
  37 :       CHARACTER*1 CCOMP
  38 :       LOGICAL LTIME
  39 : *     
  40 : * Executable statements
  41 : *
  42 : *      WRITE(IOIMP,*) 'Entrée dans kres10.eso' 
  43 :       ICVG=0
  44 :       LNMV=0
  45 :       LRES=0
  46 :       AMORS=KMORS
  47 :       AISA=KIZA
  48 : *
  49 :       IF (LTIME) THEN
  49 :          CALL TIMESPV(ITTIME)
  50 :          ITI1=(ITTIME(1)+ITTIME(2))
  51 :       ENDIF
  52 : C
  53 : C Factorisation LDU de la matrice
  54 : C
  55 : C On crée quelques infos utilisées par TRIALU
  56 :       NRIGE=0 
  57 :       NMATRI=0
  58 :       NKID=9
  59 :       NKMT=7
  60 :       SEGINI MATRIK
  61 : * Ceci pourrait être optimisé
  62 :       MATRIK.KSYM=2
  63 :       NPT=0
  64 :       NTT=0
  65 :       NBLK=0
  66 :       SEGINI IDMAT
  67 :       MATRIK.KIDMAT(1)=IDMAT
  67 :       CALL TRIALU(MATRIK,AMORS,AISA,
  68 :      $     IDMAT,
  69 :      $     IMPR,IRET)
  70 :       IF (IRET.NE.0) THEN
  71 :          ICVG=-1
  72 :          GOTO 9999
  73 :       ENDIF
  74 :       IF (LTIME) THEN
  74 :          CALL TIMESPV(ITTIME)
  75 :          ITI2=(ITTIME(1)+ITTIME(2))
  76 :       ENDIF
  77 : C
  78 : C Obtention de la solution (montée-descente)
  79 : C
  80 :       KS2B=ISMBR
  80 :       CALL REZOLU(IDMAT,
  81 :      $     KS2B,
  82 :      $     IMPR,IRET)
  83 :       IF (IRET.NE.0) GOTO 9999
  84 :       INCX=KS2B
  85 : *
  86 :       IF (LTIME) THEN
  86 :          CALL TIMESPV(ITTIME)
  87 :          ITI3=(ITTIME(1)+ITTIME(2))
  88 :          ITP=ITI2-ITI1
  89 :          ITR=ITI3-ITI2
  90 :          CHARI='FACTORIS'
  90 :          CALL ECCTAB(KTIME,'MOT     ',IVALI,XVALI,CHARI,LOGII,IRETI,
  91 :      $        'ENTIER  ',ITP,XVALR,CHARR,LOGIR,IRETR)
  92 :          CHARI='RESOLUTI'
  92 :          CALL ECCTAB(KTIME,'MOT     ',IVALI,XVALI,CHARI,LOGII,IRETI,
  93 :      $        'ENTIER  ',ITR,XVALR,CHARR,LOGIR,IRETR)
  94 :       ENDIF
  95 : C
  96 : C Destruction de la factorisation
  97 : C
  98 :       IF (MATRIK.NE.0) SEGSUP MATRIK
  99 :       IF (IDMAT.NE.0) SEGSUP IDMAT
 100 : C
 101 : C     Destruction de la matrice Morse
 102 : C
 103 :       IF (INODET.EQ.0) THEN
 104 :          SEGSUP AMORS
 105 :          SEGSUP AISA
 106 :       ENDIF
 107 : *
 108 : * Normal termination
 109 : *
 110 :       RETURN
 111 : *
 112 : * Format handling
 113 : *
 114 : *
 115 : * Error handling
 116 : *
 117 :  9999 CONTINUE
 118 :       MOTERR(1:8)='KRES12  '
 118 :       CALL ERREUR(349)
 119 :       RETURN
 120 : *
 121 : * End of subroutine KRES12
 122 : *
 123 :       END
 124 : 
 125 :