1 : C RESCGS SOURCE CHAT 05/01/13 02:51:23 5004 2 : SUBROUTINE RESCGS(IZB,MTABP,IZP) 3 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4 : C C 5 : C RESOLUTION DE L'EQUATION K*P = B PAR LA METHODE DU GRADIENT C 6 : C CONJUGUE PRECONDITIONNE. LA MATRICE EST STOCKEE. C 7 : C C 8 : C MTABP EST UNE TABLE QUI CONTIENT LES INFOS NECESSAIRES POUR LE C 9 : C CALCUL. C 10 : C C 11 : C IZP ET IZB SONT LA SOLUTION ET LE SECOND MEMBRE DE L'EQUATION C 12 : C C 13 : C ON DECODE LA TABLE MTABP.METHODE ET ON APPELLE LE SP C 14 : C DE LA BIBLIOTHEQUE : C 15 : C C 16 : C CGRES (SANS PRECONDITIONNEMENT) C 17 : C CGRESD (PRECONDITIONNEMENT DIAGONAL) C 18 : C CGRESI (PRECONDITIONNEMENT CHOLESKI) C 19 : C C 20 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 21 : IMPLICIT INTEGER(I-N) 22 : IMPLICIT REAL*8 (A-H,O-Z) 23 : -INC SMLREEL 24 : POINTEUR IZB.MLREEL 25 : POINTEUR IZP.MLREEL 26 : CHARACTER*8 TYPE 27 : 28 : TYPE=' ' 28 : CALL ACMO(MTABP,'MATRIS',TYPE,MTAB2) 29 : TYPE=' ' 29 : CALL ACMO(MTABP,'METHODE',TYPE,MTAB3) 29 : CALL ECME(MTAB3,'ICOLD',0) 29 : CALL ACME(MTAB3,'IPAT',IPAT) 29 : CALL ECMO(MTAB3,'IZP','LISTREEL',IZP) 30 : IF(IPAT.LE.3) THEN 31 : IPOU=1 32 : VPOU=100.D0 32 : CALL ECME(MTAB3,'IPOU',IPOU) 32 : CALL ECMF(MTAB3,'VPOU',VPOU) 33 : ELSE 33 : CALL ECME(MTAB3,'IPOU',0) 34 : ENDIF 35 : C 36 : C Il faut renseigner KSTO,NL,ILG,IMAT,IPRC,IA,JA,KA, 37 : C **** ** *** **** **** ** ** ** 38 : C IZB,IZP,ICOLD,NPT,NPITE,EPI,IPOU,VPOU 39 : C *** *** ***** *** ***** *** **** **** 40 : C NIMPR et IPAT !!! 41 : C ***** **** 42 : C 42 : CALL ACME(MTAB3,'KSTOCK',KSTO) 42 : CALL ACME(MTAB3,'KTYPI',KTYPI) 42 : CALL ACME(MTAB2,'NL',NL) 42 : CALL ACME(MTAB2,'ILG',ILG) 43 : TYPE=' ' 43 : CALL ACMO(MTAB2,'IMAT',TYPE,IMAT) 44 : TYPE=' ' 44 : CALL ACMO(MTAB3,'IPRC',TYPE,IPRC) 45 : TYPE=' ' 45 : CALL ACMO(MTAB2,'IA',TYPE,IA) 46 : TYPE=' ' 46 : CALL ACMO(MTAB2,'JA',TYPE,JA) 47 : TYPE=' ' 47 : CALL ACMO(MTAB2,'KA',TYPE,KA) 48 : TYPE=' ' 48 : CALL ACMO(MTAB3,'IZP',TYPE,IZP) 48 : CALL ACME(MTAB3,'ICOLD',ICOLD) 48 : CALL ACME(MTAB3,'NITMAX',NPT) 48 : CALL ACME(MTAB3,'NPITE',NPITE) 48 : CALL ACMF(MTAB3,'EPSI',EPSI) 48 : CALL ACME(MTAB3,'IPOU',IPOU) 48 : CALL ACMF(MTAB3,'VPOU',VPOU) 48 : CALL ACME(MTAB3,'NFIMPR',NIMPR) 48 : CALL ACME(MTAB3,'IPAT',IPAT) 49 : C 50 : C Il faut renseigner KSTO,NL,ILG,IMAT,(IPRC),IA,JA,KA, 51 : C **** ** *** **** **** ** ** ** 52 : C IZB,IZP,ICOLD,NPT,NPITE,NEFF,EPI,IPOU,VPOU 53 : C *** *** ***** *** ***** 0000 *** **** **** 54 : C NIMPR et IPAT !!! 55 : C ***** **** 56 : C 57 : IF(KTYPI.EQ.2) THEN 57 : CALL CGRES( KSTO, 58 : 1 NL,ILG, 59 : 2 IMAT,IA,JA,KA, 60 : 3 IZB,IZP,ICOLD, 61 : 4 NPT,NPITE,NEFF,ICONV,EPSI,IPOU,VPOU, 62 : 5 NIMPR,IPAT) 63 : ELSEIF(KTYPI.EQ.3) THEN 63 : CALL CGRESD( KSTO, 64 : 1 NL,ILG, 65 : 2 IMAT,IPRC,IA,JA,KA, 66 : 3 IZB,IZP,ICOLD, 67 : 4 NPT,NPITE,NEFF,ICONV,EPSI,IPOU,VPOU, 68 : 5 NIMPR,IPAT) 69 : ELSEIF(KTYPI.EQ.4) THEN 69 : CALL CGRESI( KSTO, 70 : 1 NL,ILG, 71 : 2 IMAT,IPRC,IA,JA,KA, 72 : 3 IZB,IZP,ICOLD, 73 : 4 NPT,NPITE,NEFF,ICONV,EPSI,IPOU,VPOU, 74 : 5 NIMPR,IPAT) 75 : ELSE 76 : WRITE(6,*) 'RESGCS : KTYPI = ',KTYPI,' INVALIDE' 77 : ENDIF 78 : C SEGACT IZB,IZP 79 : C JG=IZB.PROG(/1) 79 : C CALL RSETD(IZB.PROG,IZP.PROG,JG) 80 : C SEGDES IZB,IZP 81 : C 82 : C Reglage a posteriori de la frequence des tests si on a converge 83 : C au premier test. 84 : C 85 : IF(ICONV.EQ.1) THEN 86 : IF(NEFF.EQ.NPITE) THEN 87 : NPITE=MAX(NPITE/2,3) 88 : ELSE 89 : NPITE=MAX(NEFF/10,10) 90 : ENDIF 91 : ENDIF 92 : 92 : CALL ECME(MTAB3,'NPITE',NPITE) 92 : CALL ECMO(MTAB3,'IZP','LISTREEL',IZP) 93 : IPAT=IPAT+1 94 : 95 : RETURN 96 : END 97 : 98 :
© Cast3M 2003 - All rights reserved.
Disclaimer