Télécharger kres12.eso

Retour à la liste

Numérotation des lignes :

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

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