C KRES12 SOURCE GOUNAND 11/10/07 21:15:51 7149 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 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(6) CHARACTER*8 CHARI CHARACTER*1 CCOMP LOGICAL LTIME * * 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) ITI1=(ITTIME(1)+ITTIME(2)) 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 (IRET.NE.0) THEN ICVG=-1 GOTO 9999 ENDIF IF (LTIME) THEN CALL TIMESPV(ITTIME) ITI2=(ITTIME(1)+ITTIME(2)) ENDIF C C Obtention de la solution (montée-descente) C KS2B=ISMBR CALL REZOLU(IDMAT, $ KS2B, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 INCX=KS2B * IF (LTIME) THEN CALL TIMESPV(ITTIME) ITI3=(ITTIME(1)+ITTIME(2)) 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