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.  
  54. -INC PPARAM
  55. -INC CCOPTIO
  56. -INC CCREEL
  57. POINTEUR KMORS.PMORS
  58. POINTEUR KISA.IZA
  59. POINTEUR INVPIV.IZA
  60. *
  61. * .. Variables locales
  62. * .. Parameters
  63. REAL*8 ONE ,ZERO
  64. PARAMETER (ONE=1.0D0,ZERO=0.0D0)
  65. * ..
  66. C Nombre de pivots nul
  67. INTEGER NBPIVN
  68. C Nombre de pivots petits
  69. INTEGER NBPIVP
  70. C Nombre de pivots inférieurs à 0
  71. INTEGER NBPIVI
  72. REAL*8 VALPIV
  73. C***
  74. IRET=0
  75. IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans meidia'
  76. NBPIVP=0
  77. C On récupère les segments utiles
  78. SEGACT MATRIK
  79. NTTT =KNTTT
  80. IDMAT=KIDMAT(1)
  81. SEGACT IDMAT
  82. INVPIV=IDIAG
  83. SEGDES IDMAT
  84. SEGDES MATRIK
  85. C Le préconditionneur est-il déjà construit ?
  86. C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  87. C En fait, on surcharge tout le temps INVPIV car IDIAG peut ne pas
  88. C etre nul mais contenir autre chose que le préconditionneur
  89. C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  90. INVPIV=0
  91. C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  92. IF (INVPIV.EQ.0) THEN
  93. C
  94. C On parcourt la matrice a la recherche des indices diagonaux
  95. C
  96. NBVA=NTTT
  97. SEGINI INVPIV
  98. SEGACT KMORS
  99. SEGACT KISA
  100. DO 1 INTTT=1,NTTT
  101. IDEB=KMORS.IA(INTTT)
  102. IFIN=KMORS.IA(INTTT+1)-1
  103. ICOL=IDEB
  104. IF (IDEB.LE.IFIN) THEN
  105. C On cherche le terme Aii
  106. 11 CONTINUE
  107. IF (KMORS.JA(ICOL).LT.INTTT.AND.ICOL.LT.IFIN) THEN
  108. ICOL=ICOL+1
  109. GOTO 11
  110. ENDIF
  111. C On ne l'a pas trouvé
  112. IF (KMORS.JA(ICOL).NE.INTTT) THEN
  113. WRITE(IOIMP,*) 'diag.',INTTT,'inexistante'
  114. WRITE(IOIMP,*) 'le préconditionnement par la diag.'
  115. WRITE(IOIMP,*) 'est impossible.'
  116. IRET=-1
  117. GOTO 9999
  118. ELSE
  119. C On l'a trouvé
  120. VALPIV=KISA.A(ICOL)
  121. IF (VALPIV.LT.XPETIT) THEN
  122. NBPIVP=NBPIVP+1
  123. VALPIV=ONE
  124. ENDIF
  125. INVPIV.A(INTTT)=ONE/VALPIV
  126. ENDIF
  127. ELSE
  128. WRITE(IOIMP,*) 'Ligne',INTTT,'vide'
  129. WRITE(IOIMP,*) 'le préconditionnement par la diag.'
  130. WRITE(IOIMP,*) 'est impossible.'
  131. IRET=-3
  132. GOTO 9999
  133. ENDIF
  134. 1 CONTINUE
  135. *
  136. * Warning(s)
  137. *
  138. IF (NBPIVP.GT.0) THEN
  139. IF (IMPR.GT.1) THEN
  140. WRITE(IOIMP,*) 'WARNING !'
  141. WRITE(IOIMP,*) NBPIVP,' |diag.|<',XPETIT
  142. ENDIF
  143. ENDIF
  144.  
  145. IF (IMPR.GT.6) THEN
  146. WRITE(IOIMP,*) 'création du pointeur INVPIV=',INVPIV
  147. IF (IMPR.GT.7) THEN
  148. WRITE(IOIMP,*) 'INVPIV.A(1..',NBVA,')= '
  149. WRITE(IOIMP,1002)(INVPIV.A(II),II=1,NBVA)
  150. ENDIF
  151. ENDIF
  152.  
  153. SEGDES KISA
  154. SEGDES KMORS
  155. SEGDES INVPIV
  156. C
  157. C On stocke l'inverse de la diagonale obtenue
  158. C
  159. SEGACT IDMAT*MOD
  160. IDIAG=INVPIV
  161. SEGDES IDMAT
  162. ELSE
  163. IF (IMPR.GT.6) THEN
  164. WRITE(IOIMP,*) 'Le préconditionneur est déjà construit :'
  165. WRITE(IOIMP,*) 'INVPIV=',INVPIV
  166. IF (IMPR.GT.7) THEN
  167. SEGACT INVPIV
  168. WRITE(IOIMP,*) 'INVPIV.A(1..',NBVA,')= '
  169. WRITE(IOIMP,1002)(INVPIV.A(II),II=1,NBVA)
  170. SEGDES INVPIV
  171. ENDIF
  172. ENDIF
  173. ENDIF
  174. *
  175. * Normal termination
  176. *
  177. RETURN
  178. *
  179. * Format handling
  180. *
  181. 1002 FORMAT(10(1X,1PE11.4))
  182. *
  183. * Error handling
  184. *
  185. 9999 CONTINUE
  186. WRITE(IOIMP,*) 'An error was detected in meidia.eso'
  187. RETURN
  188. *
  189. * End of MEIDIA
  190. *
  191. END
  192.  
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  
  206.  
  207.  

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