Télécharger la plaquette Cast3M


fr en

Télécharger kres11.eso

Retour à la liste

Numérotation des lignes : 

kres11

  1. C KRES11    SOURCE    GOUNAND   25/04/30    21:15:10     12258          
  2.       SUBROUTINE KRES11(KMORS,KIZA,ISMBR,IPBLOC,
  3.      $           KTYPI,ITER,RESID,ICALRS,IRSTRT,LBCG,BRTOL,IDDOT,IMVEC,
  4.      $           KPREC,RXMILU,RXILUP,XLFIL,XDTOL,XSPIV,
  5.      $           KTIME,LTIME,LDUMP,ISMOOT,
  6.      $           INCX,LRES,LNMV,ICVG,IMPR)
  7.       IMPLICIT REAL*8 (A-H,O-Z)
  8.       IMPLICIT INTEGER (I-N)
  9. C***********************************************************************
  10. C NOM         : KRES11
  11. C DESCRIPTION : - Construction du préconditionneur
  12. C               - Appel des solveurs itératifs
  13. C
  14. C
  15. C LANGAGE     : ESOPE
  16. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  17. C               mél : gounand@semt2.smts.cea.fr
  18. C***********************************************************************
  19. C VERSION    : v1, 29/08/2011, version initiale
  20. C HISTORIQUE : v1, 29/08/2011, création
  21. C HISTORIQUE :
  22. C HISTORIQUE :
  23. C***********************************************************************
  24.  
  25. -INC PPARAM
  26. -INC CCOPTIO
  27. -INC SMLENTI
  28.       POINTEUR LNMV.MLENTI
  29.       POINTEUR IPBLOC.MLENTI
  30. -INC SMLREEL
  31.       POINTEUR LRES.MLREEL
  33.       POINTEUR MAPREC.MATRIK
  34.       POINTEUR AMORS.PMORS
  35.       POINTEUR AIZA.IZA
  36. -INC SMVECTD
  37.       POINTEUR ISMBR.MVECTD
  38.       POINTEUR INCX.MVECTD
  39. C     Tableau de correspondance : entier <-> mot
  40. C     pour le type d'inversion
  41.       INTEGER NBTYPI,LNTYPI
  42.       PARAMETER (NBTYPI=11)
  43.       PARAMETER (LNTYPI=18)
  44.       CHARACTER*(LNTYPI) LTYPI(NBTYPI)
  45. C     Tableau de correspondance : entier <-> mot
  46. C     pour le type de préconditionnement (cas d'une méthode itérative)
  47.       INTEGER NBPREC,LNPREC
  48.       PARAMETER (NBPREC=11)
  49.       PARAMETER (LNPREC=8)
  50.       CHARACTER*(LNPREC) LPREC(NBPREC)
  51. -INC SMTABLE
  52.       POINTEUR KTIME.MTABLE
  53.       DIMENSION ITTIME(4)
  54.       CHARACTER*8 CHARI
  55.       CHARACTER*1 CCOMP
  56.       LOGICAL LTIME,LOGII,LDUMP
  57. C
  58. C Initialisation des tableaux
  59. C
  60.       DATA LTYPI/'Choleski          ',
  61.      $     'Conjugate Gradient',
  62.      $     'BiCGSTAB G        ',
  63.      $     'BiCGSTAB(l) G     ',
  64.      $     'GMRES(m)          ',
  65.      $     'CGS-Neumaier      ',
  66.      $     'Multigrid FCG     ',
  67.      $     'Multigrid GCR(m)  ',
  68.      $     'Bi-CG             ',
  69.      $     'AGMG GCR(m) Stokes',
  70.      $     'AGMG GCR(m) NS    '/
  71. c$$$     $     'CG old            ',
  72. c$$$     $     'BiCGSTAB old      ',
  73. c$$$     $     'GMRES(m) old      ',
  74. c$$$     $     'CGS               ',
  75. c$$$     $     'BiCGSTAB          ',
  76. c$$$     $     'BiCGSTAB(l)       ',
  77. c$$$     $     'BiCGSTAB(l)F      '/
  78.       DATA LPREC/'None    ',
  79.      $     'Jacobi  ',
  80.      $     'D-ILU   ',
  81.      $     'ILU(0)  ',
  82.      $     'MILU(0) ',
  83.      $     'ILUT    ',
  84.      $     'ILUT2   ',
  85.      $     'ILUTP   ',
  86.      $     'ILUTP+0 ',
  87.      $     'ILU0-PV ',
  88.      $     'ILU0-PVf'/
  89.  
  90.       IVALI=0
  91.       XVALI=0.D0
  92.       LOGII=.FALSE.
  93.       IRETI=0
  94.       XVALR=0.D0
  95.       IRETR=0
  96. *
  97. * Executable statements
  98. *
  99. *      WRITE(IOIMP,*) 'Entrée dans kres10.eso'
  100.       ICVG=0
  101. *Debug      IF (KTYPI.EQ.1) KTYPI=3
  102.       IF (KTYPI.LT.2.OR.KTYPI.GT.NBTYPI) THEN
  103.          WRITE(IOIMP,*) 'KTYPI incorrect (2..',NBTYPI,') :',KTYPI
  104.          GOTO 9999
  105.       ENDIF
  106.       IF (KPREC.LT.0.OR.KPREC.GT.NBPREC-1) THEN
  107.          WRITE(IOIMP,*) 'PRECOND ',
  108.      $           'incorrect (0..',NBPREC-1,') :',KPREC
  109.          GOTO 9999
  110.       ENDIF
  111. C
  112. C     Impressions
  113. C
  114.       IF (IMPR.GT.1) THEN
  115.          IF (IDDOT.EQ.0) CCOMP=' '
  116.          IF (IDDOT.EQ.1) CCOMP='c'
  117.          IF (KTYPI.EQ.5.OR.KTYPI.EQ.8.OR.KTYPI.EQ.10.OR.KTYPI.EQ.11)
  118.      $        THEN
  119.             WRITE(IOIMP,*) CCOMP,LTYPI(KTYPI),' (m=',IRSTRT,')'
  120.          ELSEIF (KTYPI.EQ.4) THEN
  121.             WRITE(IOIMP,*) CCOMP,LTYPI(KTYPI),' (l=',LBCG,')'
  122.          ELSE
  123.             WRITE(IOIMP,*) CCOMP,LTYPI(KTYPI)
  124.          ENDIF
  125.          IF (KPREC.EQ.4) THEN
  126.             WRITE(IOIMP,110) ' ',LPREC(KPREC+1),' (r=',RXMILU,')'
  127.  110        FORMAT (3A,D9.2,A)
  128.          ELSEIF (KPREC.GE.5.AND.KPREC.LE.6) THEN
  129.             WRITE(IOIMP,111) ' ',LPREC(KPREC+1),' (lfil=',XLFIL,
  130.      $           ' droptol=',XDTOL,')'
  131.  111        FORMAT (3A,D9.2,A,D9.2,A)
  132.          ELSEIF (KPREC.GE.7.AND.KPREC.LE.8) THEN
  133.             WRITE(IOIMP,112) ' ',LPREC(KPREC+1),' (lfil=',XLFIL,
  134.      $           ' droptol=',XDTOL,' pivtol=',XSPIV,
  135.      $           ')'
  136.  112        FORMAT (3A,D9.2,A,D9.2,A,D9.2,A,I4,A)
  137.          ELSEIF (KPREC.EQ.10) THEN
  138.             WRITE(IOIMP,110) ' ',LPREC(KPREC+1),' (r=',RXILUP,')'
  139.          ELSE
  140.             WRITE(IOIMP,*) LPREC(KPREC+1)
  141.          ENDIF
  142.       ENDIF
  143.       IF (LTIME) THEN
  144.          call timespv(ittime,oothrd)
  145.          ITI1=(ITTIME(1)+ITTIME(2))/10
  146.       ENDIF
  147. C
  148. C               - Construction du préconditionneur (repris sur kres5)
  149. C
  150.       SEGACT ISMBR
  151.       INC=ISMBR.VECTBB(/1)
  152.       NRIGE=0
  153.       NMATRI=0
  154.       NKID=9
  155.       NKMT=7
  156.       SEGINI MAPREC
  157.       MAPREC.KNTTT=INC
  158.       MAPREC.KSYM=2
  159.       NTT=0
  160.       NPT=0
  161.       NBLK=0
  162.       SEGINI IDMAT
  163.       MAPREC.KIDMAT(1)=IDMAT
  164. *
  165. * Gestion du CTRL-C
  166.       if (ierr.NE.0) return
  167.       IF (KPREC.EQ.1) THEN
  168.          CALL MEIDIA(KMORS,KIZA,MAPREC,IMPR,IRET)
  169.          IF (IRET.NE.0) GOTO 9999
  170.       ELSEIF (KPREC.EQ.2) THEN
  171.          CALL PRDILU(KMORS,KIZA,MAPREC,IMPR,IRET)
  172.          IF (IRET.NE.0) GOTO 9999
  173.       ELSEIF (KPREC.EQ.3) THEN
  174.          CALL PRILU0(KMORS,KIZA,MAPREC,IMPR,IRET)
  175.          IF (IRET.NE.0) GOTO 9999
  176.       ELSEIF (KPREC.EQ.4) THEN
  177.          CALL PRMILU(KMORS,KIZA,MAPREC,RXMILU,IMPR,IRET)
  178.          IF (IRET.NE.0) GOTO 9999
  179.       ELSEIF (KPREC.GE.5.AND.KPREC.LE.6) THEN
  180.          IVARI=KPREC-5
  181.          CALL PRILUT(KMORS,KIZA,MAPREC,XLFIL,XDTOL,IVARI,
  182.      $        IMPR,IRET)
  183.          IF (IRET.NE.0) GOTO 9999
  184. *            WRITE(IOIMP,*) 'PRILUT !'
  185. *        ELSEIF (KPREC.GE.7.AND.KPREC.LE.9) THEN
  186.       ELSEIF (KPREC.GE.7.AND.KPREC.LE.8) THEN
  187.          WRITE(IOIMP,*) 'KPREC=',KPREC, 'non dispo'
  188.          GOTO 9999
  189.       ELSEIF (KPREC.EQ.9.OR.KPREC.EQ.10) THEN
  190.          CALL PRILUP(KMORS,KIZA,MAPREC,RXILUP,KPREC-9,IMPR,IRET)
  191.          IF (IRET.NE.0) GOTO 9999
  192.       ELSEIF (KPREC.NE.0) THEN
  193.          WRITE(IOIMP,*) 'Erreur de programmation'
  194.          GOTO 9999
  195.       ENDIF
  196.       IF (LTIME) THEN
  197.          call timespv(ittime,oothrd)
  198.          ITI2=(ITTIME(1)+ITTIME(2))/10
  199.       ENDIF
  200. C      MATRIK=MAPREC
  201. C      SEGACT MATRIK
  202. C      nkid=kidmat(/1)
  203. C      WRITE(IOIMP,*) 'Apres constr precon'
  204. C      WRITE(IOIMP,*) '     MAPREC KIDMAT NKID=',nkid
  205. C      WRITE(IOIMP,2020) (KIDMAT(II),II=1,KIDMAT(/1))
  206. C 2020 FORMAT (20(2X,I12) )
  207. C
  208. C               - Appel des solveurs itératifs
  209. C  Apparemment, le segment MATRIK ne sert qu'à vérifier la symétrie
  210. C  et à construire INCTYP pour le multigrille
  211. C
  212.       NRIGE=0
  213.       NMATRI=0
  214.       NKID=0
  215.       NKMT=0
  216.       SEGINI MATRIK
  217.       IF (KTYPI.NE.2) KSYM=2
  218.       SEGACT ISMBR
  219.       INC=ISMBR.VECTBB(/1)
  220.       SEGINI INCX
  221.       KS2B=ISMBR
  222.       AMORS=KMORS
  223.       AIZA=KIZA
  224. *
  225. * Gestion du CTRL-C
  226.       if (ierr.NE.0) return
  227.       IF (KTYPI.EQ.2) THEN
  228.          CALL PRCG2(AMORS,AIZA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX,
  229.      $        ITER,INMV,RESID,KPREC,BRTOL,ICALRS,IDDOT,IMVEC,
  230.      $        IMPR,IRET)
  231.       ELSEIF (KTYPI.EQ.3) THEN
  232.          LBCG=1
  233.          CALL PRBCGG(AMORS,AIZA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX,
  234.      $        ITER,INMV,RESID,KPREC,BRTOL,LBCG,ICALRS,IDDOT,IMVEC,
  235.      $        IMPR,IRET)
  236.       ELSEIF (KTYPI.EQ.4) THEN
  237.          CALL PRBCGG(AMORS,AIZA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX,
  238.      $        ITER,INMV,RESID,KPREC,BRTOL,LBCG,ICALRS,IDDOT,IMVEC,
  239.      $        IMPR,IRET)
  240.       ELSEIF (KTYPI.EQ.5) THEN
  241. C         WRITE(IOIMP,*) 'ITER=',ITER
  242. C         WRITE(IOIMP,*) 'INMV=',INMV
  243. C         WRITE(IOIMP,*) 'RESID=',RESID
  244. C         WRITE(IOIMP,*) 'KPREC=',KPREC
  245. C         WRITE(IOIMP,*) 'IRSTRT=',IRSTRT
  246. C         WRITE(IOIMP,*) 'ICALRS=',ICALRS
  247. C         WRITE(IOIMP,*) 'IDDOT=',IDDOT
  248.          CALL PRGMR2(AMORS,AIZA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX,
  249.      $        ITER,INMV,RESID,KPREC,IRSTRT,ICALRS,IDDOT,IMVEC,
  250.      $        IMPR,IRET)
  251.       ELSEIF (KTYPI.EQ.6) THEN
  252.          CALL PRCGSN(AMORS,AIZA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX,
  253.      $        ITER,INMV,RESID,KPREC,BRTOL,ICALRS,IDDOT,IMVEC,
  254.      $        IMPR,IRET)
  255.       ELSEIF (KTYPI.EQ.7.OR.KTYPI.EQ.8.OR.KTYPI.EQ.10.OR.KTYPI.EQ.11)
  256.      $           THEN
  257.          IF (KTYPI.EQ.7) THEN
  258.             NRESTS=1
  259.          ELSE
  260.             NRESTS=IRSTRT
  261.          ENDIF
  262. *            WRITE(IOIMP,*) 'Appel de pragmg'
  263.          CALL PRAGMG(AMORS,AIZA,KS2B,IPBLOC,KTYPI,LRES,
  264.      $        LNMV,INCX,ITER,INMV,
  265.      $        RESID,KPREC,
  266.      $        NRESTS,ICALRS,IDDOT,IMVEC,KTIME,LTIME,LDUMP,ISMOOT,
  267.      $        IMPR,IRET)
  268.       ELSEIF (KTYPI.EQ.9) THEN
  269.          CALL PRBCG(AMORS,AIZA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX,
  270.      $        ITER,INMV,RESID,KPREC,BRTOL,ICALRS,IDDOT,IMVEC,
  271.      $        IMPR,IRET)
  272.       ELSE
  273.          WRITE(IOIMP,*) 'KTYPI=',KTYPI,' invalide (1..',NBTYPI,')'
  274.          GOTO 9999
  275.       ENDIF
  276. * Gestion du CTRL-C
  277.       if (ierr.NE.0) return
  278. C  IRET<0 : 'vrai erreur' ou breakdown (dans le cas de BiCGSTAB)
  279. C  IRET>0 : l'itération n'a pas convergé mais on veut
  280. C           quand meme la solution calculée
  281.       ICVG=IRET
  282.       IF (IRET.GT.0) THEN
  283.          WRITE(IOIMP,*) 'Convergence to tolerance not achieved : ',
  284.      $        'ITER=',ITER,' INMV=',INMV,' RESID=',RESID
  285.       ELSEIF (IRET.EQ.0) THEN
  286.          IF (IMPR.GT.0) THEN
  287.             WRITE(IOIMP,*) 'ITER=',ITER,' INMV=',INMV,' RESID=',RESID
  288.          ENDIF
  289.       ELSEIF (IRET.LT.0) THEN
  290.          WRITE(IOIMP,*) 'Error or breakdown in iterative method'
  291.          GOTO 9999
  292.       ELSE
  293.          WRITE(IOIMP,*) 'KTYPI=',KTYPI,' invalide (1..',NBTYPI,')'
  294.          GOTO 9999
  295.       ENDIF
  296.       SEGSUP MATRIK
  297.       IF (LTIME) THEN
  298.          call timespv(ittime,oothrd)
  299.          ITI3=(ITTIME(1)+ITTIME(2))/10
  300.          ITP=ITI2-ITI1
  301.          ITR=ITI3-ITI2
  302.          CHARI='PRECONDI'
  303.          CALL ECCTAB(KTIME,'MOT     ',IVALI,XVALI,CHARI,LOGII,IRETI,
  304.      $        'ENTIER  ',ITP,XVALR,CHARR,LOGIR,IRETR)
  305.          CHARI='RESOLUTI'
  306.          CALL ECCTAB(KTIME,'MOT     ',IVALI,XVALI,CHARI,LOGII,IRETI,
  307.      $        'ENTIER  ',ITR,XVALR,CHARR,LOGIR,IRETR)
  308.       ENDIF
  309. C
  310. C     Destruction du préconditionneur
  311. C
  312.       SEGACT MAPREC
  313.       IDMAT=MAPREC.KIDMAT(1)
  314.       IF (IDMAT.NE.0) THEN
  315.          SEGACT IDMAT
  316.          IZA=IDIAG
  317.          SEGSUP IZA
  318.          SEGSUP IDMAT
  319.       ENDIF
  320.       PMORS=MAPREC.KIDMAT(6)
  321.       IF (PMORS.NE.0) SEGSUP PMORS
  322.       IZA=MAPREC.KIDMAT(7)
  323.       IF (IZA.NE.0) SEGSUP IZA
  324.       SEGSUP MAPREC
  325. *
  326. * Normal termination
  327. *
  328.       RETURN
  329. *
  330. * Format handling
  331. *
  332. *
  333. * Error handling
  334. *
  335.  9999 CONTINUE
  336.       MOTERR(1:8)='KRES11  '
  337.       CALL ERREUR(349)
  338.       RETURN
  339. *
  340. * End of subroutine KRES11
  341. *
  342.       END
  343.  
  344.  

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