Télécharger la plaquette Cast3M


fr en

Télécharger prbcgg.eso

Retour à la liste

Numérotation des lignes : 

prbcgg

  1. C PRBCGG    SOURCE    CB215821  25/06/19    21:15:02     12288          
  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.  
  44. -INC PPARAM
  45. -INC CCOPTIO
  46. -INC SMLREEL
  47.       INTEGER JG
  48.       POINTEUR LRES.MLREEL
  49. -INC SMLENTI
  50.       POINTEUR LNMV.MLENTI
  51.       POINTEUR ITRAV.MLENTI
  53.       POINTEUR MAPREC.MATRIK
  54.       POINTEUR KMORS.PMORS
  55.       POINTEUR KISA.IZA
  56.       POINTEUR KS2B.IZA
  57.       POINTEUR INCX.IZA
  58.       POINTEUR INVDIA.IZA
  59.       POINTEUR ILUM.PMORS
  60.       POINTEUR ILUI.IZA
  61. *     .. Work Vectors for BiCGSTAB(l)
  62.       SEGMENT SPACE
  63.       REAL*8  IJ(NI,NJ)
  64.       ENDSEGMENT
  65.       POINTEUR IZ.SPACE,IZM1.SPACE
  66.       SEGMENT SPACE2
  67.       POINTEUR WRK(NIZA).IZA
  68.       ENDSEGMENT
  69.       POINTEUR IR.SPACE2,IU.SPACE2
  70.       POINTEUR IRTLD.IZA,IXTLD.IZA,IUHAT.IZA,IBP.IZA
  71.       POINTEUR IY.IZA,IYP.IZA
  72.       POINTEUR ITMP.IZA
  73. *     .. Scalar Arguments ..
  74.       INTEGER ITER, KPREC, IMPR, IRET
  75.       REAL*8  RESID
  76.       INTEGER NBVA,NJA,NTT,NTTPRE
  77. *     .. Executable Statements ..
  78. *
  79.       IRET = 0
  80. *
  81. * On récupère les paramètres
  82. *
  83.       SEGACT MATRIK
  84.       SEGACT MAPREC
  85.       IF (KSYM.EQ.0) THEN
  86.          IF (IMPR.GT.2) THEN
  87.             WRITE(IOIMP,*) 'MATRIK',MATRIK,'symétrique : ',
  88.      $           'use a Conjugate Gradient instead !'
  89.          ENDIF
  90. C         IRET=-2
  91. C         GOTO 9999
  92.       ENDIF
  93. *     Pour le préconditionneur
  94.       ILUM =MAPREC.KIDMAT(6)
  95.       ILUI =MAPREC.KIDMAT(7)
  96.       IDMAT=MAPREC.KIDMAT(1)
  97.       SEGACT IDMAT
  98.       INVDIA=IDIAG
  99. C      SEGDES IDMAT
  100.  
  101.       SEGACT KMORS
  102.       NTT =KMORS.IA(/1)-1
  103. *      NJA =KMORS.JA(/1)
  104.       SEGACT KISA
  105.       SEGACT KS2B
  106.       SEGACT INCX*MOD
  107. C Paramètres des préconditionnements diagonaux et D-ILU
  108.       IF (KPREC.NE.0) THEN
  109.          IF (KPREC.EQ.1.OR.KPREC.EQ.2) THEN
  110. C     Est-il compatible avec la matrice ?
  111.             SEGACT INVDIA
  112.             NTTPRE=INVDIA.A(/1)
  113.             IF (NTTPRE.NE.NTT) THEN
  114.                WRITE(IOIMP,*) 'La matrice et son préconditionnement'
  115.                WRITE(IOIMP,*) 'ne sont pas compatibles...'
  116.                WRITE(IOIMP,*) 'NTT=',NTT
  117.                WRITE(IOIMP,*) 'NTTPRE=',NTTPRE
  118.                IRET=-2
  119.                GOTO 9999
  120.             ENDIF
  121. C Paramètres des préconditionnements ILU(0), MILU(0), ILUT et ILUT2
  122. C ilutp, ilutpg, ilutpg2
  123.          ELSEIF (KPREC.GE.3.AND.KPREC.LE.10) THEN
  124.             SEGACT ILUM
  125.             SEGACT ILUI
  126.             NTTPRE=ILUM.IA(/1)
  127.             IF (NTTPRE.NE.NTT) THEN
  128.                WRITE(IOIMP,*) 'La matrice et son préconditionnement',
  129.      $              'ne sont pas compatibles...'
  130.                WRITE(IOIMP,*) 'NTT=',NTT,' NTTPRE=',NTTPRE
  131.                IRET=-2
  132.                GOTO 9999
  133.             ENDIF
  134.          ENDIF
  135.       ENDIF
  136. C
  137. C     Initialisation de l'historique de convergence
  138. C
  139.       JG=ITER+1
  140.       SEGINI LNMV
  141.       SEGINI LRES
  142. C
  143. C
  144. C     Initialisation des vecteurs de travail pour BiCGStab(l)
  145. C
  146.       NI=LBCG
  147.       NJ=LBCG
  148.       SEGINI IZ,IZM1
  149.       NBVA=LBCG
  150.       SEGINI IY,IYP
  151.       JG=LBCG
  152.       SEGINI ITRAV
  153.       NBVA=NTT
  154.       SEGINI IRTLD,IXTLD,IUHAT,IBP
  155.       NIZA=LBCG+1
  156.       SEGINI IR
  157.       DO I=1,NIZA
  158.          SEGINI ITMP
  159.          IR.WRK(I)=ITMP
  160.       ENDDO
  161.       SEGINI IU
  162.       DO I=1,NIZA
  163.          SEGINI ITMP
  164.          IU.WRK(I)=ITMP
  165.       ENDDO
  166. C
  167.       CALL BCGG(KMORS,KISA,KS2B,INCX,
  168.      $     KPREC,INVDIA,ILUM,ILUI,
  169.      $     LRES,LNMV,
  170.      $     IRTLD,IXTLD,IUHAT,IR,IU,IZ,IZM1,IY,IYP,IBP,ITRAV,
  171.      $     ITER,INMV,BRTOL,LBCG,RESID,ICALRS,IDDOT,IMVEC,IMPR,IRET)
  172. * Gestion du CTRL-C
  173.       if (ierr.NE.0) return
  174. C
  175. C     Désactivation-suppression
  176. C
  177.       DO I=1,NIZA
  178.          ITMP=IU.WRK(I)
  179.          SEGSUP ITMP
  180.       ENDDO
  181.       SEGSUP IU
  182.       DO I=1,NIZA
  183.          ITMP=IR.WRK(I)
  184.          SEGSUP ITMP
  185.       ENDDO
  186.       SEGSUP IR
  187.       SEGSUP IRTLD,IXTLD,IUHAT,IBP
  188.       SEGSUP ITRAV
  189.       SEGSUP IY,IYP
  190.       SEGSUP IZ,IZM1
  191.       JG=ITER+1
  192.       SEGADJ LRES
  193. C      SEGDES LRES
  194.       SEGADJ LNMV
  195. C      SEGDES LNMV
  196. C      IF (KPREC.EQ.1.OR.KPREC.EQ.2) THEN
  197. C         SEGDES INVDIA
  198. C      ELSEIF (KPREC.GE.3.AND.KPREC.LE.9) THEN
  199. C         SEGDES ILUI
  200. C         SEGDES ILUM
  201. C      ENDIF
  202. C      SEGDES INCX
  203. C      SEGDES KS2B
  204. C      SEGDES KISA
  205. C      SEGDES KMORS
  206. C      SEGDES MAPREC
  207. C      SEGDES MATRIK
  208. C
  209. C     A problem has occured in the GMRES method
  210. C
  211.       IF (IRET.LT.0) GOTO 9999
  212. *
  213. *     Normal termination
  214. *
  215.       RETURN
  216. *
  217. * Format handling
  218. *
  219. *
  220. * Error handling
  221. *
  222.  9999 CONTINUE
  223.       WRITE(IOIMP,*) 'An error was detected in prbcgg.eso'
  224.       RETURN
  225. *
  226. *     End of prbcgg
  227. *
  228.       END
  229.  
  230.  
  231.  

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