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   22/08/25    21:15:04     11434          
  2.       SUBROUTINE KRES11(KMORS,KIZA,KTYP,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. -INC SMLREEL
  31.       POINTEUR LRES.MLREEL
  33.       POINTEUR MAPREC.MATRIK
  34.       POINTEUR AMORS.PMORS
  35.       POINTEUR AISA.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=16)
  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
  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.      $     'CG old            ',
  70.      $     'BiCGSTAB old      ',
  71.      $     'GMRES(m) old      ',
  72.      $     'CGS               ',
  73.      $     'BiCGSTAB          ',
  74.      $     'BiCGSTAB(l)       ',
  75.      $     'BiCGSTAB(l)F      '/
  76.       DATA LPREC/'None    ',
  77.      $     'Jacobi  ',
  78.      $     'D-ILU   ',
  79.      $     'ILU(0)  ',
  80.      $     'MILU(0) ',
  81.      $     'ILUT    ',
  82.      $     'ILUT2   ',
  83.      $     'ILUTP   ',
  84.      $     'ILUTP+0 ',
  85.      $     'ILU0-PV ',
  86.      $     'ILU0-PVf'/
  87.  
  88.       IVALI=0
  89.       XVALI=0.D0
  90.       LOGII=.FALSE.
  91.       IRETI=0
  92.       XVALR=0.D0
  93.       IOBRE=0
  94.       IRETR=0
  95. *
  96. * Executable statements
  97. *
  98. *      WRITE(IOIMP,*) 'Entrée dans kres10.eso'
  99.       ICVG=0
  100. *Debug      IF (KTYPI.EQ.1) KTYPI=3
  101.       IF (KTYPI.LT.2.OR.KTYPI.GT.NBTYPI) THEN
  102.          WRITE(IOIMP,*) 'KTYPI incorrect (2..',NBTYPI,') :',KTYPI
  103.          GOTO 9999
  104.       ENDIF
  105.       IF (KPREC.LT.0.OR.KPREC.GT.NBPREC-1) THEN
  106.          WRITE(IOIMP,*) 'PRECOND ',
  107.      $           'incorrect (0..',NBPREC-1,') :',KPREC
  108.          GOTO 9999
  109.       ENDIF
  110. C
  111. C     Impressions
  112. C
  113.       IF (IMPR.GT.1) THEN
  114.          IF (IDDOT.EQ.0) CCOMP=' '
  115.          IF (IDDOT.EQ.1) CCOMP='c'
  116.          IF (KTYPI.EQ.5.OR.KTYPI.EQ.8) THEN
  117.             WRITE(IOIMP,*) CCOMP,LTYPI(KTYPI),' (m=',IRSTRT,')'
  118.          ELSEIF (KTYPI.EQ.11.OR.KTYPI.EQ.12) THEN
  119.             WRITE(IOIMP,*) CCOMP,LTYPI(KTYPI),' (l=',LBCG,')'
  120.          ELSE
  121.             WRITE(IOIMP,*) CCOMP,LTYPI(KTYPI)
  122.          ENDIF
  123.          IF (KPREC.EQ.4) THEN
  124.             WRITE(IOIMP,110) ' ',LPREC(KPREC+1),' (r=',RXMILU,')'
  125.  110        FORMAT (3A,D9.2,A)
  126.          ELSEIF (KPREC.GE.5.AND.KPREC.LE.6) THEN
  127.             WRITE(IOIMP,111) ' ',LPREC(KPREC+1),' (lfil=',XLFIL,
  128.      $           ' droptol=',XDTOL,')'
  129.  111        FORMAT (3A,D9.2,A,D9.2,A)
  130.          ELSEIF (KPREC.GE.7.AND.KPREC.LE.8) THEN
  131.             WRITE(IOIMP,112) ' ',LPREC(KPREC+1),' (lfil=',XLFIL,
  132.      $           ' droptol=',XDTOL,' pivtol=',XSPIV,
  133.      $           ')'
  134.  112        FORMAT (3A,D9.2,A,D9.2,A,D9.2,A,I4,A)
  135.          ELSEIF (KPREC.EQ.10) THEN
  136.             WRITE(IOIMP,110) ' ',LPREC(KPREC+1),' (r=',RXILUP,')'
  137.          ELSE
  138.             WRITE(IOIMP,*) LPREC(KPREC+1)
  139.          ENDIF
  140.       ENDIF
  141.       IF (LTIME) THEN
  142.          call timespv(ittime,oothrd)
  143.          ITI1=(ITTIME(1)+ITTIME(2))/10
  144.       ENDIF
  145. C
  146. C               - Construction du préconditionneur (repris sur kres5)
  147. C
  148.       SEGACT ISMBR
  149.       INC=ISMBR.VECTBB(/1)
  150.       NRIGE=0
  151.       NMATRI=0
  152.       NKID=9
  153.       NKMT=7
  154.       SEGINI MAPREC
  155.       MAPREC.KNTTT=INC
  156.       MAPREC.KSYM=2
  157.       NTT=0
  158.       NPT=0
  159.       NBLK=0
  160.       SEGINI IDMAT
  161.       MAPREC.KIDMAT(1)=IDMAT
  162. *
  163. * Gestion du CTRL-C
  164.       if (ierr.NE.0) return
  165.       IF (KPREC.EQ.1) THEN
  166.          CALL MEIDIA(KMORS,KIZA,MAPREC,IMPR,IRET)
  167.          IF (IRET.NE.0) GOTO 9999
  168.       ELSEIF (KPREC.EQ.2) THEN
  169.          CALL PRDILU(KMORS,KIZA,MAPREC,IMPR,IRET)
  170.          IF (IRET.NE.0) GOTO 9999
  171.       ELSEIF (KPREC.EQ.3) THEN
  172.          CALL PRILU0(KMORS,KIZA,MAPREC,IMPR,IRET)
  173.          IF (IRET.NE.0) GOTO 9999
  174.       ELSEIF (KPREC.EQ.4) THEN
  175.          CALL PRMILU(KMORS,KIZA,MAPREC,RXMILU,IMPR,IRET)
  176.          IF (IRET.NE.0) GOTO 9999
  177.       ELSEIF (KPREC.GE.5.AND.KPREC.LE.6) THEN
  178.          IVARI=KPREC-5
  179.          CALL PRILUT(KMORS,KIZA,MAPREC,XLFIL,XDTOL,IVARI,
  180.      $        IMPR,IRET)
  181.          IF (IRET.NE.0) GOTO 9999
  182. *            WRITE(IOIMP,*) 'PRILUT !'
  183. *        ELSEIF (KPREC.GE.7.AND.KPREC.LE.9) THEN
  184.       ELSEIF (KPREC.GE.7.AND.KPREC.LE.8) THEN
  185.          WRITE(IOIMP,*) 'KPREC=',KPREC, 'non dispo'
  186.          GOTO 9999
  187.       ELSEIF (KPREC.EQ.9.OR.KPREC.EQ.10) THEN
  188.          CALL PRILUP(KMORS,KIZA,MAPREC,RXILUP,KPREC-9,IMPR,IRET)
  189.          IF (IRET.NE.0) GOTO 9999
  190.       ELSEIF (KPREC.NE.0) THEN
  191.          WRITE(IOIMP,*) 'Erreur de programmation'
  192.          GOTO 9999
  193.       ENDIF
  194.       IF (LTIME) THEN
  195.          call timespv(ittime,oothrd)
  196.          ITI2=(ITTIME(1)+ITTIME(2))/10
  197.       ENDIF
  198. C      MATRIK=MAPREC
  199. C      SEGACT MATRIK
  200. C      nkid=kidmat(/1)
  201. C      WRITE(IOIMP,*) 'Apres constr precon'
  202. C      WRITE(IOIMP,*) '     MAPREC KIDMAT NKID=',nkid
  203. C      WRITE(IOIMP,2020) (KIDMAT(II),II=1,KIDMAT(/1))
  204. C 2020 FORMAT (20(2X,I12) )
  205. C
  206. C               - Appel des solveurs itératifs
  207. C  Apparemment, le segment MATRIK ne sert qu'à vérifier la symétrie
  208. C  et à construire INCTYP pour le multigrille
  209. C
  210.       NRIGE=0
  211.       NMATRI=0
  212.       NKID=0
  213.       NKMT=0
  214.       SEGINI MATRIK
  215.       IF (KTYPI.NE.2) KSYM=2
  216.       SEGACT ISMBR
  217.       INC=ISMBR.VECTBB(/1)
  218.       SEGINI INCX
  219.       KS2B=ISMBR
  220.       AMORS=KMORS
  221.       AISA=KIZA
  222.       ATYP=KTYP
  223. *
  224. * Gestion du CTRL-C
  225.       if (ierr.NE.0) return
  226.       IF (KTYPI.EQ.2) THEN
  227.          CALL PRCG2(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX,
  228.      $        ITER,INMV,RESID,KPREC,BRTOL,ICALRS,IDDOT,IMVEC,
  229.      $        IMPR,IRET)
  230.       ELSEIF (KTYPI.EQ.3) THEN
  231.          LBCG=1
  232.          CALL PRBCGG(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX,
  233.      $        ITER,INMV,RESID,KPREC,BRTOL,LBCG,ICALRS,IDDOT,IMVEC,
  234.      $        IMPR,IRET)
  235.       ELSEIF (KTYPI.EQ.4) THEN
  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.5) THEN
  240. C         WRITE(IOIMP,*) 'ITER=',ITER
  241. C         WRITE(IOIMP,*) 'INMV=',INMV
  242. C         WRITE(IOIMP,*) 'RESID=',RESID
  243. C         WRITE(IOIMP,*) 'KPREC=',KPREC
  244. C         WRITE(IOIMP,*) 'IRSTRT=',IRSTRT
  245. C         WRITE(IOIMP,*) 'ICALRS=',ICALRS
  246. C         WRITE(IOIMP,*) 'IDDOT=',IDDOT
  247.          CALL PRGMR2(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX,
  248.      $        ITER,INMV,RESID,KPREC,IRSTRT,ICALRS,IDDOT,IMVEC,
  249.      $        IMPR,IRET)
  250.       ELSEIF (KTYPI.EQ.6) THEN
  251.          CALL PRCGSN(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX,
  252.      $        ITER,INMV,RESID,KPREC,BRTOL,ICALRS,IDDOT,IMVEC,
  253.      $        IMPR,IRET)
  254.       ELSEIF (KTYPI.EQ.7) THEN
  255. *            WRITE(IOIMP,*) 'Appel de pragmg'
  256.          CALL PRAGMG(AMORS,ATYP,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,
  257.      $        INCX,
  258.      $        ITER,INMV,RESID,KPREC,1,ICALRS,IDDOT,IMVEC,KTIME,LTIME,
  259.      $        IMPR,IRET)
  260.          SEGSUP ATYP
  261.       ELSEIF (KTYPI.EQ.8) THEN
  262.          CALL PRAGMG(AMORS,ATYP,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,
  263.      $        INCX,
  264.      $        ITER,INMV,RESID,KPREC,IRSTRT,ICALRS,IDDOT,IMVEC,KTIME,
  265.      $        LTIME,
  266.      $        IMPR,IRET)
  267.          SEGSUP ATYP
  268.       ELSEIF (KTYPI.EQ.9) THEN
  269.          CALL PRBCG(AMORS,AISA,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. C
  326. C     Destruction de la matrice Morse
  327. C
  328.       IF (INODET.EQ.0) THEN
  329.          SEGSUP AMORS
  330.          SEGSUP AISA
  331.       ENDIF
  332. *
  333. * Normal termination
  334. *
  335.       RETURN
  336. *
  337. * Format handling
  338. *
  339. *
  340. * Error handling
  341. *
  342.  9999 CONTINUE
  343.       MOTERR(1:8)='KRES11  '
  344.       CALL ERREUR(349)
  345.       RETURN
  346. *
  347. * End of subroutine KRES11
  348. *
  349.       END
  350.  
  351.  

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