Télécharger kres12.eso

Retour à la liste

Numérotation des lignes :

  1. C KRES12 SOURCE PV 16/11/17 22:00:22 9180
  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. POINTEUR AMORS.PMORS
  28. POINTEUR AISA.IZA
  29. -INC SMVECTD
  30. POINTEUR ISMBR.MVECTD
  31. POINTEUR INCX.MVECTD
  32. -INC SMTABLE
  33. POINTEUR KTIME.MTABLE
  34. DIMENSION ITTIME(4)
  35. CHARACTER*8 CHARI
  36. CHARACTER*1 CCOMP
  37. LOGICAL LTIME,LOGII
  38.  
  39. IVALI=0
  40. XVALI=0.D0
  41. LOGII=.FALSE.
  42. IRETI=0
  43. XVALR=0.D0
  44. IOBRE=0
  45. IRETR=0
  46. *
  47. * Executable statements
  48. *
  49. * WRITE(IOIMP,*) 'Entrée dans kres10.eso'
  50. ICVG=0
  51. LNMV=0
  52. LRES=0
  53. AMORS=KMORS
  54. AISA=KIZA
  55. *
  56. IF (LTIME) THEN
  57. CALL TIMESPV(ITTIME)
  58. ITI1=(ITTIME(1)+ITTIME(2))/10
  59. ENDIF
  60. C
  61. C Factorisation LDU de la matrice
  62. C
  63. C On crée quelques infos utilisées par TRIALU
  64. NRIGE=0
  65. NMATRI=0
  66. NKID=9
  67. NKMT=7
  68. SEGINI MATRIK
  69. * Ceci pourrait être optimisé
  70. MATRIK.KSYM=2
  71. NPT=0
  72. NTT=0
  73. NBLK=0
  74. SEGINI IDMAT
  75. MATRIK.KIDMAT(1)=IDMAT
  76. CALL TRIALU(MATRIK,AMORS,AISA,
  77. $ IDMAT,
  78. $ IMPR,IRET)
  79. IF (IRET.NE.0) THEN
  80. ICVG=-1
  81. GOTO 9999
  82. ENDIF
  83. IF (LTIME) THEN
  84. CALL TIMESPV(ITTIME)
  85. ITI2=(ITTIME(1)+ITTIME(2))/10
  86. ENDIF
  87. C
  88. C Obtention de la solution (montée-descente)
  89. C
  90. KS2B=ISMBR
  91. CALL REZOLU(IDMAT,
  92. $ KS2B,
  93. $ IMPR,IRET)
  94. IF (IRET.NE.0) GOTO 9999
  95. INCX=KS2B
  96. *
  97. IF (LTIME) THEN
  98. CALL TIMESPV(ITTIME)
  99. ITI3=(ITTIME(1)+ITTIME(2))/10
  100. ITP=ITI2-ITI1
  101. ITR=ITI3-ITI2
  102. CHARI='FACTORIS'
  103. CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI,
  104. $ 'ENTIER ',ITP,XVALR,CHARR,LOGIR,IRETR)
  105. CHARI='RESOLUTI'
  106. CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI,
  107. $ 'ENTIER ',ITR,XVALR,CHARR,LOGIR,IRETR)
  108. ENDIF
  109. C
  110. C Destruction de la factorisation
  111. C
  112. IF (MATRIK.NE.0) SEGSUP MATRIK
  113. IF (IDMAT.NE.0) SEGSUP IDMAT
  114. C
  115. C Destruction de la matrice Morse
  116. C
  117. IF (INODET.EQ.0) THEN
  118. SEGSUP AMORS
  119. SEGSUP AISA
  120. ENDIF
  121. *
  122. * Normal termination
  123. *
  124. RETURN
  125. *
  126. * Format handling
  127. *
  128. *
  129. * Error handling
  130. *
  131. 9999 CONTINUE
  132. MOTERR(1:8)='KRES12 '
  133. CALL ERREUR(349)
  134. RETURN
  135. *
  136. * End of subroutine KRES12
  137. *
  138. END
  139.  
  140.  
  141.  
  142.  
  143.  
  144.  
  145.  

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