1 : C KRES8 SOURCE JC220346 13/12/16 21:15:50 7884 2 : SUBROUTINE KRES8(MRIGID,KSMBR, 3 : $ KTYPI,ITER,RESID,ICALRS,IRSTRT,LBCG,BRTOL,IDDOT,IMVEC, 4 : $ KPREC,RXMILU,RXILUP,XLFIL,XDTOL,XSPIV, 5 : $ KTIME,LTIME, 6 : $ MCHSOL,LRES,LNMV,ICVG,IMPR) 7 : IMPLICIT REAL*8 (A-H,O-Z) 8 : IMPLICIT INTEGER (I-N) 9 : C*********************************************************************** 10 : C NOM : KRES8 11 : C DESCRIPTION : - Assemblage par RESOU 12 : C - Conversion au format Morse de la matrice 13 : C - Conversion du second membre en MVECTD 14 : C - Construction du préconditionneur 15 : C - Appel des solveurs itératifs 16 : C - Conversion du résultat en CHPOINT 17 : C 18 : C 19 : C LANGAGE : ESOPE 20 : C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF) 21 : C mél : gounand@semt2.smts.cea.fr 22 : C*********************************************************************** 23 : C VERSION : v1, 04/08/2011, version initiale 24 : C HISTORIQUE : v1, 04/08/2011, création 25 : C HISTORIQUE : 26 : C HISTORIQUE : 27 : C*********************************************************************** 28 : -INC CCOPTIO 29 : -INC SMCHPOI 30 : POINTEUR MCHSOL.MCHPOI 31 : -INC SMRIGID 32 : -INC SMVECTD 33 : POINTEUR ISMBR.MVECTD 34 : POINTEUR INCX.MVECTD 35 : POINTEUR IR.MVECTD 36 : -INC SMMATRI 37 : SEGMENT PMORS 38 : INTEGER IA (NTT+1) 39 : INTEGER JA (NJA) 40 : ENDSEGMENT 41 : POINTEUR PMS1.PMORS,PMS2.PMORS 42 : POINTEUR KMORS.PMORS 43 : C Segment de stokage 44 : SEGMENT IZA 45 : REAL*8 A(NBVA) 46 : ENDSEGMENT 47 : POINTEUR IZA1.IZA,IZA2.IZA,IZAU.IZA,IZAL.IZA,ISA.IZA 48 : POINTEUR KIZA.IZA 49 : 50 : -INC SMLENTI 51 : POINTEUR KTYP.MLENTI 52 : -INC SMTABLE 53 : POINTEUR KTIME.MTABLE 54 : DIMENSION ITTIME(6) 55 : CHARACTER*8 CHARI 56 : CHARACTER*1 CCOMP 57 : LOGICAL LTIME 58 : REAL*8 GNRM2 59 : * .. 60 : * .. External subroutines and functions.. 61 : EXTERNAL GAXPY,GCOPY,GDOT,GNRM2 62 : * 63 : * Executable statements 64 : * 65 : IF (LTIME) THEN 65 : CALL CRTABL(KTIME) 65 : CALL TIMESPV(ITTIME) 66 : ITI1=(ITTIME(1)+ITTIME(2)) 67 : ELSE 68 : KTIME=0 69 : ENDIF 70 : C 71 : C CAS PARTICULIER : Si la matrice est vide (toutes les inconnues 72 : C éliminées, par exemple) 73 : C 74 : SEGACT MRIGID 75 : IF (IRIGEL(/2).EQ.0) THEN 76 : NSOUPO=0 77 : NAT=0 78 : SEGINI MCHSOL 79 : SEGDES MCHSOL 80 : ICVG=0 81 : LNMV=0 82 : LRES=0 83 : IF (LTIME) THEN 83 : CALL TIMESPV(ITTIME) 84 : ITI2=(ITTIME(1)+ITTIME(2)) 85 : CHARI='MATVIDE' 85 : CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI, 86 : $ 'ENTIER ',ITI2-ITI1,XVALR,CHARR,LOGIR,IRETR) 87 : SEGDES KTIME 88 : ENDIF 89 : SEGDES MRIGID 90 : RETURN 91 : ENDIF 92 : C 93 : C - Assemblage par RESOU 94 : C 94 : CALL KRES9(MRIGID,1) 95 : IF (IERR.NE.0) RETURN 96 : IF (LTIME) THEN 96 : CALL TIMESPV(ITTIME) 97 : ITI2=(ITTIME(1)+ITTIME(2)) 98 : ENDIF 99 : C 100 : C - Conversion au format Morse de la matrice 101 : C 101 : CALL KRES10(MRIGID,KMORS,KIZA) 102 : IF (IERR.NE.0) RETURN 103 : IF (LTIME) THEN 103 : CALL TIMESPV(ITTIME) 104 : ITI3=(ITTIME(1)+ITTIME(2)) 105 : ENDIF 106 : C 107 : C On donne des infos sur la matrice 108 : C 109 : * WRITE(IOIMP,*) 'IMPR=',IMPR 109 : CALL INFMAT(KMORS,KIZA,IMPR,IRET) 110 : * IF (IRET.NE.0) GOTO 9999 111 : * WRITE(IOIMP,*) 'Apres KRES10' 112 : * WRITE(IOIMP,*) 'KMORS=',KMORS 113 : * WRITE(IOIMP,*) 'KIZA=',KIZA 114 : 115 : C 116 : C - Conversion du second membre en MVECTD 117 : C et initialisation du résultat 118 : C 119 : SEGACT MRIGID 120 : ICHOLX=ICHOLE 121 : ISECO=KSMBR 122 : * On ne vérifie pas que le second membre doit être dans le dual 123 : NOID=1 123 : CALL CHVNS(ICHOLX,ISECO,ISMBR,NOID) 124 : IF (IERR.NE.0) RETURN 125 : IF (LTIME) THEN 125 : CALL TIMESPV(ITTIME) 126 : ITI4=(ITTIME(1)+ITTIME(2)) 127 : ENDIF 128 : * SEGACT ISMBR 129 : * WRITE(IOIMP,*) 'Second membre sous forme vecteur' 130 : * INC=ISMBR.VECTBB(/1) 131 : * WRITE(IOIMP,*) ' ISMBR, INC=',INC 132 : * WRITE(IOIMP,2022) (ISMBR.VECTBB(II),II=1,ISMBR.VECTBB(/1)) 133 : C 134 : C - Construction du préconditionneur (repris sur kres5) 135 : C - Appel des solveurs itératifs 136 : C 137 : C Si solveur multigrille, il faut un segment permettant de distinguer 138 : C les inconnues 139 : IF (KTYPI.EQ.7.OR.KTYPI.EQ.8) THEN 140 : MMATRI=ICHOLE 141 : SEGACT MMATRI 142 : MINCPO=IINCPO 143 : SEGACT MINCPO 144 : NCOMP=INCPO(/1) 145 : NNOE=INCPO(/2) 146 : SEGACT ISMBR 147 : INC=ISMBR.VECTBB(/1) 148 : SEGDES ISMBR 149 : JG=INC 150 : SEGINI KTYP 151 : DO ICOMP=1,NCOMP 152 : DO INOE=1,NNOE 153 : IG=INCPO(ICOMP,INOE) 154 : IF (IG.GT.0) KTYP.LECT(IG)=ICOMP 155 : ENDDO 156 : ENDDO 157 : SEGDES KTYP 158 : SEGDES MINCPO 159 : SEGDES MMATRI 160 : ELSE 161 : KTYP=0 162 : ENDIF 163 : * 164 : * Warning KMORS, KIZA et KTYP sont détruits dans KRES11 et KRES12 165 : * si inodet=0 166 : INODET=1 166 : * CALL ECMORS(KMORS,KIZA,3) 167 : * SEGACT ISMBR 168 : * WRITE(IOIMP,*) 'Second membre sous forme vecteur' 169 : * INC=ISMBR.VECTBB(/1) 170 : * WRITE(IOIMP,*) ' ISMBR, INC=',INC 171 : * WRITE(IOIMP,2022) (ISMBR.VECTBB(II),II=1,ISMBR.VECTBB(/1)) 172 : * Solveur Direct 173 : IF (KTYPI.EQ.1) THEN 174 : SEGINI,INCX=ISMBR 174 : CALL KRES12(KMORS,KIZA,INCX, 174 : * CALL KRES12(KMORS,KIZA,ISMBR, 175 : $ KTIME,LTIME, 176 : $ INCX,LRES,LNMV,ICVG,IMPR,INODET) 177 : ELSE 178 : * Solveur Itératif 178 : CALL KRES11(KMORS,KIZA,KTYP,ISMBR, 179 : $ KTYPI,ITER,RESID,ICALRS,IRSTRT,LBCG,BRTOL,IDDOT,IMVEC, 180 : $ KPREC,RXMILU,RXILUP,XLFIL,XDTOL,XSPIV, 181 : $ KTIME,LTIME, 182 : $ INCX,LRES,LNMV,ICVG,IMPR,INODET) 183 : * WRITE(IOIMP,*) 'Apres KRES11' 184 : ENDIF 185 : IF(IERR.NE.0) RETURN 186 : * SEGACT INCX 187 : * WRITE(IOIMP,*) 'Inconnue sous forme vecteur' 188 : * INC=INCX.VECTBB(/1) 189 : * WRITE(IOIMP,*) ' INCX, INC=',INC 190 : * WRITE(IOIMP,2022) (INCX.VECTBB(II),II=1,INCX.VECTBB(/1)) 191 : * IF(IERR.NE.0) RETURN 192 : C r(0)=b 193 : * SEGINI,IR=ISMBR 194 : * SEGACT INCX 195 : * SEGACT KMORS 196 : * SEGACT KIZA 197 : *C r(0)=b-Ax 197 : * CALL GMOMV('N',-1.D0,KMORS,KIZA,INCX,1.D0,IR) 198 : * RNRM2 = GNRM2(IR) 199 : * WRITE(IOIMP,*) '||R||=',RNRM2 200 : 201 : IF (LTIME) THEN 201 : CALL TIMESPV(ITTIME) 202 : ITI5=(ITTIME(1)+ITTIME(2)) 203 : ENDIF 204 : C 205 : C - Conversion du résultat en CHPOINT 206 : C 206 : CALL VCH1(ICHOLX,INCX,MCHSOL,MRIGID) 207 : * WRITE(IOIMP,*) 'Apres VCH1' 208 : IF(IERR.NE.0) RETURN 209 : IF (LTIME) THEN 209 : CALL TIMESPV(ITTIME) 210 : ITI6=(ITTIME(1)+ITTIME(2)) 211 : CHARI='ASS+RENU' 211 : CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI, 212 : $ 'ENTIER ',ITI2-ITI1,XVALR,CHARR,LOGIR,IRETR) 213 : CHARI='CONVMORS' 213 : CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI, 214 : $ 'ENTIER ',ITI3-ITI2,XVALR,CHARR,LOGIR,IRETR) 215 : * CHARI='CONVSMB ' 215 : * CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI, 216 : * $ 'ENTIER ',ITI4-ITI3,XVALR,CHARR,LOGIR,IRETR) 217 : IF (KTYPI.EQ.1) THEN 218 : CHARI='FAC+RESO' 219 : ELSE 220 : CHARI='PRE+RESO' 221 : ENDIF 221 : CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI, 222 : $ 'ENTIER ',ITI5-ITI4,XVALR,CHARR,LOGIR,IRETR) 223 : * CHARI='CONVINC' 223 : * CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI, 224 : * $ 'ENTIER ',ITI6-ITI5,XVALR,CHARR,LOGIR,IRETR) 225 : CHARI='TOTAL ' 225 : CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI, 226 : $ 'ENTIER ',ITI6-ITI1,XVALR,CHARR,LOGIR,IRETR) 227 : SEGDES KTIME 228 : ENDIF 229 : * Le solveur direct surcharge le second membre 230 : IF (ISMBR.NE.INCX) SEGSUP ISMBR 231 : SEGSUP INCX 232 : SEGDES MRIGID 233 : * 234 : * Normal termination 235 : * 236 : RETURN 237 : * 238 : * Format handling 239 : * 240 : 2022 FORMAT(10(1X,1PG12.5)) 241 : * 242 : * End of subroutine KRES8 243 : * 244 : END 245 : 246 : 247 : 248 :
© Cast3M 2003 - All rights reserved.
Disclaimer