1 : C LDMT3 SOURCE PV 13/11/12 21:15:00 7864 2 : SUBROUTINE LDMT3(MMATRX,PREC) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : * TANT QUE OOOVAL(1,4) NE MARCHE PAS SUR CRAY 6 : PARAMETER (LPCRAY=10000) 7 : INTEGER OOOVAL 8 : POINTEUR LLL.LIGN, MMM.LIGN 9 : POINTEUR LIG2.LIGN 10 : POINTEUR L.LLIGN, M.LLIGN 11 : POINTEUR LL.MILIGN, MM.MILIGN 12 : SEGMENT ITEMP 13 : REAL*8 P(INC) 14 : ENDSEGMENT 15 : POINTEUR R.ITEMP,W.ITEMP 16 : C 17 : C **** MISE SOUS FORME A=Lt D L DE LA MATRICE MMATRX 18 : C 19 : -INC CCOPTIO 20 : -INC SMMATRI 21 : -INC CCHOLE 22 : SEGMENT KIVPO(IIMAX) 23 : SEGMENT KIVLO(IIMAX) 24 : SEGMENT ITMASQ(NBLIG) 25 : SEGMENT ITMASI(NBLIGI) 26 : SEGMENT IMASQ(LMASQ) 27 : SEGMENT IMASQI(LMASQI) 28 : 29 : SAVE IPASV 30 : DATA IPASV/0/ 31 : * prec=1.d-20 32 : * nouvelle methode de gestion de l'espace memoire necessitee par la parallelisation 33 : * memoire vive totale 34 : MACTIT=OOOVAL(1,1) 35 : * un bloc de memoire fera au plus macti/3 36 : nvstrm=0 37 : MMATRI=MMATRX 38 : SEGACT,MMATRI*MOD 39 : PRCHLV=PREC 40 : LL=IILIGN 41 : MM=IILIGS 42 : SEGACT,MM*MOD,LL*MOD 43 : INO=MM.ILIGN(/1) 44 : MDIAG=IDIAG 45 : SEGACT,MDIAG*MOD 46 : NBLIG=INO 47 : NBLIGI=INO 48 : SEGINI ITMASQ,ITMASI 49 : INC=DIAG(/1) 50 : INCC=INC 51 : MIMIK=IIMIK 52 : MINCPO=IINCPO 53 : SEGACT,MINCPO,MIMIK 54 : IPLUMI=IMIK(/2)*2 +4 55 : IL2=0 56 : IIMAX=IJMAX+IPLUMI 57 : SEGINI KIVPO,KIVLO 58 : INEG=0 59 : NBLAG=0 60 : NENSLX=0 61 : NVSTOC=0 62 : NVSTOR=0 63 : NVSTIC=0 64 : NVSTIR=0 65 : NGMAXZ=NGMAXY 66 : C 67 : C **** DEBUT DE LA TRIANGULARISATION. ON PREND NOEUD A NOEUD, 68 : C **** DECOMPACTAGE PUIS TRAVAIL SUR LES LIGNES DU NOEUDS 69 : C 70 : C **** LA LONGUEUR DE LA PLUS GRANDE LIGNE EST DONNEE PAR IMAX 71 : C 72 : 1 CONTINUE 73 : IVALMA=IJMAX+IPLUMI 74 : IVALMI=IJMAX+IPLUMI 75 : IL1=IL2+1 76 : IMIN=IL1 77 : IMINII=IL1 78 : mactic=0 79 : DO 2 I=IL1,INO 80 : VALREG=1D50 81 : L=LL.ILIGN(I) 82 : SEGACT /ERR=3/L 83 : M=MM.ILIGN(I) 84 : SEGACT /ERR=3/M 85 : NA=M.IMMMM(/1) 86 : NBPAR=NA+1 87 : NVALL=M.NJMAX 88 : NVALLL=NVALL 89 : IF(IVALMA+NVALL.GT.NGMAXZ.AND.I.GT.IL1 ) GO TO 3 90 : SEGINI /ERR=3/MMM 91 : NVALL= L.NJMAX 92 : NVILL=NVALL 93 : NA=L.IMMMM(/1) 94 : NBPAR=NA+1 95 : IF(IVALMI+NVALL.GT.NGMAXZ.AND.I.GT.IL1 ) GO TO 3 96 : SEGINI /ERR=3/LLL 97 : * recuperer la longueur du segment 98 : mactic=mactic+OOA(OOA(OOT+MMM)+OOT-1)+OOA(OOA(OOT+LLL)+OOT-1) 99 : if ((mactic.gt.mactit/3.or.mactic.gt.mactit-nvstrm*4) 100 : > .AND.I.GT.IL1) THEN 101 : SEGSUP LLL,MMM 102 : GOTO 3 103 : endif 104 : NVSTOC=NVSTOC + NVALLL 105 : NVSTIC=NVSTIC+NVALL 106 : IVALMA=IVALMA+NVALLL 107 : IVALMI=IVALMI+NVALL 108 : NVALL=NVALLL 109 : 110 : C 111 : C **** DECOMPACTAGE 112 : C 113 : IPA=1 114 : IPI=1 115 : DO 121 JPA=1,NA 116 : MMM.IVPO(JPA)=IPA 117 : LLL.IVPO(JPA)=IPI 118 : KPA=M.IPPO(JPA+1)-M.IPPO(JPA) 119 : KPI=L.IPPO(JPA+1)-L.IPPO(JPA) 120 : IPP=M.IPPO(JPA) 121 : IPPI= L.IPPO(JPA) 122 : MMM.IPPVV(JPA)=IPA-1 123 : LLL.IPPVV(JPA)=IPI-1 124 : LPA=M.LDEB(JPA) 125 : LPAI=L.LDEB(JPA) 126 : LPA1=LPA-IPA 127 : LPA1I=LPAI-IPI 128 : DO 122 MPA=1,KPA 129 : LLO=M.LINC(MPA+IPP) 130 : IPLA=LLO-LPA1 131 : MMM.VAL(IPLA)=M.XXVA(MPA+IPP) 132 : 122 CONTINUE 133 : DO 1220 MPA=1,KPI 134 : LLO=L.LINC(MPA+IPPI) 135 : IPLA=LLO-LPA1I 136 : LLL.VAL(IPLA)=L.XXVA(MPA+IPPI) 137 : 1220 CONTINUE 138 : * REDUCTION EVENTUELLE DE LA LIGNE A SA PARTIE SIGNIFICATIVE 139 : * > 1E-15*DIAGONALE 140 : **** *** 141 : VALREF=ABS(MMM.VAL(IPA+M.IMMMM(JPA)-LPA))*PREC 142 : 143 : VALREG=MIN(VALREG,VALREF) 144 : ITROP=0 145 : ITRIP=0 146 : IPAHAU=IPA+M.IMMMM(JPA)-LPA 147 : IPIHAU=IPI+L.IMMMM(JPA)-LPAI 148 : ** DO 123 ILD=IPA,IPAHAU-1 149 : ** IF (ABS(MMM.VAL(ILD)).GT.VALREF) GOTO 124 150 : ** ITROP=ITROP+1 151 : *123 CONTINUE 152 : *124 CONTINUE 153 : ** DO 1230 ILD=IPI,IPIHAU-1 154 : ** IF (ABS(LLL.VAL(ILD)).GT.VALREF) GOTO 1240 155 : ** ITRIP=ITRIP+1 156 : *230 CONTINUE 157 : *240 CONTINUE 158 : ** IF (ITROP.NE.0) THEN 159 : ** LPA=LPA+ITROP 160 : ** JILD=IPAHAU-ITROP 161 : ** DO 125 ILD=IPA,JILD 162 : ** MMM.VAL(ILD)=MMM.VAL(ILD+ITROP) 163 : *125 CONTINUE 164 : ** DO 126 ILD=JILD+1,JILD+ITROP 165 : ** MMM.VAL(ILD)=0.D0 166 : *126 CONTINUE 167 : ** NVALL=NVALL-ITROP 168 : ** NVSTOC=NVSTOC-ITROP 169 : ** IVALMA=IVALMA-ITROP 170 : ** ENDIF 171 : ** IF (ITRIP.NE.0) THEN 172 : ** LPAI=LPAI+ITRIP 173 : ** JILD=IPIHAU-ITRIP 174 : ** DO 1250 ILD=IPI,JILD 175 : ** LLL.VAL(ILD)=LLL.VAL(ILD+ITRIP) 176 : 1250 CONTINUE 177 : ** DO 1260 ILD=JILD+1,JILD+ITRIP 178 : ** LLL.VAL(ILD)=0.D0 179 : 1260 CONTINUE 180 : ** NVILL=NVILL-ITRIP 181 : ** NVSTIC=NVSTIC-ITRIP 182 : ** IVALMI=IVALMI-ITRIP 183 : ** ENDIF 184 : 185 : IPA=IPA+M.IMMMM(JPA)-LPA+1 186 : MMM.IMMM(JPA)=MM.IPNO(LPA) 187 : IF(IMIN.GT.MM.IPNO(LPA)) IMIN=MM.IPNO(LPA) 188 : IPI=IPI+L.IMMMM(JPA)-LPAI+1 189 : LLL.IMMM(JPA)=LL.IPNO(LPAI) 190 : IF(IMINII.GT.LL.IPNO(LPAI)) IMINII=LL.IPNO(LPAI) 191 : 121 CONTINUE 192 : IF (NVALL.NE.MMM.VAL(/1))SEGADJ MMM 193 : NVALLL=NVALL 194 : NVALL=NVILL 195 : IF (NVILL.NE.LLL.VAL(/1))SEGADJ LLL 196 : NVALL=NVALLL 197 : **** **** **** 198 : LMASQ=NVALL/MASDIM+2 199 : LMASQI=NVILL/MASDIM+2 200 : SEGINI IMASQ,IMASQI 201 : DO ILD=1,MMM.VAL(/1) 202 : IF (ABS(MMM.VAL(ILD)).GT.VALREG) IMASQ(ILD/MASDIM+1)=1 203 : ENDDO 204 : DO ILD=1,LLL.VAL(/1) 205 : IF (ABS(LLL.VAL(ILD)).GT.VALREG) IMASQI(ILD/MASDIM+1)=1 206 : ENDDO 207 : ITMASQ(I)=IMASQ 208 : ITMASI(I)=IMASQI 209 : MMM.IPREL=M.IMMMM(1) 210 : MMM.IDERL=M.IMMMM(NA) 211 : LLL.IPREL=L.IMMMM(1) 212 : LLL.IDERL=L.IMMMM(NA) 213 : MMM.IPPVV(NA+1)=IPA-1 214 : LLL.IPPVV(NA+1)=IPI-1 215 : SEGSUP L,M 216 : MM.ILIGN(I)=MMM 217 : LL.ILIGN(I)=LLL 218 : * IF(I.GE.1000000) THEN 219 : * WRITE( IOIMP,4987) I 220 : * 4987 FORMAT (' NOEUD NUMERO ',I5 , ' colonne puis ligne') 221 : * LLO=MMM.VAL(/1) 222 : * write(6,*) 'M IMMM ', (MMM.IMMM(IU),IU=1,MMM.IMMM(/1) ) 223 : * WRITE(IOIMP, 4926)(MMM.VAL(MPA),MPA=1,LLO) 224 : *4926 FORMAT(' M VAL ' , 6E11.4) 225 : * write(6,7632) ( MMM.IPPVV(IU),iu=1,MMM.IPPVV(/1)) 226 : *7632 FORMAT(' M IPPVV',10i6) 227 : * LLO=LLL.VAL(/1) 228 : * write(6,*) 'L IMMM ', (LLL.IMMM(IU),IU=1,LLL.IMMM(/1) ) 229 : * WRITE(IOIMP, 4927)(LLL.VAL(MPA),MPA=1,LLO) 230 : *4927 FORMAT(' L VAL ' , 6E11.4) 231 : * write(6,7633) ( LLL.IPPVV(IU),iu=1,LLL.IPPVV(/1)) 232 : *7633 FORMAT(' L IPPVV',10i6) 233 : 234 : * ENDIF 235 : 2 CONTINUE 236 : IL2=INO 237 : GO TO 4 238 : 3 IL2=I-1 239 : 4 CONTINUE 240 : IF(IL2.GE.IL1) GO TO 40 241 : C 242 : C **** APPEL AUX ERREURS MESSAGE PAS ASSEZ DE PLACE MEMOIRE 243 : C 244 : ITYP=48 244 : CALL ERREUR(48) 245 : RETURN 246 : 40 CONTINUE 247 : IB=IL2+1 248 : MMM=MM.ILIGN(IL2) 249 : MMM.IMM=IB 250 : IL2M=IL2-1 251 : IF(IL2M.LT.IL1) GO TO 353 252 : DO 352 IH=IL2M,IL1,-1 253 : MMM=MM.ILIGN(IH+1) 254 : IM=MMM.IMMM(1) 255 : DO 354 JH=1,MMM.IMMM(/1) 256 : IM=MIN(IM,MMM.IMMM(JH)) 257 : 354 CONTINUE 258 : LIG1=MM.ILIGN(IH) 259 : LIG1.IMM=MIN(MMM.IMM,IM) 260 : 352 CONTINUE 261 : 353 CONTINUE 262 : C MMM=ILIGN(IL1) 263 : IB=IL2+1 264 : LLL=LL.ILIGN(IL2) 265 : LLL.IMM=IB 266 : IL2M=IL2-1 267 : IF(IL2M.LT.IL1) GO TO 3530 268 : DO 3520 IH=IL2M,IL1,-1 269 : LLL=LL.ILIGN(IH+1) 270 : IM=LLL.IMMM(1) 271 : DO 3540 JH=1,LLL.IMMM(/1) 272 : IM=MIN(IM,LLL.IMMM(JH)) 273 : 3540 CONTINUE 274 : LIG2=LL.ILIGN(IH) 275 : LIG2.IMM=MIN(LLL.IMM,IM) 276 : 3520 CONTINUE 277 : 3530 CONTINUE 278 : MMM=MM.ILIGN(IL1) 279 : IL11=MMM.IPREL 280 : LLL=LL.ILIGN(IL1) 281 : IL22=LLL.IPREL 282 : C 283 : C **** BOUCLE *5* TRAVAILLE SUR LE NOEUD I QUI EST EN LECTURE 284 : C 285 : lig1=MM.ilign(imin) 285 : call oooeta(lig1,ieta) 286 : lig2=LL.ilign(iminII) 286 : call oooeta(lig2,ietai) 287 : if (ieta.eq.3.OR.IETAI.EQ.3) then 288 : * on cherche a reprendre des lignes migres sur disque 289 : * on passe dans le mode ou ngmaxz est grand ! 290 : ngmaxz=2000000000 291 : endif 292 : IMINA=MIN(IMIN,IMINII) 293 : DO 5 I=IMINA,IL2 294 : IMASQ=ITMASQ(I) 295 : IMASQI=ITMASI(I) 296 : LIG1=MM.ILIGN(I) 297 : LIG2=LL.ILIGN(I) 298 : IF(I.LT.IL1) GO TO 7 299 : C 300 : C ******* LE NOEUD I EST EN MEMOIRE IL EST TRIANGULE JUSQU'A 301 : C ******* IPREL IL FAUT CONTINUER TOUTE LES LIGNES PUIS CALCULER 302 : C ******* LE TERME DIAGONAL 303 : C 304 : C on s'occupe d'abord de la partie superieur 305 : LIGN=LIG1 306 : NAA= IMMM(/1) 307 : DO 156 KHG=1,NAA 308 : LIGN=LIG1 309 : II=IPREL-1+KHG 310 : IMMM(KHG)=0 311 : NN=IPPVV(KHG+1) 312 : NNS=NN 313 : NNM1=IPPVV(KHG) 314 : NNM1S=NNM1 315 : N=NN-NNM1 316 : DIAG(II)=VAL(NN) 317 : IF(N.EQ.1) GO TO 8 318 : NMI=N-II 319 : IDEP=MAX(IL11,2-NMI) 320 : KIDEP=IDEP+NMI 321 : KI1=N-1 322 : KQ=-NMI 323 : VAL(NN)=VAL(NN)+ 324 : #CHOLI1(LL.ILIGN,LIG2,VAL(1+IPPVV(KHG)),DIAG(1-NMI),LL.IPNO(1-NMI), 325 : # IPPVV(1),KHG,IVPO(1),KIDEP,KI1,KQ,IMASQ(1),1+IPPVV(KHG), 326 : # PREC,1) 327 : 8 CONTINUE 328 : LIGN=LIG2 329 : IMMM(KHG)=0 330 : NN=IPPVV(KHG+1) 331 : NNM1=IPPVV(KHG) 332 : N=NN-NNM1 333 : IF(N.EQ.1) GO TO 88 334 : NMI=N-II 335 : IDEP=MAX(IL22,2-NMI) 336 : KIDEP=IDEP+NMI 337 : KI1=N-1 338 : KQ=-NMI 339 : VAL(NN)=VAL(NN)+ 340 : #CHOLI1(MM.ILIGN,LIG1,VAL(1+IPPVV(KHG)),DIAG(1-NMI),MM.IPNO(1-NMI), 341 : # IPPVV(1),KHG,IVPO(1),KIDEP,KI1,KQ,IMASQI(1),1+IPPVV(KHG), 342 : # PREC,2) 343 : 88 CONTINUE 344 : LIGN=LIG1 345 : IF(LL.ITTR(II).EQ.0.AND. 346 : & ABS(LIG2.VAL(NN)).GT.ABS(DIAG(II))*1.E-10) GO TO 12 347 : IF(LL.ITTR(II).NE.0.AND. 348 : & ABS(LIG2.VAL(NN)).GT.ABS(DIAG(II))*1.E-6) GO TO 12 349 : C 350 : C **** ON VIENT DE DETECTER UN MODE D'ENSEMBLE 351 : C **** ON AJOUTE A LA STRUCTURE UN RESSORT EGAL A CELUI QUI EXISTAIT 352 : C **** AU PREALABLE SUR CETTE INCONNUE. 353 : C 354 : LIG2.VAL(NN)=DIAG(II) 355 : NENS=NENS+1 356 : LIG2.IMMM(KHG)=NENS 357 : if(LL.ittr(ii).NE.0) NENSLX=NENSLX+1 358 : 12 CONTINUE 359 : IMASQ(NNS/MASDIM+1)=1 360 : IMASQI(NN/MASDIM+1)=1 361 : DIAG(II)=LIG2.VAL(NN) 362 : IF(DIAG(II).NE.0.) GO TO 41 363 : KQ1=1+NNM1S 364 : KQN=N+NNM1S 365 : DO 16 LFG=KQ1,KQN 366 : IF(LIG1.VAL(LFG).NE.0.) GO TO 17 367 : 16 CONTINUE 368 : KQ1=1+NNM1 369 : KQN=N+NNM1 370 : DO 160 LFG=KQ1,KQN 371 : IF(LIG2.VAL(LFG).NE.0.) GO TO 17 372 : 160 CONTINUE 373 : DIAG(II)=1. 374 : LIG2.VAL(NN)=1. 375 : GO TO 41 376 : 17 CONTINUE 377 : C 378 : C **** ENVOI ERREUR MATRICE SINGUIERE 379 : C 380 : ITYP=49 381 : INTERR(1)=I 381 : CALL ERREUR(49) 382 : RETURN 383 : C 384 : C **** ON COMPTE LE NOMBRE DE TERMES DIAGONAUX NEGATIFS 385 : C ET LE NOMBRE DE MULTIPLICATEUR DE LAGRANGE 386 : C 387 : 41 IF(DIAG(II).LT.0.D0) INEG=INEG+1 388 : IF(LL.ITTR(II).NE.0) NBLAG=NBLAG+1 389 : LIG1.VAL(NNS)=LIG2.VAL(NN) 390 : 156 CONTINUE 391 : NA=IMMM(/1) 392 : * 393 : * RECOMPACTAGE DE LIGN (DEJA ENTIEREMENT TRAITEE) 394 : * d'abord la triangulaire superieure 395 : * 395 : CALL COMPAC(LIG1.VAL(1),NBPAR,KIVPO(1),KIVLO(1), 396 : # NVALL,LIG1.IPPVV(1),IZROSF,NA,PREC,imasq(1)) 397 : 398 : IF (NBPAR.NE.NA+1.OR.NVALL.NE.LIG1.VAL(/1)) SEGADJ LIG1 399 : NVSTOR=NVSTOR+NVALL 400 : nvstrm=max(nvstrm,nvall) 401 : DO 143 LHG=1,NBPAR 402 : LIG1.IVPO(2*LHG-1)=KIVPO(LHG) 403 : LIG1.IVPO(2*LHG)=KIVLO(LHG) 404 : 143 CONTINUE 405 : * IF(I.EQ.910) THEN 406 : * WRITE (6,*) ' NOEU ',I,' DIAG INVERSE ',LIG1.VAL(VAL(/1)) 407 : * WRITE (6,*) ' LIGNE APRES COMPACTION VAL ' 408 : * WRITE (6,*) (LIG1.VAL(IK),IK=1,LIG1.VAL(/1)) 409 : * WRITE (6,*) 'KIVPO ' 410 : * WRITE (6,*) (KIVPO(IK),IK=1,NBPAR) 411 : * WRITE (6,*) 'KIVLO ' 412 : * WRITE (6,*) (KIVLO(IK),IK=1,NBPAR) 413 : * write(6,*) ( LIG1.IPPVV(IU),IU=1,LIG1.IPPVV(/1)) 414 : * ENDIF 415 : * 416 : * RECOMPACTAGE DE LIGN (DEJA ENTIEREMENT TRAITEE) 417 : * puis la triangulaire superieure 418 : * 419 : NBPAR=NA+1 419 : CALL COMPAC(LIG2.VAL(1),NBPAR,KIVPO(1),KIVLO(1), 420 : # NVILL,LIG2.IPPVV(1),IZROSF,NA,PREC,imasqi(1)) 421 : NVALL=NVILL 422 : IF (NBPAR.NE.NA+1.OR.NVILL.NE.LIG2.VAL(/1)) SEGADJ LIG2 423 : NVSTIR=NVSTIR+NVILL 424 : nvstrm=max(nvstrm,nvIll) 425 : DO 1430 LHG=1,NBPAR 426 : LIG2.IVPO(2*LHG-1)=KIVPO(LHG) 427 : LIG2.IVPO(2*LHG)=KIVLO(LHG) 428 : 1430 CONTINUE 429 : segsup imasq 430 : imasq=itmasq(i) 431 : * IF(I.EQ.910) THEN 432 : * WRITE (6,*) ' NOEU ',I,' DIAG INVERSE ',LIG2.VAL(VAL(/1)) 433 : * WRITE (6,*) ' LIGNE APRES COMPACTION VAL ' 434 : * WRITE (6,*) (LIG2.VAL(IK),IK=1,LIG2.VAL(/1)) 435 : * WRITE (6,*) 'KIVPO ' 436 : * WRITE (6,*) (KIVPO(IK),IK=1,NBPAR) * WRITE (6,*) 'KIVLO ' 437 : * WRITE (6,*) (KIVLO(IK),IK=1,NBPAR) 438 : * write(6,*) ( LIG2.IPPVV(IU),IU=1,LIG2.IPPVV(/1)) 439 : * ENDIF 440 : 441 : C **** ON TRIANGULARISE LES AUTRES LIGNES 442 : C 443 : GOTO 5 444 : 7 CONTINUE 445 : IF(I.GE.IMIN) THEN 446 : SEGACT,LIG2 447 : IPPR=LIG2.IPREL 448 : IDDR=LIG2.IDERL 449 : 450 : C 451 : C **** BOUCLE *10* SUR LES LIGNES DES NOEUDS INFERIEUR JUSQU'A 452 : C **** IL2 ON CALCULE UNE COLONNE 453 : C 454 : DO 10 JBI=IL1,IL2 455 : LIGN=MM.ILIGN(JBI) 456 : IMASQ=ITMASQ(JBI) 456 : CALL CHOLE3(IPREL,IDERL,IPPVV(1),IPPR,IDDR,IVPO(1), 457 : # LIG2.IPPVV(1),VAL(1),LIG2.VAL(1),LIG2.IVPO(1), 458 : > imasq(1),prec) 459 : IF(IMM.GT.I) GO TO 106 460 : 10 CONTINUE 461 : 106 CONTINUE 462 : * IF(I.LT.IL1) SEGDES,LIG1 463 : SEGDES,LIG2 464 : ENDIF 465 : IF(I.GE.IMINII) THEN 466 : SEGACT,LIG1 467 : IPPR=LIG1.IPREL 468 : IDDR=LIG1.IDERL 469 : 470 : C 471 : C **** BOUCLE *10* SUR LES LIGNES DES NOEUDS INFERIEUR JUSQU'A 472 : C **** IL2 ON CALCULE UNE COLONNE 473 : C 474 : DO 100 JBI=IL1,IL2 475 : LIGN=LL.ILIGN(JBI) 476 : IMASQ=ITMASI(JBI) 476 : CALL CHOLE3(IPREL,IDERL,IPPVV(1),IPPR,IDDR,IVPO(1), 477 : # LIG1.IPPVV(1),VAL(1),LIG1.VAL(1),LIG1.IVPO(1), 478 : > imasq(1),prec) 479 : IF(IMM.GT.I) GO TO 1060 480 : 100 CONTINUE 481 : 1060 CONTINUE 482 : * IF(I.LT.IL1) SEGDES,LIG2 483 : SEGDES,LIG1 484 : ENDIF 485 : 486 : 5 CONTINUE 487 : DO 11 I=IL1,IL2 488 : LIGN=LL.ILIGN(I) 489 : SEGDES,LIGN 490 : LIGN=MM.ILIGN(I) 491 : SEGDES,LIGN 492 : 11 CONTINUE 493 : IF(IL2.LT.INO) GO TO 1 494 : C ON MET A JOUR LE NOMBRE DE TERMES DIAGONAUX NEGATIF 495 : C ON ENLEVE LE NOMBRE DE MULTIPLICATEUR DE LAGRANGE 496 : c INEG=INEG-NBLAG 497 : * on ne compte pas 2 fois les multiplicateurs qui vont etre 498 : * eliminés lors de la resolution car mode d'ensemble 499 : INEG=INEG-(NBLAG-NENSLX) 500 : if (iimpi.ne.0.and.NENSLX.gt.0) WRITE(IOIMP,4820) NENSLX 501 : 4820 FORMAT(I12,' MODES D ENSEMBLE PORTANT SUR DES MULTIPLICATEURS', 502 : 1' DE LAGRANGE DETECTES') 503 : 504 : IF (IIMPI.EQ.1)WRITE(IOIMP,4821) NVSTOC+NVSTIC 505 : 4821 FORMAT( ' NOMBRE DE VALEURS DANS LE PROFIL',I9) 506 : IF (IIMPI.EQ.1)WRITE(IOIMP,4822) NVSTOR+NVSTIR 507 : 4822 FORMAT( ' NOMBRE DE VALEURS STOCKEES DANS LE PROFIL',I9) 508 : INTERR(1)=NVSTOR+NVSTIR 508 : IF (IPASV.EQ.0) CALL ERREUR(-278) 509 : IPASV=1 510 : SEGDES,MINCPO 511 : SEGDES,MIMIK 512 : SEGDES,MMATRI 513 : SEGDES,LL,MM 514 : SEGDES,MDIAG 515 : MMATRX=MMATRI 516 : SEGSUP KIVPO,KIVLO,ITMASQ 517 : RETURN 518 : END 519 : 520 : 521 : 522 : 523 : 524 : 525 : 526 : 527 : 528 : 529 : 530 : 531 : 532 : 533 : 534 : 535 : 536 : 537 : 538 : 539 : 540 : 541 :
© Cast3M 2003 - All rights reserved.
Disclaimer