Télécharger meidia.eso

Retour à la liste

Numérotation des lignes :

  1. C MEIDIA SOURCE PV 16/11/17 22:00:42 9180
  2. SUBROUTINE MEIDIA(KMORS,KISA,MATRIK,IMPR,IRET)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C***********************************************************************
  6. C NOM : MEIDIA
  7. C DESCRIPTION :
  8. C Calcul du préconditionneur "Jacobi" d'une matrice Morse.
  9. C Son calcul est simple : c'est la diagonale de la matrice !
  10. C
  11. C On stocke l'inverse de la diagonale de la matrice
  12. C dans un segment de type
  13. C IZA pointé par IDIAG du segment IDMAT
  14. C pointé par KIDMAT(1) du segment MATRIK.
  15. C (Toujours la réutilisation de l'existant...)
  16. C Si on rencontre une diagonale nulle dans la matrice Morse,
  17. C on affiche un Warning et on stocke 1.D0 dans l'inverse
  18. C du préconditionneur.
  19. C De meme, on affiche un Warning si on rencontre des indices
  20. C très "petits"...
  21. C
  22. C
  23. C LANGAGE : ESOPE
  24. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  25. C mél : gounand@semt2.smts.cea.fr
  26. C***********************************************************************
  27. C APPELES : -
  28. C***********************************************************************
  29. C ENTREES : MATRIK, IMPR, IRET
  30. C ENTREES/SORTIES : -
  31. C SORTIES : INVPIV (IDIAG dans KIDMAT(1) dans MATRIK)
  32. C CODE RETOUR (IRET) : 0 si ok
  33. C <0 si problème
  34. C MATRIK : pointeur sur segment MATRIK de l'include SMMATRIK
  35. C on pioche dedans les informations nécessaires
  36. C (différents pointeurs, nb. de ddl...)
  37. C IMPR : niveau d'impression
  38. C INVPIV : pointeur sur segment IZA de l'include SMMATRIK
  39. C vecteur contenant l'inverse de la diagonale
  40. C de la matrice morse pointée par MATRIK (KIDMAT(4-5))
  41. C***********************************************************************
  42. C VERSION : v1, 01/04/98, version initiale
  43. C HISTORIQUE : v1, 01/04/98, création
  44. C HISTORIQUE : 09/02/98, on ne construit pas le préconditionneur s'il
  45. C existe déjà.
  46. C HISTORIQUE :
  47. C HISTORIQUE :
  48. C***********************************************************************
  49. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  50. C en cas de modification de ce sous-programme afin de faciliter
  51. C la maintenance !
  52. C***********************************************************************
  53. -INC CCOPTIO
  54. -INC CCREEL
  55. POINTEUR KMORS.PMORS
  56. POINTEUR KISA.IZA
  57. POINTEUR INVPIV.IZA
  58. *
  59. * .. Variables locales
  60. * .. Parameters
  61. REAL*8 ONE ,ZERO
  62. PARAMETER (ONE=1.0D0,ZERO=0.0D0)
  63. * ..
  64. C Nombre de pivots nul
  65. INTEGER NBPIVN
  66. C Nombre de pivots petits
  67. INTEGER NBPIVP
  68. C Nombre de pivots inférieurs à 0
  69. INTEGER NBPIVI
  70. REAL*8 VALPIV
  71. C***
  72. IRET=0
  73. IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans meidia'
  74. NBPIVP=0
  75. C On récupère les segments utiles
  76. SEGACT MATRIK
  77. NTTT =KNTTT
  78. IDMAT=KIDMAT(1)
  79. SEGACT IDMAT
  80. INVPIV=IDIAG
  81. SEGDES IDMAT
  82. SEGDES MATRIK
  83. C Le préconditionneur est-il déjà construit ?
  84. C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  85. C En fait, on surcharge tout le temps INVPIV car IDIAG peut ne pas
  86. C etre nul mais contenir autre chose que le préconditionneur
  87. C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  88. INVPIV=0
  89. C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  90. IF (INVPIV.EQ.0) THEN
  91. C
  92. C On parcourt la matrice a la recherche des indices diagonaux
  93. C
  94. NBVA=NTTT
  95. SEGINI INVPIV
  96. SEGACT KMORS
  97. SEGACT KISA
  98. DO 1 INTTT=1,NTTT
  99. IDEB=KMORS.IA(INTTT)
  100. IFIN=KMORS.IA(INTTT+1)-1
  101. ICOL=IDEB
  102. IF (IDEB.LE.IFIN) THEN
  103. C On cherche le terme Aii
  104. 11 CONTINUE
  105. IF (KMORS.JA(ICOL).LT.INTTT.AND.ICOL.LT.IFIN) THEN
  106. ICOL=ICOL+1
  107. GOTO 11
  108. ENDIF
  109. C On ne l'a pas trouvé
  110. IF (KMORS.JA(ICOL).NE.INTTT) THEN
  111. WRITE(IOIMP,*) 'diag.',INTTT,'inexistante'
  112. WRITE(IOIMP,*) 'le préconditionnement par la diag.'
  113. WRITE(IOIMP,*) 'est impossible.'
  114. IRET=-1
  115. GOTO 9999
  116. ELSE
  117. C On l'a trouvé
  118. VALPIV=KISA.A(ICOL)
  119. IF (VALPIV.LT.XPETIT) THEN
  120. NBPIVP=NBPIVP+1
  121. VALPIV=ONE
  122. ENDIF
  123. INVPIV.A(INTTT)=ONE/VALPIV
  124. ENDIF
  125. ELSE
  126. WRITE(IOIMP,*) 'Ligne',INTTT,'vide'
  127. WRITE(IOIMP,*) 'le préconditionnement par la diag.'
  128. WRITE(IOIMP,*) 'est impossible.'
  129. IRET=-3
  130. GOTO 9999
  131. ENDIF
  132. 1 CONTINUE
  133. *
  134. * Warning(s)
  135. *
  136. IF (NBPIVP.GT.0) THEN
  137. IF (IMPR.GT.1) THEN
  138. WRITE(IOIMP,*) 'WARNING !'
  139. WRITE(IOIMP,*) NBPIVP,' |diag.|<',XPETIT
  140. ENDIF
  141. ENDIF
  142.  
  143. IF (IMPR.GT.6) THEN
  144. WRITE(IOIMP,*) 'création du pointeur INVPIV=',INVPIV
  145. IF (IMPR.GT.7) THEN
  146. WRITE(IOIMP,*) 'INVPIV.A(1..',NBVA,')= '
  147. WRITE(IOIMP,1002)(INVPIV.A(II),II=1,NBVA)
  148. ENDIF
  149. ENDIF
  150.  
  151. SEGDES KISA
  152. SEGDES KMORS
  153. SEGDES INVPIV
  154. C
  155. C On stocke l'inverse de la diagonale obtenue
  156. C
  157. SEGACT IDMAT*MOD
  158. IDIAG=INVPIV
  159. SEGDES IDMAT
  160. ELSE
  161. IF (IMPR.GT.6) THEN
  162. WRITE(IOIMP,*) 'Le préconditionneur est déjà construit :'
  163. WRITE(IOIMP,*) 'INVPIV=',INVPIV
  164. IF (IMPR.GT.7) THEN
  165. SEGACT INVPIV
  166. WRITE(IOIMP,*) 'INVPIV.A(1..',NBVA,')= '
  167. WRITE(IOIMP,1002)(INVPIV.A(II),II=1,NBVA)
  168. SEGDES INVPIV
  169. ENDIF
  170. ENDIF
  171. ENDIF
  172. *
  173. * Normal termination
  174. *
  175. RETURN
  176. *
  177. * Format handling
  178. *
  179. 1002 FORMAT(10(1X,1PE11.4))
  180. *
  181. * Error handling
  182. *
  183. 9999 CONTINUE
  184. WRITE(IOIMP,*) 'An error was detected in meidia.eso'
  185. RETURN
  186. *
  187. * End of MEIDIA
  188. *
  189. END
  190.  
  191.  
  192.  
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  

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