Télécharger prbcgg.eso

Retour à la liste

Numérotation des lignes :

  1. C PRBCGG SOURCE PV 16/11/17 22:01:02 9180
  2. SUBROUTINE PRBCGG(KMORS,KISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX,
  3. $ ITER,INMV,RESID,KPREC,
  4. $ BRTOL,LBCG,ICALRS,IDDOT,IMVEC,IMPR,IRET)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM : PRBCGG
  9. C DESCRIPTION :
  10. C Préparation de la résolution d'un système linéaire Ax=b
  11. C par une méthode BiCGSTAB(l) préconditionnée ou non.
  12. C (+ reliable updates)
  13. C LANGAGE : ESOPE
  14. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  15. C mél : gounand@semt2.smts.cea.fr
  16. C REFERENCE (bibtex-like) :
  17. C @BOOK{templates,
  18. C AUTHOR={R.Barrett, M.Berry, T.F.Chan, J.Demmel, J.Donato,
  19. C J.Dongarra, V.Eijkhout, R.Pozo, C.Romine,
  20. C H. Van der Vorst},
  21. C TITLE={Templates for the Solution of Linear Systems :
  22. C Building Blocks for Iterative Methods},
  23. C PUBLISHER={SIAM}, YEAR={1994}, ADDRESS={Philadelphia,PA} }
  24. C -> URL : http://www.netlib.org/templates/Templates.html
  25. C@TechReport{fokkema,
  26. C author = {DR Fokkema},
  27. C title = {Enhanced implementation of BiCGSTAB(l) for solving
  28. C linear systems of equations},
  29. C institution = {?},
  30. C year = {1996}}
  31. C***********************************************************************
  32. C VERSION : v1, 22/02/06, version initiale
  33. C HISTORIQUE : v1, 22/02/06, création
  34. C HISTORIQUE :
  35. C HISTORIQUE :
  36. C***********************************************************************
  37. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  38. C en cas de modification de ce sous-programme afin de faciliter
  39. C la maintenance !
  40. C***********************************************************************
  41. *
  42. * .. Includes et pointeurs associés ..
  43. -INC CCOPTIO
  44. -INC SMLREEL
  45. INTEGER JG
  46. POINTEUR LRES.MLREEL
  47. -INC SMLENTI
  48. POINTEUR LNMV.MLENTI
  49. POINTEUR ITRAV.MLENTI
  50. POINTEUR MAPREC.MATRIK
  51. POINTEUR KMORS.PMORS
  52. POINTEUR KISA.IZA
  53. POINTEUR KS2B.IZA
  54. POINTEUR INCX.IZA
  55. POINTEUR INVDIA.IZA
  56. POINTEUR ILUM.PMORS
  57. POINTEUR ILUI.IZA
  58. * .. Work Vectors for BiCGSTAB(l)
  59. SEGMENT SPACE
  60. REAL*8 IJ(NI,NJ)
  61. ENDSEGMENT
  62. POINTEUR IZ.SPACE,IZM1.SPACE
  63. SEGMENT SPACE2
  64. POINTEUR WRK(NIZA).IZA
  65. ENDSEGMENT
  66. POINTEUR IR.SPACE2,IU.SPACE2
  67. POINTEUR IRTLD.IZA,IXTLD.IZA,IUHAT.IZA,IBP.IZA
  68. POINTEUR IY.IZA,IYP.IZA
  69. POINTEUR ITMP.IZA
  70. * .. Scalar Arguments ..
  71. INTEGER ITER, KPREC, IMPR, IRET
  72. REAL*8 RESID
  73. INTEGER NBVA,NJA,NTT,NTTPRE
  74. * .. Executable Statements ..
  75. *
  76. IRET = 0
  77. *
  78. * On récupère les paramètres
  79. *
  80. SEGACT MATRIK
  81. SEGACT MAPREC
  82. IF (KSYM.EQ.0) THEN
  83. IF (IMPR.GT.2) THEN
  84. WRITE(IOIMP,*) 'MATRIK',MATRIK,'symétrique : ',
  85. $ 'use a Conjugate Gradient instead !'
  86. ENDIF
  87. C IRET=-2
  88. C GOTO 9999
  89. ENDIF
  90. * Pour le préconditionneur
  91. ILUM =MAPREC.KIDMAT(6)
  92. ILUI =MAPREC.KIDMAT(7)
  93. IDMAT=MAPREC.KIDMAT(1)
  94. SEGACT IDMAT
  95. INVDIA=IDIAG
  96. SEGDES IDMAT
  97.  
  98. SEGACT KMORS
  99. NTT =KMORS.IA(/1)-1
  100. * NJA =KMORS.JA(/1)
  101. SEGACT KISA
  102. SEGACT KS2B
  103. SEGACT INCX*MOD
  104. C Paramètres des préconditionnements diagonaux et D-ILU
  105. IF (KPREC.NE.0) THEN
  106. IF (KPREC.EQ.1.OR.KPREC.EQ.2) THEN
  107. C Est-il compatible avec la matrice ?
  108. SEGACT INVDIA
  109. NTTPRE=INVDIA.A(/1)
  110. IF (NTTPRE.NE.NTT) THEN
  111. WRITE(IOIMP,*) 'La matrice et son préconditionnement'
  112. WRITE(IOIMP,*) 'ne sont pas compatibles...'
  113. WRITE(IOIMP,*) 'NTT=',NTT
  114. WRITE(IOIMP,*) 'NTTPRE=',NTTPRE
  115. IRET=-2
  116. GOTO 9999
  117. ENDIF
  118. C Paramètres des préconditionnements ILU(0), MILU(0), ILUT et ILUT2
  119. C ilutp, ilutpg, ilutpg2
  120. ELSEIF (KPREC.GE.3.AND.KPREC.LE.10) THEN
  121. SEGACT ILUM
  122. SEGACT ILUI
  123. NTTPRE=ILUM.IA(/1)
  124. IF (NTTPRE.NE.NTT) THEN
  125. WRITE(IOIMP,*) 'La matrice et son préconditionnement',
  126. $ 'ne sont pas compatibles...'
  127. WRITE(IOIMP,*) 'NTT=',NTT,' NTTPRE=',NTTPRE
  128. IRET=-2
  129. GOTO 9999
  130. ENDIF
  131. ENDIF
  132. ENDIF
  133. C
  134. C Initialisation de l'historique de convergence
  135. C
  136. JG=ITER+1
  137. SEGINI LNMV
  138. SEGINI LRES
  139. C
  140. C
  141. C Initialisation des vecteurs de travail pour BiCGStab(l)
  142. C
  143. NI=LBCG
  144. NJ=LBCG
  145. SEGINI IZ,IZM1
  146. NBVA=LBCG
  147. SEGINI IY,IYP
  148. JG=LBCG
  149. SEGINI ITRAV
  150. NBVA=NTT
  151. SEGINI IRTLD,IXTLD,IUHAT,IBP
  152. NIZA=LBCG+1
  153. SEGINI IR
  154. DO I=1,NIZA
  155. SEGINI ITMP
  156. IR.WRK(I)=ITMP
  157. ENDDO
  158. SEGINI IU
  159. DO I=1,NIZA
  160. SEGINI ITMP
  161. IU.WRK(I)=ITMP
  162. ENDDO
  163. C
  164. CALL BCGG(KMORS,KISA,KS2B,INCX,
  165. $ KPREC,INVDIA,ILUM,ILUI,
  166. $ LRES,LNMV,
  167. $ IRTLD,IXTLD,IUHAT,IR,IU,IZ,IZM1,IY,IYP,IBP,ITRAV,
  168. $ ITER,INMV,BRTOL,LBCG,RESID,ICALRS,IDDOT,IMVEC,IMPR,IRET)
  169. C
  170. C Désactivation-suppression
  171. C
  172. DO I=1,NIZA
  173. ITMP=IU.WRK(I)
  174. SEGSUP ITMP
  175. ENDDO
  176. SEGSUP IU
  177. DO I=1,NIZA
  178. ITMP=IR.WRK(I)
  179. SEGSUP ITMP
  180. ENDDO
  181. SEGSUP IR
  182. SEGSUP IRTLD,IXTLD,IUHAT,IBP
  183. SEGSUP ITRAV
  184. SEGSUP IY,IYP
  185. SEGSUP IZ,IZM1
  186. JG=ITER+1
  187. SEGADJ LRES
  188. SEGDES LRES
  189. SEGADJ LNMV
  190. SEGDES LNMV
  191. IF (KPREC.EQ.1.OR.KPREC.EQ.2) THEN
  192. SEGDES INVDIA
  193. ELSEIF (KPREC.GE.3.AND.KPREC.LE.9) THEN
  194. SEGDES ILUI
  195. SEGDES ILUM
  196. ENDIF
  197. SEGDES INCX
  198. SEGDES KS2B
  199. SEGDES KISA
  200. SEGDES KMORS
  201. SEGDES MAPREC
  202. SEGDES MATRIK
  203. C
  204. C A problem has occured in the GMRES method
  205. C
  206. IF (IRET.LT.0) GOTO 9999
  207. *
  208. * Normal termination
  209. *
  210. RETURN
  211. *
  212. * Format handling
  213. *
  214. *
  215. * Error handling
  216. *
  217. 9999 CONTINUE
  218. WRITE(IOIMP,*) 'An error was detected in prbcgg.eso'
  219. RETURN
  220. *
  221. * End of prbcgg
  222. *
  223. END
  224.  
  225.  
  226.  
  227.  
  228.  
  229.  
  230.  
  231.  
  232.  
  233.  
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  

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