C PRBCGG SOURCE GOUNAND 22/08/25 21:15:09 11434 SUBROUTINE PRBCGG(KMORS,KISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX, $ ITER,INMV,RESID,KPREC, $ BRTOL,LBCG,ICALRS,IDDOT,IMVEC,IMPR,IRET) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C*********************************************************************** C NOM : PRBCGG C DESCRIPTION : C Préparation de la résolution d'un système linéaire Ax=b C par une méthode BiCGSTAB(l) préconditionnée ou non. C (+ reliable updates) C LANGAGE : ESOPE C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF) C mél : gounand@semt2.smts.cea.fr C REFERENCE (bibtex-like) : C @BOOK{templates, C AUTHOR={R.Barrett, M.Berry, T.F.Chan, J.Demmel, J.Donato, C J.Dongarra, V.Eijkhout, R.Pozo, C.Romine, C H. Van der Vorst}, C TITLE={Templates for the Solution of Linear Systems : C Building Blocks for Iterative Methods}, C PUBLISHER={SIAM}, YEAR={1994}, ADDRESS={Philadelphia,PA} } C -> URL : http://www.netlib.org/templates/Templates.html C@TechReport{fokkema, C author = {DR Fokkema}, C title = {Enhanced implementation of BiCGSTAB(l) for solving C linear systems of equations}, C institution = {?}, C year = {1996}} C*********************************************************************** C VERSION : v1, 22/02/06, version initiale C HISTORIQUE : v1, 22/02/06, création C HISTORIQUE : C HISTORIQUE : C*********************************************************************** C Prière de PRENDRE LE TEMPS de compléter les commentaires C en cas de modification de ce sous-programme afin de faciliter C la maintenance ! C*********************************************************************** * * .. Includes et pointeurs associés .. -INC PPARAM -INC CCOPTIO -INC SMLREEL INTEGER JG POINTEUR LRES.MLREEL -INC SMLENTI POINTEUR LNMV.MLENTI POINTEUR ITRAV.MLENTI -INC SMMATRIK POINTEUR MAPREC.MATRIK POINTEUR KMORS.PMORS POINTEUR KISA.IZA POINTEUR KS2B.IZA POINTEUR INCX.IZA POINTEUR INVDIA.IZA POINTEUR ILUM.PMORS POINTEUR ILUI.IZA * .. Work Vectors for BiCGSTAB(l) SEGMENT SPACE REAL*8 IJ(NI,NJ) ENDSEGMENT POINTEUR IZ.SPACE,IZM1.SPACE SEGMENT SPACE2 POINTEUR WRK(NIZA).IZA ENDSEGMENT POINTEUR IR.SPACE2,IU.SPACE2 POINTEUR IRTLD.IZA,IXTLD.IZA,IUHAT.IZA,IBP.IZA POINTEUR IY.IZA,IYP.IZA POINTEUR ITMP.IZA * .. Scalar Arguments .. INTEGER ITER, KPREC, IMPR, IRET REAL*8 RESID INTEGER NBVA,NJA,NTT,NTTPRE * .. Executable Statements .. * IRET = 0 * * On récupère les paramètres * SEGACT MATRIK SEGACT MAPREC IF (KSYM.EQ.0) THEN IF (IMPR.GT.2) THEN WRITE(IOIMP,*) 'MATRIK',MATRIK,'symétrique : ', $ 'use a Conjugate Gradient instead !' ENDIF C IRET=-2 C GOTO 9999 ENDIF * Pour le préconditionneur ILUM =MAPREC.KIDMAT(6) ILUI =MAPREC.KIDMAT(7) IDMAT=MAPREC.KIDMAT(1) SEGACT IDMAT INVDIA=IDIAG SEGDES IDMAT SEGACT KMORS NTT =KMORS.IA(/1)-1 * NJA =KMORS.JA(/1) SEGACT KISA SEGACT KS2B SEGACT INCX*MOD C Paramètres des préconditionnements diagonaux et D-ILU IF (KPREC.NE.0) THEN IF (KPREC.EQ.1.OR.KPREC.EQ.2) THEN C Est-il compatible avec la matrice ? SEGACT INVDIA NTTPRE=INVDIA.A(/1) IF (NTTPRE.NE.NTT) THEN WRITE(IOIMP,*) 'La matrice et son préconditionnement' WRITE(IOIMP,*) 'ne sont pas compatibles...' WRITE(IOIMP,*) 'NTT=',NTT WRITE(IOIMP,*) 'NTTPRE=',NTTPRE IRET=-2 GOTO 9999 ENDIF C Paramètres des préconditionnements ILU(0), MILU(0), ILUT et ILUT2 C ilutp, ilutpg, ilutpg2 ELSEIF (KPREC.GE.3.AND.KPREC.LE.10) THEN SEGACT ILUM SEGACT ILUI NTTPRE=ILUM.IA(/1) IF (NTTPRE.NE.NTT) THEN WRITE(IOIMP,*) 'La matrice et son préconditionnement', $ 'ne sont pas compatibles...' WRITE(IOIMP,*) 'NTT=',NTT,' NTTPRE=',NTTPRE IRET=-2 GOTO 9999 ENDIF ENDIF ENDIF C C Initialisation de l'historique de convergence C JG=ITER+1 SEGINI LNMV SEGINI LRES C C C Initialisation des vecteurs de travail pour BiCGStab(l) C NI=LBCG NJ=LBCG SEGINI IZ,IZM1 NBVA=LBCG SEGINI IY,IYP JG=LBCG SEGINI ITRAV NBVA=NTT SEGINI IRTLD,IXTLD,IUHAT,IBP NIZA=LBCG+1 SEGINI IR DO I=1,NIZA SEGINI ITMP IR.WRK(I)=ITMP ENDDO SEGINI IU DO I=1,NIZA SEGINI ITMP IU.WRK(I)=ITMP ENDDO C CALL BCGG(KMORS,KISA,KS2B,INCX, $ KPREC,INVDIA,ILUM,ILUI, $ LRES,LNMV, $ IRTLD,IXTLD,IUHAT,IR,IU,IZ,IZM1,IY,IYP,IBP,ITRAV, $ ITER,INMV,BRTOL,LBCG,RESID,ICALRS,IDDOT,IMVEC,IMPR,IRET) * Gestion du CTRL-C if (ierr.NE.0) return C C Désactivation-suppression C DO I=1,NIZA ITMP=IU.WRK(I) SEGSUP ITMP ENDDO SEGSUP IU DO I=1,NIZA ITMP=IR.WRK(I) SEGSUP ITMP ENDDO SEGSUP IR SEGSUP IRTLD,IXTLD,IUHAT,IBP SEGSUP ITRAV SEGSUP IY,IYP SEGSUP IZ,IZM1 JG=ITER+1 SEGADJ LRES SEGDES LRES SEGADJ LNMV SEGDES LNMV IF (KPREC.EQ.1.OR.KPREC.EQ.2) THEN SEGDES INVDIA ELSEIF (KPREC.GE.3.AND.KPREC.LE.9) THEN SEGDES ILUI SEGDES ILUM ENDIF SEGDES INCX SEGDES KS2B SEGDES KISA SEGDES KMORS SEGDES MAPREC SEGDES MATRIK C C A problem has occured in the GMRES method C IF (IRET.LT.0) GOTO 9999 * * Normal termination * RETURN * * Format handling * * * Error handling * 9999 CONTINUE WRITE(IOIMP,*) 'An error was detected in prbcgg.eso' RETURN * * End of prbcgg * END