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

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