Sources Esope | Cast3M

kres12
C KRES12    SOURCE    GOUNAND   22/08/25    21:15:05     11434          
      SUBROUTINE KRES12(KMORS,KIZA,ISMBR,
     $           KTIME,LTIME,
     $           INCX,LRES,LNMV,ICVG,IMPR,INODET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : KRES12
C DESCRIPTION : - Méthode directe
C
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C VERSION    : v1, 13/09/2011, version initiale
C HISTORIQUE : v1, 13/09/2011, création
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
 
-INC PPARAM
-INC CCOPTIO
-INC SMLENTI
      POINTEUR LNMV.MLENTI
      POINTEUR ATYP.MLENTI
-INC SMLREEL
      POINTEUR LRES.MLREEL
-INC SMMATRIK
      POINTEUR AMORS.PMORS
      POINTEUR AISA.IZA
-INC SMVECTD
      POINTEUR ISMBR.MVECTD
      POINTEUR INCX.MVECTD
-INC SMTABLE
      POINTEUR KTIME.MTABLE
      DIMENSION ITTIME(4)
      CHARACTER*8 CHARI
      CHARACTER*1 CCOMP
      LOGICAL LTIME,LOGII
 
      IVALI=0
      XVALI=0.D0
      LOGII=.FALSE.
      IRETI=0
      XVALR=0.D0
      IOBRE=0
      IRETR=0
*
* Executable statements
*
*      WRITE(IOIMP,*) 'Entrée dans kres10.eso'
      ICVG=0
      LNMV=0
      LRES=0
      AMORS=KMORS
      AISA=KIZA
*
      IF (LTIME) THEN
         call timespv(ittime,oothrd)
         ITI1=(ITTIME(1)+ITTIME(2))/10
      ENDIF
C
C Factorisation LDU de la matrice
C
C On crée quelques infos utilisées par TRIALU
      NRIGE=0
      NMATRI=0
      NKID=9
      NKMT=7
      SEGINI MATRIK
* Ceci pourrait être optimisé
      MATRIK.KSYM=2
      NPT=0
      NTT=0
      NBLK=0
      SEGINI IDMAT
      MATRIK.KIDMAT(1)=IDMAT
      CALL TRIALU(MATRIK,AMORS,AISA,
     $     IDMAT,
     $     IMPR,IRET)
      if (ierr.ne.0) return
      IF (IRET.NE.0) THEN
         ICVG=-1
         GOTO 9999
      ENDIF
      IF (LTIME) THEN
         call timespv(ittime,oothrd)
         ITI2=(ITTIME(1)+ITTIME(2))/10
      ENDIF
C
C Obtention de la solution (montée-descente)
C
      KS2B=ISMBR
      CALL REZOLU(IDMAT,
     $     KS2B,
     $     IMPR,IRET)
      if (ierr.ne.0) return
      IF (IRET.NE.0) GOTO 9999
      INCX=KS2B
*
      IF (LTIME) THEN
         call timespv(ittime,oothrd)
         ITI3=(ITTIME(1)+ITTIME(2))/10
         ITP=ITI2-ITI1
         ITR=ITI3-ITI2
         CHARI='FACTORIS'
         CALL ECCTAB(KTIME,'MOT     ',IVALI,XVALI,CHARI,LOGII,IRETI,
     $        'ENTIER  ',ITP,XVALR,CHARR,LOGIR,IRETR)
         CHARI='RESOLUTI'
         CALL ECCTAB(KTIME,'MOT     ',IVALI,XVALI,CHARI,LOGII,IRETI,
     $        'ENTIER  ',ITR,XVALR,CHARR,LOGIR,IRETR)
      ENDIF
C
C Destruction de la factorisation
C
      IF (MATRIK.NE.0) SEGSUP MATRIK
      IF (IDMAT.NE.0) SEGSUP IDMAT
C
C     Destruction de la matrice Morse
C
      IF (INODET.EQ.0) THEN
         SEGSUP AMORS
         SEGSUP AISA
      ENDIF
*
* Normal termination
*
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      MOTERR(1:8)='KRES12  '
      CALL ERREUR(349)
      RETURN
*
* End of subroutine KRES12
*
      END