Télécharger la plaquette Cast3M


fr en

Télécharger shole.eso

Retour à la liste

Numérotation des lignes : 

shole

  1. C SHOLE     SOURCE    PV090527  26/08/26    21:15:18     12625          
  2.       SUBROUTINE SHOLE(MMATRX,PREC,ISTAB,NBNNMA,NLIGRA,XMATRI,INSYM)
  3. C----------------------------------------------------------------------
  4. C     Factorisation de la matrice MMATRX
  5. C     Solveur direct : 
  6. C     - matrice     symetrique : A = L D Lt
  7. C     - matrice non symetrique : A = L D M
  8. C     Solveur iteratif :
  9. C     - matrice     symetrique : ILU(0)
  10. C     - matrice non symetrique : pas implemente
  11. C----------------------------------------------------------------------
  12.       IMPLICIT INTEGER(I-N)
  13.       IMPLICIT REAL*8(A-H,O-Z)
  14. C  TANT QUE OOOVAL(1,4) NE MARCHE PAS SUR CRAY
  15.       PARAMETER (LPCRAY=10000)
  16.       INTEGER OOOVAL,OOOLEN
  17.       dimension ittime(4)
  18. C
  19. -INC PPARAM
  20. -INC CCOPTIO
  21. -INC CCREEL
  22. -INC SMMATRI
  23. -INC SMRIGID
  24. -INC CCASSIS
  25. -INC CCHOLE
  26. -INC SMCOORD
  27. C
  28.       POINTEUR LILIGN.MILIGN
  29.       POINTEUR LLIGL.LLIGN,LLIGM.LLIGN
  30.       POINTEUR LIGL.LIGN,LIGM.LIGN,LIG5.LIGN,LIG3.LIGN
  31.       SEGMENT KIVPO(IIMAX)
  32.       SEGMENT KIVLO(IIMAX)
  33.       segment immt(nblig)
  34.       segment xreser
  35.        integer ireser(ivstrm)
  36.        real yreser(nvstrm)
  37.       endsegment
  38.       SEGMENT ILR
  39.         integer ILIGR(NNOE)
  40.       ENDSEGMENT
  41.       POINTEUR ILIGNS.ILR
  42.       external chole4i
  43.       external shole3i
  44.       DATA COEAUG/0.75D0/
  45.       SAVE IPASV
  46.       DATA IPASV/0/
  47. *  ngmpet dit si on tient en memoire (false) ou si on deborde (true)
  48.       logical ngmpet
  49.       logical lsgdes,pasfait
  50.       LOGICAL bNONSYM,bSOITER
  51. C
  52.       SEGDES,MCOORD
  53.       maitre=0
  54.       xreser=0
  55.       pasfait=.true.
  56.       lsgdes=.false.
  57. *  faire attention a respecter l'ordre des segdes par la suite
  58.       call ooomru(1)
  59.       if (istab.ne.0.and.istab.ne.1) call erreur(5)
  60.       condmax=0.d0
  61.       condmin=xgrand*xzprec
  62.       ngmpet=.false.
  63.       nvallp=nvall
  64.       call timespv(ittime,oothrd)
  65.       kcour=(ittime(1)+ittime(2))/10
  66.       kcouri=kcour
  67.       kcour=0
  68.       nbopit=0
  69.       nvaor=0
  70.       nbthro=nbthrs
  71.       ithrd=0
  72.       if (nbthro.gt.1) then
  73.        ithrd=1
  74.        call threadii
  75.        call oooprl(1)
  76.       endif
  77.       nbthr=nbthro
  78.       do ith=1,nbthr
  79.        nbop(ith)=0
  80.       enddo
  81.       stmult=1d-5
  82.  
  83.       nvstrm=0
  84.       ivstrm=oooval(1,4)*2
  85. C     write(6,*) 'nvstrm initial',nvstrm
  86.       MMATRI=MMATRX
  87.       SEGACT,MMATRI*MOD
  88.       PRCHLV=PREC
  89. C
  90. C     Matrice non symetrique ou non
  91.       bNONSYM=(INSYM.EQ.1)
  92. C     Solveur iteratif ou non
  93.       bSOITER=(MFACT.EQ.1)
  94. C
  95.       MILIGN=IILIGN
  96.       SEGACT,MILIGN*MOD
  97.       LILIGN=MILIGN
  98.       ICOE=1
  99.       IF (bNONSYM) THEN
  100.         ICOE=2
  101.         LILIGN=IILIGS
  102.         SEGACT,LILIGN*MOD
  103.       ENDIF
  104. C
  105.       INO=MILIGN.ILIGN(/1)
  106.       NNOE=INO
  107.       SEGINI,ILIGNS
  108. C
  109.       MDIAG=IDIAG
  110.       SEGACT,MDIAG*MOD
  111.       NBLIG=INO
  112.       segini immt
  113.       precc=prec
  114.       INC=DIAG(/1)
  115. C
  116. C     Cas du super-element
  117.       nbnnmc=inc+1
  118.       if (xmatri.ne.0) then
  119.         nelrig=1
  120.         nligrp=nligra
  121.         nligrd=nligra
  122.         rigrel=0
  123.         segini xmatri
  124.         nbnnmc=nbnnma
  125.       endif
  126.       matric=xmatri
  127.       INCC=INC
  128.       MIMIK=IIMIK
  129.       MINCPO=IINCPO
  130.       SEGACT,MINCPO,MIMIK
  131.       IPLUMI=IMIK(/2)*2 +4
  132.       IL2=0
  133.       IIMAX=IJMAX+IPLUMI
  134.       SEGINI KIVPO,KIVLO
  135.       INEG=0
  136.       NBLAG=0
  137.       NENSLX=0
  138.       NVSTOC=0
  139.       NVSTOR=0
  140.       diagmax=XPETIT/XZPREC
  141.       diagmin=xgrand
  142.       do i=1,diag(/1)
  143.        if (abs(diag(i)).le.xspeti) diag(i)=
  144.      >      xspeti              
  145.        if (ittr(i).eq.0) diagmax=max(diagmax,abs(diag(i)))
  146.        if (ittr(i).eq.0.and.abs(diag(i)).gt.xpetit/xzprec) then
  147.          diagmin=min(diagmin,abs(diag(i)))
  148.        endif
  149.       enddo
  150.       if (diagmax.le.xpetit/xzprec) then
  151.          do i=1,diag(/1)
  152.            diagmax=max(diagmax,abs(diag(i)))
  153.            if (abs(diag(i)).gt.xpetit/xzprec)
  154.      >       diagmin=min(diagmin,abs(diag(i)))
  155.          enddo
  156.       endif
  157.       diagmin=min(diagmin,diagmax)
  158. **     write (6,*) ' shole diagmin diagmax ',diagmin,diagmax,diag(/1)
  159. C
  160. C  **** DEBUT DE LA TRIANGULARISATION. ON PREND NOEUD A NOEUD,
  161. C  **** DECOMPACTAGE PUIS TRAVAIL SUR LES LIGNES DU NOEUDS
  162. C
  163. C  ****  LA LONGUEUR DE LA PLUS GRANDE LIGNE EST DONNEE PAR IMAX
  164. C
  165. C SP  indicateurs pour impression message "stabilisation RESO..."
  166.       isr=0
  167.       isrl=0
  168.  
  169.   1   CONTINUE
  170.       IL1=IL2+1
  171.       IMIN=IL1
  172. C
  173. C     Reserver de la place ou mettre les lignes superieures dans le cas debordement
  174.       if (ngmpet) then
  175.         if (xreser.eq.0) then
  176. CC      write(6,*)'segini xreser',nvstrm
  177.         segini xreser
  178.         endif
  179.       endif
  180. C
  181.       DO 2 I=IL1,INO
  182. C
  183.       LIGL=0
  184.       LIGM=0
  185.       LGLIG=0
  186. C
  187.       IF (bNONSYM) THEN
  188.         LLIGM=LILIGN.ILIGN(I)
  189.         LLIGL=MILIGN.ILIGN(I)
  190.         SEGACT /ERR=32/LLIGM
  191.         SEGACT /ERR=32/ LLIGL
  192.       ELSE
  193.         LLIGM=MILIGN.ILIGN(I)
  194.         SEGACT /ERR=32/LLIGM
  195.       ENDIF
  196.       GOTO 31
  197.   32  CONTINUE
  198.       IF (LSGDES) GOTO 3
  199. **    write(6,*) 'desactivation-1 ',1,il1-1
  200.       lsgdes=.true.
  201.       do it=il1-1,1,-1
  202.         lig1=ILIGNS.ILIGR(it)
  203.         segdes lig1
  204.         IF (bNONSYM) THEN
  205.           lig1=LILIGN.ilign(it)
  206.           segdes lig1
  207.         ENDIF
  208.         lig1=MILIGN.ilign(it)
  209.         segdes lig1
  210.       enddo
  211.       SEGACT /ERR=3/ LLIGM
  212.       IF (bNONSYM) SEGACT /ERR=3/ LLIGL
  213.   31  CONTINUE
  214. ** essai pv
  215.       NVMAX=LLIGM.NJMAX
  216.       IF (bNONSYM) NVMAX=MAX(NVMAX,LLIGL.NJMAX)
  217.       if (ngmpet) then
  218.         if (nvmax.gt.2*njmaxp.and.i-il1+1.gt.nbthrs/2) then
  219. **        write(6,*) 'fin de bloc il1  i nvmax',il1,i,nvmax
  220.           goto 3
  221.         endif
  222.       endif
  223.       NJMAXP=NVMAX
  224. ** fin essai
  225. C
  226.       NVALL=0
  227.       IF (bNONSYM) THEN
  228.         NA1  =LLIGM.IMMMM(/1)
  229.         NVAL1=LLIGM.IMMMM(NA1)-LLIGM.LDEB(1)
  230.         LDEB1=LLIGM.LDEB(1)
  231.         NA2  =LLIGL.IMMMM(/1)
  232.         NVAL2=LLIGL.IMMMM(NA2)-LLIGL.LDEB(1)
  233.         LDEB2=LLIGL.LDEB(1)
  234. C
  235. C       Il peut arriver que les segments ligne et colonne
  236. C       d'un meme noeud ne demarrent pas de la meme colonne/ligne.
  237. C       Decalage pour que ce ne soit plus le cas
  238.         LDEBM=MIN(LDEB1,LDEB2)
  239.         IF      (LDEB1-LDEBM.NE.0) THEN
  240.           SEGACT,LLIGM*MOD
  241.           LLIGM.NJMAX=LLIGL.NJMAX
  242.           DO IMV=1,NA1
  243.             LLIGM.LDEB(IMV)=LDEBM
  244.           ENDDO
  245.         ELSE IF (LDEB2-LDEBM.NE.0) THEN
  246.           SEGACT,LLIGL*MOD
  247.           LLIGL.NJMAX=LLIGM.NJMAX
  248.           DO IMV=1,NA2
  249.             LLIGL.LDEB(IMV)=LDEBM
  250.           ENDDO
  251.         ENDIF
  252.         NVALT=MAX(NVAL1,NVAL2)
  253.       ELSE
  254.         NA=LLIGM.IMMMM(/1)
  255.         NBPAR=NA+1
  256.         NVALT=LLIGM.IMMMM(NA)-LLIGM.LDEB(1)
  257.       ENDIF
  258.       if (ngmpet.and.nvalt.lt.nvallp/3) then
  259. **      write(6,*) 'passage en lent'
  260.         ngmpet=.false.
  261.       endif
  262.       NVALLP=NVALT
  263.       if (ngmpet) then
  264. C       nvall=(NVMAX*nvstor)/nvstoc
  265.         NVALL=NVMAX
  266.         if (nvall.gt.NVSTRM) then
  267. C       write(*,*)'redimensionnement de xreser',nvstrm,(2*ICOE*NVALL),
  268. C    &             il1,il2
  269.           nvstrm=2*ICOE*nvall
  270.           segsup,xreser
  271.           segini,xreser
  272.         endif
  273.       endif
  274. C
  275.       IF (bNONSYM) THEN
  276. C       Le masque est uniquement present dans LIGM
  277.         NA=NA1
  278.         NBPAR=NA+1
  279.         LMASQ=MASQA(NVALT+MASDIM)
  280.         SEGINI /ERR=33/ LIGM
  281. C
  282.         NA=NA2
  283.         NBPAR=NA+1
  284.         LMASQ=0
  285.         SEGINI /ERR=33/ LIGL
  286.       ELSE
  287.         LMASQ=MASQA(NVALT+MASDIM)
  288.         SEGINI /ERR=33/ LIGM
  289.       ENDIF
  290.       GOTO 34
  291.   33  CONTINUE
  292.       IF (LSGDES) GOTO 3
  293. **    write(6,*) 'desactivation-2 ',1,il1-1
  294.       lsgdes=.true.
  295.       do it=il1-1,1,-1
  296.         lig1=ILIGNS.ILIGR(it)
  297.         segdes lig1
  298.         IF (bNONSYM) THEN
  299.           lig1=LILIGN.ilign(it)
  300.           segdes lig1
  301.         ENDIF
  302.         lig1=MILIGN.ilign(it)
  303.         segdes lig1
  304.       enddo
  305.       IF (bNONSYM) THEN
  306.         IF (LIGM.EQ.0) THEN
  307.           NA=NA1
  308.           NBPAR=NA+1
  309.           LMASQ=MASQA(NVAL1+MASDIM)
  310.           SEGINI /ERR=3/ LIGM
  311.         ENDIF
  312.         IF (LIGL.EQ.0) THEN
  313.           NA=NA2
  314.           NBPAR=NA+1
  315.           LMASQ=0
  316.           SEGINI /ERR=3/ LIGL
  317.         ENDIF
  318.       ELSE
  319.         SEGINI /ERR=3/ LIGM
  320.       ENDIF
  321.   34  CONTINUE
  322. C
  323. C     Travail sur la partie superieure
  324.       IF (bNONSYM) MILIGN=IILIGS
  325. C
  326.       LLIGN =LLIGM
  327.       LIGN  =LIGM
  328.       ILIGNS.ILIGR(I)=LIGM
  329. C
  330.   35  CONTINUE
  331. C
  332. C     Recuperer la longueur du segment
  333.       NA    =LIGN.IMMM(/1)
  334.       LGLIG =LGLIG  + NA*INT(REAL(LLIGN.NJMAX/NA)**(4.D0/3.D0))
  335.       NVSTOC=NVSTOC + LLIGN.NJMAX
  336.       NVAOR =NVAOR  + LLIGN.XXVA(/1)
  337. C
  338. C  ****  DECOMPACTAGE
  339. C
  340.       IPA=1
  341.       DO 121 JPA=1,NA
  342.         KPA =LLIGN.IPPO(JPA+1)-LLIGN.IPPO(JPA)
  343.         IPP =LLIGN.IPPO(JPA)
  344.         LPA =LLIGN.LDEB(JPA)
  345.         LPA1=LPA-IPA
  346.         LIGN.IMMM(JPA) =LPA
  347.         LIGN.IVPO(JPA) =IPA
  348.         LIGN.IPPVV(JPA)=IPA-1
  349.         DO 122 MPA=1,KPA
  350.           IPLA=LLIGN.LINC(MPA+IPP)-LPA1
  351.           ICC =IPLA-IPA+1
  352.           ICC1=ICC-MASQD(ICC)+1
  353.           MICC=MASQA(ICC)
  354.           IMSQ=LIGM.IMASQ(MICC)
  355.           IF (IMSQ.LE.0) THEN
  356.             MSQH=icc1
  357.             MSQB=icc1
  358.           ELSE
  359.             MSQH=MAX(MASQH(IMSQ),icc1)
  360.             MSQB=MIN(MASQB(IMSQ),icc1)
  361.           ENDIF
  362.           LIGM.IMASQ(MICC)=MASQV(MSQB,MSQH)
  363. 122     CONTINUE
  364.         IPA=IPA+LLIGN.IMMMM(JPA)-LPA + 1
  365.         IF(IMIN.GT.MILIGN.IPNO(LPA)) IMIN=MILIGN.IPNO(LPA)
  366. 121   CONTINUE
  367.       LIGN.IPPVV(NA+1)=IPA-1
  368. C
  369.       IF (NA.GT.0) THEN
  370.         LIGN.IPREL=LLIGN.IMMMM(1)
  371.         LIGN.IDERL=LLIGN.IMMMM(NA)
  372.         MILIGN.LCARA(2,I)=LIGN.IPREL
  373.         MILIGN.LCARA(3,I)=LIGN.IDERL
  374.       ENDIF
  375. C
  376. C     Travail sur la partie inferieure
  377.       IF ((bNONSYM).AND.(MILIGN.EQ.IILIGS)) THEN
  378.         MILIGN=IILIGN
  379.         LLIGN =LLIGL
  380.         LIGN  =LIGL
  381.         GOTO 35
  382.       ENDIF
  383. C
  384. C     Indexation de imasq
  385.       LMASQ=LIGM.IMASQ(/1)
  386.       ipln=lmasq
  387.       idec=1
  388.       do 123 ipl=lmasq,1,-1
  389.         if (LIGM.imasq(ipl).gt.0) then
  390.           ipln=ipl-1
  391.           idec=MASQB(LIGM.IMASQ(IPL))
  392.         else
  393.           LIGM.IMASQ(IPL)=-(IPLN*MASDIM+IDEC)
  394.         endif
  395.  123  continue
  396. CCC   write (6,*) ' imasq ',lmasq
  397. CCC   write (6,*) (LIGM.imasq(ipl),ipl=1,lmasq)
  398. C
  399. C*    write (6,*) 'longueur ligne ',nvall
  400. C nb de ligne multiple du nb de threads
  401. C blocage ligne lecture-ecriture pour minimiser le cache
  402. C on note si on est au minimum de lignes
  403.       nbthro=min(nbthrs,lglig/800+1)
  404.       nbthro2=min(nbthrs,lglig/10000+1)
  405.       IF (.not.ngmpet) THEN
  406.         if (i+1-il1.ge.nbthro2) then
  407.           nbthro2=min(nbthrs,i+1-il1)
  408.         endif
  409.         if (i+1-il1.ge.nbthro) then
  410.           nbthro=min(nbthrs,i+1-il1)
  411.           il2=i
  412. **        write(6,*) ' nbthro il1 il2 ',nbthro,il1,il2
  413.           GOTO 4
  414.         endif
  415.       ENDIF
  416.  
  417.     2 CONTINUE
  418.       IL2=INO
  419.       GOTO 4
  420.     3 CONTINUE
  421.       IL2=I-1
  422. **    write(6,*) 'desactivation-4 ',lligm
  423.       SEGDES,LLIGM
  424.       IF (LIGM.NE.0) SEGSUP,LIGM
  425.       IF (bNONSYM) THEN
  426.         SEGDES,LLIGL
  427.         IF (LIGL.NE.0) SEGSUP,LIGL
  428.       ENDIF
  429.     4 CONTINUE
  430.       nbthro=min(nbthrs,nbthro)
  431.       nbthro2=min(nbthrs,nbthro2)
  432.       nbthr=nbthro
  433.       if(xreser.ne.0) then
  434. CC      write(6,*)'segsup xreser 1',il1,il2
  435.         segsup xreser
  436.         xreser=0
  437.       endif
  438. C
  439.       IF(IL2.GE.IL1) GOTO 40
  440. C
  441. C ****  MESSAGE PAS ASSEZ DE PLACE MEMOIRE
  442. C
  443.       CALL ERREUR(48)
  444. **    call ooodmp(0)
  445.       if (ithrd.eq.1) then
  446.        call threadis
  447.        call oooprl(0)
  448.       endif
  449.       call ooomru(0)
  450.       RETURN
  451.    40 CONTINUE
  452. C
  453. C     Travail sur la partie superieure
  454.       IF (bNONSYM) MILIGN=IILIGS
  455. C
  456.    39 CONTINUE
  457. C
  458.       IM=INC
  459.       DO 352 IH=IL2,IL1,-1
  460.         LIGN=ILIGNS.ILIGR(IH)
  461.         IL=INC
  462.         DO 354 JH=1,LIGN.IMMM(/1)
  463.           IM=MIN(IM,LIGN.IMMM(JH))
  464.           IL=MIN(IL,LIGN.IMMM(JH))
  465.  354    CONTINUE
  466.         LIGN.IML=IL
  467.         MILIGN.LCARA(1,IH)=LIGN.IML
  468.         IMMT(IH)=MILIGN.IPNO(IM)
  469.   352 CONTINUE
  470. C
  471. C     Travail sur la partie inferieure
  472.       IF ((bNONSYM).AND.(MILIGN.EQ.IILIGS)) THEN
  473.         MILIGN=IILIGN
  474.         GOTO 39
  475.       ENDIF
  476. C
  477.       IMAX=IL1-1
  478.       IF (LSGDES) THEN
  479.         DO IT=IMIN,IL1-1
  480.           LIG1=ILIGNS.ILIGR(IT)
  481.           SEGACT /ERR=333/ LIG1
  482.         ENDDO
  483.   333   CONTINUE
  484.         IMAX=IT-1
  485.       ENDIF
  486. C
  487.       nbthrp=nbthr
  488.       nbthr=min(nbthrp,il2-il1+1)
  489.       nbthr=nbthro2
  490.       IPER=IMIN
  491.       IDER=IMAX
  492.       IL1P=IL1
  493.       DO 13 I=IL1,IL2
  494. C
  495.         IF (bSOITER) GOTO 337
  496.         IF (bNONSYM) MILIGN=IILIGS
  497.   336   CONTINUE
  498. C
  499. C       Travail sur la partie inferieure
  500.         IF (bNONSYM) LILIGN=IILIGN
  501. C
  502.         DO ITH=1,NBTHR-1
  503.           CALL THREADID(ITH,SHOLE3I)
  504.         ENDDO
  505.         CALL SHOLE3I(NBTHR)
  506.         DO ITH=NBTHR-1,1,-1
  507.           CALL THREADIF(ITH)
  508.         ENDDO
  509. C
  510. C       Travail sur la partie superieure
  511.         IF (bNONSYM) THEN
  512.           LILIGN=IILIGS
  513.           DO ITH=1,NBTHR-1
  514.             CALL THREADID(ITH,SHOLE3I)
  515.           ENDDO
  516.           CALL SHOLE3I(NBTHR)
  517.           DO ITH=NBTHR-1,1,-1
  518.             CALL THREADIF(ITH)
  519.           ENDDO
  520.         ENDIF
  521. C
  522.   337   CONTINUE
  523. C
  524.         IF (I.EQ.IL1P.AND.IDER.NE.IL1P-1) THEN
  525.           DO IT=IDER,IPER,-1
  526.             LIG1=ILIGNS.ILIGR(IT)
  527.             SEGDES LIG1
  528.           ENDDO
  529.           IPER=IDER+1
  530.           IDER=IL1-1
  531.           DO IT=IPER,IDER
  532.             LIG1=ILIGNS.ILIGR(IT)
  533.             SEGACT /ERR=335/ LIG1
  534.           ENDDO
  535.   335     CONTINUE
  536.           IDER=IT-1
  537.           IF (IDER.LT.IPER) THEN
  538.             CALL ERREUR(48)
  539.             RETURN
  540.           ENDIF
  541.           GOTO 336
  542.         ENDIF
  543. C
  544.         NBTHR=1
  545. C
  546. C       Travail sur la partie superieure
  547.         IF (bNONSYM) MILIGN=IILIGS
  548.         LLIGN=MILIGN.ILIGN(I)
  549.         LIGN =ILIGNS.ILIGR(I)
  550.         NA=LIGN.IDERL-LIGN.IPREL+1
  551.         CALL SOMPAC(IPPVV(1),IMASQ(1),NA,KIVPO(1),KIVLO(1),NBPAR,IZROSF)
  552. C
  553.         NVALL=KIVLO(NBPAR)-1
  554.         LMASQ=MASQA(LLIGN.NJMAX)+1
  555. C
  556.   444   CONTINUE
  557. C
  558. C       LIGN est deja dimensionne a NJMAX
  559.         IF (ngmpet) THEN
  560.           SEGADJ,LIGN
  561.           LIG5=LIGN
  562.           GOTO 17
  563.         ENDIF
  564. C
  565.         SEGINI /ERR=109/ LIG5
  566.         GOTO 108
  567.  109    CONTINUE
  568.         IF (LSGDES) GOTO 14
  569. C       write(6,*) 'desactivation-3 ',1,il1p-1
  570.         lsgdes=.true.
  571.         do it=il1p-1,1,-1
  572.           lig1=ILIGNS.ILIGR(it)
  573.           segdes lig1
  574.           lig1=MILIGN.ilign(it)
  575.           segdes lig1
  576.         enddo
  577.         SEGINI /ERR=14/ LIG5
  578.  108    CONTINUE
  579.         LIG5.IML  =LIGN.IML
  580.         LIG5.IMM  =NBPAR
  581.         LIG5.IPREL=LIGN.IPREL
  582.         LIG5.IDERL=LIGN.IDERL
  583.         DO 111 LHE=1,NA
  584.           LIG5.IMMM(LHE)=LIGN.IMMM(LHE)
  585.  111    CONTINUE
  586.         DO 112 LHF=1,NA+1
  587.           LIG5.IPPVV(LHF)=LIGN.IPPVV(LHF)
  588.  112    CONTINUE
  589. C
  590.  17     CONTINUE
  591. C
  592.         DO 113 LHG=1,NBPAR
  593.           LIG5.IVPO(2*LHG-1)=KIVPO(LHG)
  594.           LIG5.IVPO(2*LHG)  =KIVLO(LHG)
  595.  113    CONTINUE
  596. C
  597.         DO IT=NBPAR-1,1,-1
  598.           IVI=LIG5.IVPO(2*IT)
  599.           IVF=LIG5.IVPO(2*(IT+1))-1
  600.           ICI=LIG5.IVPO(2*IT-1)
  601.           DO IC=MASQA(IVF-IVI+ICI),MASQA(ICI),-1
  602.             LIG5.IMASQ(IC)=IT
  603.           ENDDO
  604.         ENDDO
  605. C
  606.         IPA=1
  607.         DO 119 JPA=1,NA
  608.           IPP=LLIGN.IPPO(JPA)
  609.           KPA=LLIGN.IPPO(JPA+1)-IPP
  610.           LPA=LLIGN.LDEB(JPA)
  611.           LPA1=LPA-IPA
  612.           DO 120 MPA=1,KPA
  613.             XXV=LLIGN.XXVA(MPA+IPP)
  614.             IF (ABS(XXV).LE.XPETIT) GOTO 120
  615.             IPLA=LLIGN.LINC(MPA+IPP)-LPA1
  616.             IMSQ=LIG5.IMASQ(MASQA(IPLA))
  617.             IF (IMSQ.GT.0) THEN
  618. 114           CONTINUE
  619.               IF (IPLA.GE.LIG5.IVPO(2*(IMSQ+1)-1)) THEN
  620.                 IMSQ=IMSQ+1
  621.                 GOTO 114
  622.               ENDIF
  623.               IDBC=LIG5.IVPO(2*IMSQ-1)
  624.               IDBV=LIG5.IVPO(2*IMSQ  )
  625.               IPOS=IDBV+(IPLA-IDBC)
  626.               LIG5.VAL(IPOS)=XXV
  627.             ENDIF
  628. 120       CONTINUE
  629.           IPA=IPA+LLIGN.IMMMM(JPA)-LPA+1
  630. 119     CONTINUE
  631. C
  632.         ITR=NBPAR
  633.         DO 125 IPL=LMASQ,1,-1
  634.           IF (LIG5.IMASQ(IPL).GT.0) THEN
  635.             ITR=LIG5.IMASQ(IPL)
  636.           ELSE
  637.             LIG5.IMASQ(IPL)=-ITR
  638.           ENDIF
  639.  125    CONTINUE
  640. C
  641.         SEGSUP,LLIGN
  642.         MILIGN.ILIGN(I)=LIG5
  643.         ILIGNS.ILIGR(I)=0
  644. C
  645. C       Travail sur la partie inferieure
  646.         IF ((bNONSYM).AND.(MILIGN.EQ.IILIGS)) THEN
  647.           MILIGN=IILIGN
  648.           LLIGN=MILIGN.ILIGN(I)
  649.           GOTO 444
  650.         ENDIF
  651.         IF (.not.ngmpet) SEGSUP,LIGN
  652. C
  653.         IDER=I
  654.         IPER=IDER
  655.         IL1=I+1
  656.   13  CONTINUE
  657.       GOTO 15
  658.   14  CONTINUE
  659.       LIGN=ILIGNS.ILIGR(I)
  660.       SEGSUP,LIGN
  661.       IL2=I-1
  662.   15  CONTINUE
  663.       IL1=IL1P
  664. C
  665.       if (lsgdes) then
  666. C       write(6,*) 'desactivation-4 ',1,il1-1
  667.         do it=il1-1,imin,-1
  668.           lig1=ILIGNS.ILIGR(it)
  669.           if (lig1.ne.0) segdes lig1
  670.         enddo
  671.       endif
  672.       nbthr=nbthrp
  673. C
  674. C  ****  BOUCLE  *5*  TRAVAILLE SUR LE NOEUD I QUI EST EN LECTURE
  675. C
  676.       ipos=0
  677.       iper=imin
  678.       ider=imin-1
  679.       DO 5 I=IMIN,IL2
  680.  
  681.       IF (bNONSYM) THEN
  682.         LIGM=LILIGN.ILIGN(I)
  683.         LIGL=MILIGN.ILIGN(I)
  684.       ELSE
  685.         LIGM=MILIGN.ILIGN(I)
  686.       ENDIF
  687. C
  688.       IF(I.LT.IL1) GOTO 7
  689. C
  690. C  ******* LE NOEUD I EST EN MEMOIRE IL EST TRIANGULE JUSQU'A
  691. C  ******* IPREL  IL FAUT CONTINUER TOUTE LES LIGNES PUIS CALCULER
  692. C  ******* LE TERME DIAGONAL
  693. C
  694.       LIGN=LIGM
  695.       NBCOL=LIGN.IVPO(2*LIGN.IPPVV(2)-1)-1
  696.       DO 156 KHG=1,LIGN.IMMM(/1)
  697. C
  698.         LIGN=LIGM
  699.         II=LIGN.IPREL-1+KHG
  700.         LIGN.IMMM(KHG)=0
  701. C
  702.         MM=LIGN.IVPO(2*LIGN.IPPVV(KHG))
  703.         NN=LIGN.IVPO(2*LIGN.IPPVV(KHG+1))
  704.         N=NN-MM
  705.         NN=NN-1
  706. C
  707.         DIAG(II)=LIGN.VAL(NN)
  708.         IF (N.EQ.1) THEN
  709.           IF (II-NBNNMC.GT.0) THEN
  710.             RE(II-NBNNMC,II-NBNNMC,1)=LIGN.VAL(NN)
  711.             GOTO 41
  712.           ENDIF
  713.           GOTO 8
  714.         ENDIF
  715. C
  716.         IF (.NOT.bNONSYM) GOTO 8
  717. C
  718. C       Travail sur la partie superieure
  719.         LIGN.VAL(NN)=LIGN.VAL(NN)+
  720.      &               CHOLE5(LIGN,LIGL,KHG,DIAG(1),NBCOL,0,NBOP(1))
  721.    8    CONTINUE
  722. C
  723. C       Travail sur la partie inferieure + terme diagonal
  724.         IF (bNONSYM) THEN
  725.           LIGN=LIGL
  726.           II=LIGN.IPREL-1+KHG
  727.           LIGN.IMMM(KHG)=0
  728. C
  729.           MM=LIGN.IVPO(2*LIGN.IPPVV(KHG))
  730.           NN=LIGN.IVPO(2*LIGN.IPPVV(KHG+1))
  731.           N=NN-MM
  732.           NN=NN-1
  733.         ENDIF
  734. C
  735.         LIGN.VAL(NN)=LIGN.VAL(NN)+
  736.      &               CHOLE5(LIGN,LIGM,KHG,DIAG(1),NBCOL,1,NBOP(1))
  737.         IF (II-NBNNMC.GT.0) THEN
  738.           RE(II-NBNNMC,II-NBNNMC,1)=LIGN.VAL(NN)
  739.           GOTO 41
  740.         ENDIF
  741. C
  742.         if (diag(ii).eq.0.d0) diag(ii)=-xspeti 
  743.         IF (bSOITER) THEN
  744.           if (diag(ii).ne.0.d0) then
  745.             if (ittr(ii).eq.0) then
  746.               if (abs(val(nn)).lt.abs(diag(ii))*coeaug) then
  747. **              write(6,*)'augmentation raideur ii',ii,val(nn),diag(ii)
  748.                 val(nn)=diag(ii)*coeaug
  749.               endif
  750.             else
  751.               if (abs(val(nn)).lt.abs(diag(ii))*coeaug) then
  752. **              write(6,*)'augmentation raideur ii',ii,val(nn),diag(ii)
  753.                 val(nn)=diag(ii)*coeaug
  754.               endif
  755.             endif
  756.           endif
  757.         ENDIF
  758. C
  759. C       Terme diagonal ok?
  760.         diagref=max(abs(diag(ii)),diagmin)
  761.         diagcmp=diagref*5d-12
  762.         IF (ABS(LIGN.VAL(NN)).GT.diagcmp) GOTO 12
  763. **      write(6,*) ' ittr val diagcmp ',ittr(ii),val(nn),diagcmp
  764. C  il faut mettre une valeur plus grande sur les LX car on a un probleme de conditionnement
  765. C  sur le calcul des reactions en cas de 2 relations presque identique
  766. C
  767. C  **** ON VIENT DE DETECTER UN MODE D'ENSEMBLE
  768. C  **** ON AJOUTE A LA STRUCTURE UN RESSORT EGAL A CELUI QUI EXISTAIT
  769. C  **** AU PREALABLE SUR CETTE INCONNUE.
  770. C
  771. *     write (6,*) ' shole mode d ensemble ittr ligne ',
  772. *    >      ittr(ii),ii,diag(ii),val(nn),diagref
  773. C  on garde le signe car il fau un moins sur les ML
  774.         vmaxi=diagref
  775.         do ipv=MM,NN
  776.           vmaxi=max(vmaxi,abs(lign.val(ipv)))
  777.         enddo
  778.         if(ittr(ii).NE.0) then
  779.           lign.VAL(NN)=lign.val(nn)-1.30D0*diagref
  780.           NENSLX=NENSLX+1
  781.         else
  782.           lign.val(nn)=vmaxi
  783.         endif
  784.         NENS=NENS+1
  785.         LIGM.IMMM(KHG)=NENS
  786.         IF (bNONSYM) LIGL.IMMM(KHG)=NENS
  787.    12   CONTINUE
  788. C
  789. C       Stabilisation
  790.         IF (ISTAB.NE.0) THEN
  791. C
  792. C         Elimination des Nan
  793.           if(.not.(abs(LIGN.val(nn)).lt.xgrand*xzprec).and.pasfait) then
  794.             pasfait=.false.
  795.             LIGN.val(nn)=xgrand*xzprec
  796.             write (6,*) 'Nan dans shole ligne',ii
  797.           endif
  798. C
  799.           diagcmp=abs(diagmin)*1d-5+xpetit/xzprec
  800.           IF (ITTR(II).EQ.0) THEN
  801.             IF (LIGN.VAL(NN).LT.-DIAGMAX*1D-3) THEN
  802.               LIGN.VAL(NN)=ABS(LIGN.VAL(NN))
  803. ***           val(nn)=diagmax*1d-3
  804.               IF (LIGN.IMMM(KHG).EQ.0) NENS=NENS+1
  805.               LIGN.IMMM(KHG)=NENS
  806.             ELSEIF (LIGN.VAL(NN).LE.DIAGCMP) THEN
  807.               IF (ISR.EQ.0.OR.IIMPI.GT.0)
  808.      &        write (ioimp,*) 'stabilisation RESO',ii,val(nn),diag(ii)
  809.               isr=isr+1
  810.               LIGN.VAL(NN)=MAX(DIAGCMP,-LIGN.VAL(NN))
  811.               IF (LIGN.IMMM(KHG).EQ.0) NENS=NENS+1
  812.               LIGN.IMMM(KHG)=NENS
  813.             ELSE
  814.               DIAGMIN=MIN(DIAGMIN,ABS(LIGN.VAL(NN)))
  815.             ENDIF
  816.           ELSE IF (ITTR(II).NE.0) THEN
  817.             IF (LIGN.VAL(NN).GE.ABS(DIAG(II))*STMULT) THEN
  818.               IF (ISRL.EQ.0.OR.IIMPI.GT.0)
  819.      &        write (ioimp,*) 'stabilisation RESO lagrange',ii,val(nn)
  820.               isrl=isrl+1
  821.               LIGN.VAL(NN)=-ABS(DIAG(II))*STMULT
  822.               IF (LIGN.IMMM(KHG).EQ.0) THEN
  823.                 NENS=NENS+1
  824.                 NENSLX=NENSLX+1
  825.               ENDIF
  826.               LIGN.IMMM(KHG)=NENS
  827.             ENDIF
  828.           ENDIF
  829.         ENDIF
  830. C
  831.         DIAG(II)=LIGN.VAL(NN)
  832.         IF(ABS(DIAG(II)).LE.XPETIT) THEN
  833.           DIAG(II)=diagmax
  834.           IF(ITTR(II).NE.0) DIAG(II)=-DIAGMAX
  835.           IF (bNONSYM) LIGL.VAL(NN)=DIAG(II)
  836.         ENDIF
  837.         LIGM.VAL(NN)=DIAG(II)
  838.         GOTO 41
  839. C
  840. C  ****  ERREUR MATRICE SINGUIERE
  841. C
  842.         INTERR(1)=I
  843.         CALL ERREUR(49)
  844.         if (ithrd.eq.1) then
  845.           call threadis
  846.          call oooprl(0)
  847.         endif
  848.         call ooomru(0)
  849.         RETURN
  850. C
  851. C  ****  ON COMPTE LE NOMBRE DE TERMES DIAGONAUX NEGATIFS
  852. C        ET LE NOMBRE DE MULTIPLICATEUR DE LAGRANGE
  853. C
  854.    41   CONTINUE
  855.         IF(DIAG(II).LT.0.D0) INEG=INEG+1
  856.         IF(ITTR(II).NE.0)   NBLAG=NBLAG+1
  857. C
  858.         CONDMAX=MAX(CONDMAX,ABS(DIAG(II)))
  859.         IF (II.LE.NBNNMC) THEN
  860.           CONDMIN=MIN(CONDMIN,ABS(DIAG(II)))
  861.           DIAG(II)=1.D0/DIAG(II)
  862.         ENDIF
  863. C
  864.   156 CONTINUE
  865. C
  866. C     Suppression du masque
  867.       LMASQ=0
  868. C
  869.       IF (bNONSYM) THEN
  870.         LIGN =LIGL
  871.         NVALL=LIGN.VAL(/1)
  872.         NBPAR=LIGN.IVPO(/1)/2
  873.         NA   =LIGN.IMMM(/1)
  874.         SEGADJ,LIGN
  875.       ENDIF
  876. C
  877.       LIGN =LIGM
  878.       NVALL=LIGN.VAL(/1)
  879.       NBPAR=LIGN.IVPO(/1)/2
  880.       NA   =LIGN.IMMM(/1)
  881.       SEGADJ,LIGN
  882. C
  883.       NVSTOR=NVSTOR+NVALL
  884.       NVSTRM=MAX(NVSTRM,NVALL*2*ICOE)
  885. C
  886.       LMASQ=0
  887.       NVALL=0
  888.       SEGINI,LIG3
  889.       lig3.iml=iml
  890.       lig3.imm=imm
  891.       lig3.iprel=iprel
  892.       lig3.iderl=iderl
  893.       do ipv=1,immm(/1)
  894.        lig3.immm(ipv)=immm(ipv)
  895.       enddo
  896.       do ipv=1,ippvv(/1)
  897.        lig3.ippvv(ipv)=ippvv(ipv)
  898.       enddo
  899.       do ipv=1,ivpo(/1)
  900.        lig3.ivpo(ipv)=ivpo(ipv)
  901.       enddo
  902.       ILIGNS.ILIGR(I)=LIG3
  903.       IF (lsgdes) SEGDES,LIG3
  904. C
  905. C      IF (I.EQ.IDBGL) THEN
  906. C        IF (bNONSYM) THEN
  907. C          LIG1=LILIGN.ILIGN(I)
  908. C          WRITE(*,*) 'LIGNE FINALE SUP',I,LIG1
  909. C          segprt,lig1
  910. C        ENDIF
  911. C        LIG1=MILIGN.ILIGN(I)
  912. C        WRITE(*,*) 'LIGNE FINALE INF',I,LIG1
  913. C        segprt,lig1
  914. C      ENDIF
  915. C
  916. C  ****  ON TRIANGULARISE LES AUTRES LIGNES
  917. C
  918.       IL1=IL1+1
  919.       IF (IL1.GT.IL2) GOTO 5
  920.       IF (bNONSYM) THEN
  921.         LIGM=LILIGN.ILIGN(I)
  922.         LIGL=MILIGN.ILIGN(I)
  923.       ELSE
  924.         LIGM=MILIGN.ILIGN(I)
  925.       ENDIF
  926.       lign=MILIGN.ilign(il1)
  927.       GOTO 7
  928. C
  929.   71  CONTINUE
  930. C
  931.       IF (IPER.GT.IDER) THEN
  932.         call erreur(48)
  933.         write(6,*) ' 1 shole iper ider i il1 il2 ',
  934.      >         iper,ider,i,il1,il2
  935.         do ipv=1,ino
  936.           lig1=MILIGN.ilign(ipv)
  937.           call oooeta(lig1,ieta,imod)
  938.           if (ipv.lt.il1.or.ipv.gt.il2) then
  939. **         if (ieta.eq.1) write(6,*) 'ligne active ',ipv
  940.           endif
  941.         enddo
  942. **      call ooodmp(0)
  943.         if (ithrd.eq.1) then
  944.           call threadis
  945.           call oooprl(0)
  946.         endif
  947.         call ooomru(0)
  948.         RETURN
  949.       ENDIF
  950. C
  951. C     Passage en superlent
  952.       if (ider.lt.il1-1.and..not.ngmpet) then
  953. **      write(6,*) 'passage en superlent',ider,i,il1-1
  954.         ngmpet=.true.
  955.       endif
  956. C
  957. C     soit parce qu'on a fini, soit parce qu'on manque de memoire
  958. C     il faut executer les lignes activees puis les desactiver
  959. C     lancer les chole4 et attendre qu'ils soient finis
  960.       if (xreser.ne.0) then
  961. CC      write(6,*)'segsup xreser 2'
  962.         segsup xreser
  963.         xreser=0
  964.       endif
  965.  
  966.       if (ipos.ne.0) then
  967. **      write (6,*) ' lancement thread ',iper,ider,il1,il2
  968.         nbthr=min(nbthr,il2-il1+1)
  969.         ipers=iper
  970.         iders=ider
  971.         ipert=iper
  972.         ifois=1
  973. *       write(6,*) 'il2 kidepb ider',lcara(1,il2),kidepb,ider
  974. **      write(6,*) 'i il1 il2',i,il1,il2
  975.  401    continue
  976.         ipas=max(1200/ifois,80)
  977.         if (ifois.ge.6 ) ipas= 80
  978.         if (nbthr.eq.1) ipas=igrand
  979. *402    continue
  980.         liper=lcara(2,iper)
  981.         iper2=il1-1
  982. **      call ooosur(MILIGN.ilign(il2))
  983.         do il=il1,il2
  984.           lign=MILIGN.ilign(il)
  985.           kidepb=lcara(1,il)-1
  986.           iperC=liper-kidepb
  987.           iperC=max(1,iperC)
  988.           imsq=LIGN.imasq(masqa(iperC))
  989.           if (imsq.lt.0) then
  990. CC          iperC=max(LIGN.ivpo(2*(-imsq)-1),iperC+1)
  991.             iperC=LIGN.ivpo(2*(-imsq)-1)
  992.           endif
  993.           iper1=ipno(iperC+kidepb)
  994.           iper2=min(iper1,iper2)
  995.         enddo
  996.         iper=iper2
  997.         ipert=iper
  998.         ider=min(iders,iper+ipas-1)
  999.         lider=lcara(3,ider)
  1000.         ider2=il1-1
  1001.         isaug=igrand
  1002.         if (il2.lt.il1) then
  1003.           write(6,*) 'il1 > il2',il1,il2
  1004.           call erreur(48)
  1005.         endif
  1006.         do il=il1,il2
  1007.           lign=MILIGN.ilign(il)
  1008.           kidepb=lcara(1,il)-1
  1009.           iderC=lider-kidepb
  1010.           iderC=max(1,iderC)
  1011.           imsq=LIGN.imasq(masqa(iderC))
  1012.           isaut=0
  1013.           if (imsq.lt.0) then
  1014.             iderC=LIGN.ivpo(2*(-imsq)-1)-1
  1015. **          isaut=0
  1016. **          do mpv=masqa(iderC),masqa(iper-kidepb),-1
  1017. **           if (LIGN.imasq(mpv).lt.0) isaut=isaut+masdim
  1018. **          enddo
  1019.             isaut=ipas/2
  1020. **          isaut=-1
  1021.           endif
  1022.           ider1=ipno(iderC+kidepb)
  1023.           ider2=min(ider1,ider2)
  1024.           isaug=min(isaug,isaut)
  1025.         enddo
  1026.         ider=min(ider2+isaug,iders)
  1027.         ifois=ifois+1
  1028. C
  1029. C       Travail sur la partie superieure
  1030.         iths=nbthr
  1031.         IF (bNONSYM) THEN
  1032.           MILIGN=IILIGS
  1033.           LILIGN=IILIGN
  1034.           do ith=1,nbthr
  1035.             if (ith.ne.iths) call threadid(ith,chole4i)
  1036.           enddo
  1037.           call chole4i(iths)
  1038.           do ith=nbthr,1,-1
  1039.             if (ith.ne.iths) call threadif(ith)
  1040.           enddo
  1041. C
  1042. C         Travail sur la partie inferieure
  1043.           MILIGN=IILIGN
  1044.           LILIGN=IILIGS
  1045.         ENDIF
  1046. C
  1047.         do ith=1,nbthr
  1048.           if (ith.ne.iths) call threadid(ith,chole4i)
  1049.         enddo
  1050.         call chole4i(iths)
  1051.         do ith=nbthr,1,-1
  1052.           if (ith.ne.iths) call threadif(ith)
  1053.         enddo
  1054. C
  1055.         iper=ider+1
  1056.         if (iper.le.iders) goto 401
  1057.         iper=ipers
  1058.         ider=iders
  1059.       ENDIF
  1060.  
  1061. C  test ctrlC
  1062.       if (ierr.ne.0) goto 9999
  1063.       ipos=0
  1064.       IF (LSGDES) THEN
  1065. C       write(6,*) 'desactivation 5 iper ider',iper,ider
  1066.         do ipv=ider,iper,-1
  1067.           lig1=MILIGN.ilign(ipv)
  1068.           segdes lig1
  1069.           IF (bNONSYM) THEN
  1070.             lig1=LILIGN.ilign(ipv)
  1071.             segdes lig1
  1072.           ENDIF
  1073.         enddo
  1074.         IF (I.NE.IL1-1) THEN
  1075.           LIG1=MILIGN.ILIGN(I)
  1076.           SEGACT,LIG1*MOD
  1077.           IF (bNONSYM) THEN
  1078.             LIG1=LILIGN.ILIGN(I)
  1079.             SEGACT,LIG1*MOD
  1080.           ENDIF
  1081.         ENDIF
  1082.       ENDIF
  1083.       iper=ider+1
  1084.       GOTO 5
  1085. C
  1086.     7 CONTINUE
  1087.       IF (LSGDES.AND.(I.LT.IL1)) THEN
  1088.         IF (.not.ngmpet) THEN
  1089.           iperI=lcara(2,i)
  1090.           do il=il1,il2
  1091.             lign=MILIGN.ilign(il)
  1092.             kidepb=lcara(1,il)-1
  1093.             iperC=iperI-kidepb
  1094.             iperC=max(1,iperC)
  1095.             if (LIGN.imasq(masqa(iperC)).gt.0) goto 432
  1096.           enddo
  1097.           GOTO 5
  1098.         ENDIF
  1099.  432    CONTINUE
  1100.         SEGACT/ERR=71/LIGM
  1101.         IF (bNONSYM) SEGACT/ERR=71/LIGL
  1102.       ENDIF
  1103.       ipos=ipos+1
  1104.       ider=i
  1105.       IF (I.EQ.IL1-1) GOTO 71
  1106. C
  1107.     5 CONTINUE
  1108. C
  1109. **    write (6,*) ' il1 il2 apres 5 ',il1,il2
  1110.       if (lsgdes) then
  1111. C       write(6,*) 'desactivation 8 il1 il2',il1,il1p,il2
  1112.         DO I=IL2,IL1P,-1
  1113.           LIGN=MILIGN.ILIGN(I)
  1114.           SEGDES,LIGN
  1115.           IF (bNONSYM) THEN
  1116.             LIGN=LILIGN.ILIGN(I)
  1117.             SEGDES,LIGN
  1118.           ENDIF
  1119.         ENDDO
  1120.       ENDIF
  1121.       nbopt=0
  1122.       do ith=1,nbthro
  1123.        nbopt=nbopt+nbop(ith)
  1124.        nbop(ith)=0
  1125.       enddo
  1126.       nbopin=nbopt
  1127.       nbopit=nbopit+nbopin
  1128.       call timespv(ittime,oothrd)
  1129.       kcour=(ittime(1)+ittime(2))/10
  1130.       if (xreser.ne.0) then
  1131. CC      write(6,*)'segsup xreser 3'
  1132.         segsup xreser
  1133.         xreser=0
  1134.       endif
  1135.       IF(IL2.LT.INO) GOTO 1
  1136. C  ON MET A JOUR LE NOMBRE DE TERMES DIAGONAUX NEGATIF
  1137. C   ON ENLEVE LE NOMBRE DE MULTIPLICATEUR DE LAGRANGE
  1138. C       INEG=INEG-NBLAG
  1139. C     on ne compte pas 2 fois les multiplicateurs qui vont etre
  1140. C     elimines lors de la resolution car mode d'ensemble
  1141.       INEG=INEG-(NBLAG-NENSLX)
  1142.       if (iimpi.ne.0.and.NENSLX.gt.0) WRITE(IOIMP,4820) NENSLX
  1143.  4820 FORMAT(I12,' MODES D ENSEMBLE PORTANT SUR DES MULTIPLICATEURS',
  1144.      1' DE LAGRANGE DETECTES')
  1145.  
  1146.       IF (IIMPI.EQ.1) WRITE(IOIMP,4821) NVSTOC
  1147.  4821 FORMAT( ' NOMBRE DE VALEURS  DANS LE PROFIL',I12)
  1148.       IF (IIMPI.EQ.1) WRITE(IOIMP,4822) NVSTOR*ICOE
  1149.  4822 FORMAT( ' NOMBRE DE VALEURS STOCKEES DANS LE PROFIL',I12)
  1150.       IF (IIMPI.EQ.1) WRITE(IOIMP,4825) Nbopit/1000000
  1151.  4825 FORMAT( ' NOMBRE DE GIGA OPERATIONS FMA',I40)
  1152.       IF (IIMPI.EQ.1) WRITE(IOIMP,4823) NVaor
  1153.  4823 FORMAT( ' NOMBRE DE VALEURS initiales',I9)
  1154. C     IF (IIMPI.EQ.1) WRITE(IOIMP,4824) nbopit/1d6/(kcour-kcouri)
  1155. C 4824 FORMAT( ' Performance en Gigaflops ',F8.1)
  1156.       INTERR(1)=NVSTOR*ICOE
  1157.       reaerr(1)=nvstor/inc**(4.D0/3.D0)
  1158.       reaerr(2)=2.D0*nbopit/1.D6/max(1,(kcour-kcouri))
  1159.       reaerr(3)=condmax/condmin
  1160.       IF (IPASV.EQ.0.or.reaerr(3).gt.1.D30) CALL ERREUR(-278)
  1161.       IPASV=1
  1162.       call ooomru(0)
  1163.       if(lsgdes) then
  1164.         do ipv=1,ino
  1165.           lign=MILIGN.ilign(ipv)
  1166.           segdes lign
  1167.         enddo
  1168.       endif
  1169.       SEGDES,MINCPO
  1170.       SEGDES,MIMIK
  1171.       SEGDES,MMATRI
  1172.       SEGDES,MILIGN
  1173.       IF (bNONSYM) THEN
  1174.         do ipv=1,ino
  1175.           lign=LILIGN.ilign(ipv)
  1176.           segdes lign
  1177.         enddo
  1178.         SEGDES,LILIGN
  1179.       ENDIF
  1180.       MMATRX=MMATRI
  1181.       SEGSUP KIVPO,KIVLO
  1182.       do ipv=1,nnoe
  1183.         lig3=ILIGNS.ILIGR(ipv)
  1184.         segsup lig3
  1185.       enddo
  1186.       SEGSUP,ILIGNS
  1187.       segsup immt
  1188. C     write (6,*) ' shole ipos max ',iposm
  1189.  9999 continue
  1190.       if (ithrd.eq.1) then
  1191.         call threadis
  1192.        call oooprl(0)
  1193.       endif
  1194.       if(iimpi.ne.0)  write (6,*)
  1195.      >      ' shole condmin condmax ',condmin,condmax,diag(/1)
  1196.       SEGDES,MDIAG
  1197.       RETURN
  1198.       END
  1199.  
  1200.  
  1201.  
  1202.  
  1203.  
  1204.  

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