Télécharger la plaquette Cast3M


fr en

Télécharger separm.eso

Retour à la liste

Numérotation des lignes : 

separm

  1. C SEPARM    SOURCE    MB234859  26/07/06    21:15:13     12591          
  2.       SUBROUTINE SEPARM(MRIGID,RI1,RI2,NOUNIL,BDBLX,NELIM,IPE)
  3. C----------------------------------------------------------------------
  4. C  Distinguer dans le MRIGID les rigidites elementaires pouvant etre 
  5. C  eliminees et celles devant etre conservees.
  6. C
  7. C Entrees :
  8. C ---------
  9. C  mrigid : pointeur sur la rigidite totale
  10. C  nelim  : ne rien eliminer lorsque vaut 0
  11. C  bdblx  : est vrai si les mult de Lagrange doivent etre dedoubles
  12. C  ipe    : numero de la passe d'elimination si elimination recursive
  13. C
  14. C Sorties :
  15. C ---------
  16. C     ri1 : pointeur sur les rigidites elementaires a eliminer, i.e. 
  17. C           pouvant etre traitee comme des dependances
  18. C     ri2 : pointeur sur les rigidites elementaires a conserver
  19. C
  20. C  juillet 2003 passage aux simples multiplicateurs de Lagrange, mais
  21. C  separm dualise ceux qu'il garde
  22. C----------------------------------------------------------------------
  23.       IMPLICIT INTEGER(I-N)
  24.       IMPLICIT REAL*8 (A-H,O-Z)
  25. C
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. -INC CCREEL
  29. *-INC CCHAMP
  30. -INC SMRIGID
  31. -INC SMCOORD
  32. -INC SMELEME
  33. C
  34.       INTEGER OOOVAL
  35.       LOGICAL bdblx
  36. C
  37.       segment trav1
  38.        character*(lochpo) compp(lcomp1)
  39.       endsegment
  40.       segment trav2
  41.        integer ielim(nbnoc,nbincp),iautr(nbnoc,nbincp)
  42.        integer icomb(nbnoc,nbincp),ideja(nbnoc,nbincp)
  43.       endsegment
  44. C     Remplir posinc pour accelerer les tests sur les composantes
  45.       segment trav3
  46.        integer posinc(nligrp)
  47.       endsegment
  48.       segment trav4
  49.        integer itrv1(nbprl)
  50.        integer itrv2(nbprl)
  51.        real*8 dtrv1(nbprl)
  52.        real*8 dtrv2(nbprl)
  53.       endsegment
  54.       segment trav5
  55.        integer idata(2,nligrp)
  56.       endsegment
  57.       segment icpr(nbpts)
  58.       segment itemp(ntemp)
  59.       character*(lochpo) co1
  60.       character*(8) typmat
  61.       integer ri1p,ri1s,ri1f,ri2f
  62. C
  63. **     write(ioimp,*) ' entree de separm '
  64. **     call ooodmp(0)
  65. **     nbav=oooval(2,1)
  66. *      write (ioimp,*) ' dans separm nouinl ',nounil
  67. CC     write (ioimp,*) ' matrice mrigid'
  68. CC     call prrigi(mrigid,0)
  69. CC     segact,mrigid
  70.       nbdep=0
  71.       nbpiv=0
  73.       nbpvt=0
  74.       typmat='TEMPORAI'
  75. C     -----------------------------------------------------------------
  76. C     Distinguer ce qui peut etre elimine (ri4) et le reste (ri3)
  77. C     -----------------------------------------------------------------
  78.       if (nelim.ne.0) then
  79.         nbno=nbpts
  80.         segini icpr
  81.       endif
  82.       nbnoc=0
  83.       segact mrigid
  84.       nbrig=irigel(/2)
  85.       ntemp=nbrig
  86.       segini,itemp
  87.       nrige3=0
  88.       do 760 irig=1,nbrig
  89.         meleme=irigel(1,irig)
  90.         segact meleme
  91.         if ((itypel.ne.22.and.itypel.ne.28).or.
  92.      &      (irigel(7,irig).ne.0).or.(nelim.eq.0)) then
  93.           itemp(irig)=1
  94.           nrige3=nrige3+1
  95.         endif
  96. C
  97.         if (nelim.eq.0) goto 760
  98. C
  99. **      write(ioimp,*) '1 itypel dans separm',itypel
  100.         do il=1,num(/2)
  101.           do ip=1,num(/1)
  102.             ipt=num(ip,il)
  103.             if (icpr(ipt).eq.0) then
  104.               nbnoc=nbnoc+1
  105.               icpr(ipt)=nbnoc
  106.             endif
  107.           enddo
  108.         enddo
  109.  760  continue
  110. C
  111.       nrigel=nrige3
  112.       segini,ri3
  113.       ri3.iforig=iforig
  114.       ri3.mtymat=mtymat
  115.       nrige4=nbrig-nrige3
  116.       nrigel=nrige4
  117.       segini,ri4
  118.       ri4.iforig=iforig
  119.       ri4.mtymat=typmat
  120.       i3=0
  121.       i4=0
  122.       do 555 jj=1,nbrig
  123.         if (itemp(jj).eq.1) then
  124.           i3=i3+1
  125.           ii=i3
  126.           ri5=ri3
  127.         else
  128.           i4=i4+1
  129.           ii=i4
  130.           ri5=ri4
  131.         endif
  132.         ri5.coerig(ii)=coerig(jj)
  133.         do kk=1,8
  134.           ri5.irigel(kk,ii)=irigel(kk,jj)
  135.         enddo
  136.  555  continue
  137.       segsup,itemp
  138.       if (nelim.eq.0) then
  139.         ri1=ri4
  140.         ri2=ri3
  141.         GOTO 2002
  142.       endif
  143. C     -----------------------------------------------------------------
  144. C     Recuperer les noms de composantes (segment trav1)
  145. C     -----------------------------------------------------------------
  146.       lcomp1 = 50
  147.       segini trav1
  148.       nbincp=0
  149.       do 10 irig=1,nrige4
  150.         descr=ri4.irigel(3,irig)
  151.         segact descr
  152.         do 40 nligrp=2,lisinc(/2)
  153. C         print *,'lisinc(',nligrp,'/',lisinc(/2),')=',lisinc(nligrp)
  154.           do 50 inc=1,nbincp
  155.             if (compp(inc).eq.lisinc(nligrp)) goto 40
  156.   50      continue
  157.           nbincp=nbincp+1
  158.           if (nbincp.GT.lcomp1) then
  159.             lcomp1 = lcomp1 + 50
  160.             segadj trav1
  161.           endif
  162.           compp(nbincp)=lisinc(nligrp)
  163.   40    continue
  164.   10  continue
  165. C     -----------------------------------------------------------------
  166. C     Quelles inconnues peuvent etre eliminees?
  167. C     -----------------------------------------------------------------
  168. C     Interdit d'eliminer les inconnues apparaissant dans des conditions 
  169. C     unilaterales lorsque nounil = 0.
  170.       segini,trav2
  171.       do 60 irig=1,nrige4
  172.         MELEME=RI4.IRIGEL(1,IRIG)
  173. C
  174.         IF (ITYPEL.NE.28) THEN
  175.           IF (ITYPEL.NE.22) GOTO 60
  176.           IF (RI4.IRIGEL(6,IRIG).EQ.0 .OR. NOUNIL.EQ.1) GOTO 60
  177.           nld=2
  178.         ELSE
  179. C         Super-elements : si trop gros ce n'est pas avantageux d'eliminer
  180. C         -> identifier ses noeuds et ddls pour ne pas les eliminer.
  181.           IF (NUM(/1).LT.255) GOTO 60
  182.           IF (IPE.LT.3)       GOTO 60
  183.           nld=1
  184.         ENDIF
  185. C
  186.         descr=ri4.irigel(3,irig)
  187.         do 70 nligrp=nld,lisinc(/2)
  188.           do 80 inc=1,nbincp
  189. C            print *,'lisinc(',nligrp,'/',lisinc(/2),')=',lisinc(nligrp)
  190. C     &             ,'  compp(',inc,')=',compp(inc)
  191.             if (compp(inc).eq.lisinc(nligrp)) goto 90
  192.   80      continue
  193. ***       write(ioimp,*) '- ',lisinc(nligrp),' non trouve dans trav1'
  194.           goto 70
  195.   90      continue
  196. C
  197. C         La composante lisinc(nligrp) ne doit pas etre eliminee pour
  198. C         les noeuds num(ip,j)
  199.           ip=noelep(nligrp)
  200.           do 100 j=1,num(/2)
  201. C            IF(num(ip,j).GT.ielim(/1).OR.inc.GT.ielim(/2).OR.
  202. C     *         num(ip,j).GT.iautr(/1).OR.inc.GT.iautr(/2))THEN
  203. C               print *,'BUG DANS SEPARM : ',
  204. C     &                 num(ip,j),'>',ielim(/1),iautr(/1),
  205. C     &                 inc,'>',ielim(/2),iautr(/2)
  206. C            ENDIF
  207.             ielim(icpr(num(ip,j)),inc)=1
  208.             iautr(icpr(num(ip,j)),inc)=1
  209.  100      continue
  210.   70    continue
  211.   60  continue
  212. C     -----------------------------------------------------------------
  213. C     Nombre de conditions associees a chaque ddl de chaque noeud
  214. C     -----------------------------------------------------------------
  215.       do 700 irig=1,nrige4
  216.         if (ri4.irigel(6,irig).ne.0.and.nounil.eq.0) goto 700
  217.         meleme=ri4.irigel(1,irig)
  218.         if (itypel.ne.22) goto 700
  219.         descr=ri4.irigel(3,irig)
  220. C
  221.         nligrp=lisinc(/2)
  222.         segini trav3
  223.         do 730 inc=2,nligrp
  224.           do 720 incp=1,nbincp
  225.             if (lisinc(inc).eq.compp(incp)) then
  226.               posinc(inc)=incp
  227.               goto 730
  228.             endif
  229.   720     continue
  230.           call erreur(5)
  231.   730   continue
  232. C
  233.         do 750 ince=2,lisinc(/2)
  234.           incp=posinc(ince)
  235.           do 740 j=1,num(/2)
  236.             ip=num(noelep(ince),j)
  237.             icomb(icpr(ip),incp)=icomb(icpr(ip),incp)+1
  238.   740     continue
  239.   750   continue
  240.         segsup trav3
  241.   700 continue
  242.       ipass=1
  243. C
  244. C     -----------------------------------------------------------------
  245.  2000 CONTINUE
  246.       nrigel=0
  247.       segini,ri1
  248.       ri1.iforig=iforig
  249.       ri1.mtymat=typmat
  250.       segini,ri2=ri4
  251.       ri2.mtymat=mtymat
  252. C
  253. C     Trier pour attaquer en premier les relations portant sur le moins
  254. C     d'inconnues
  255.       nbprl=ri4.irigel(/2)
  256.       segini trav4
  257.       do 765 irig=1,nbprl        
  258.         descr=ri4.irigel(3,irig)
  259.         dtrv1(irig)= lisinc(/2)+(irig/(nbprl+1.))
  260.         if(ri4.irigel(6,irig).ne.0) dtrv1(irig)=dtrv1(irig)+1000000
  261.         if(ri4.irigel(6,irig).eq.2) dtrv1(irig)=dtrv1(irig)+1000000
  262. **      if(ri4.irigel(6,irig).eq.0) dtrv1(irig)=dtrv1(irig)+1000000
  263. **      itrv1(irig)=nbprl-irig+1
  264.         itrv1(irig)=      irig   
  265. 765   continue
  266.       call triflo(dtrv1,dtrv2,itrv1,itrv2,nbprl)
  267. C
  268.       do 200 iri=1,nbprl
  269.         irig=itrv1(iri) 
  270. **      irig=iri   
  271. **      if (ipass.eq.1) irig=itrv1(iri)
  272.         if (ri4.irigel(6,irig).ne.0.and.nounil.eq.0) goto 190
  273.         meleme=ri4.irigel(1,irig)
  274.         if (itypel.ne.22) goto 190
  275.         Xmatri=ri4.irigel(4,irig)
  276.         segact Xmatri
  277.         if (abs(re(1,1,1)).gt.1d-30) goto 190
  278.         descr=ri4.irigel(3,irig)
  279. C
  280.         nligrp=lisinc(/2)
  281.         segini,trav3,trav5
  282.         do 230 inc=2,nligrp
  283.          do 220 incp=1,nbincp
  284.            if (lisinc(inc).eq.compp(incp)) then
  285.              posinc(inc)=incp
  286.              goto 230
  287.            endif
  288.  220     continue
  289.         call erreur(5)
  290.  230    continue
  291. C
  292.         segini,ipt8=meleme
  293.         nbdepe=0
  294.         do 210 j=1,num(/2)
  295. C
  296. C         Cette matrice elementaire contient elle des inconnues
  297.           if (noelep(/1).le.1) then
  298.             ipt8.num(1,j)=0
  299.             goto 210
  300.           endif
  301. C
  302. C         La matrice est elle augmentee
  303.           if (abs(re(1,1,j)).gt.1d-5) then
  304.             ipt8.num(1,j)=0
  305.             goto 210
  306.           endif
  307. C
  308. C         Cette matrice elementaire contient-elle une inco. eliminee
  309.           remax=abs(re(1,1,j))
  310.           do 240 inc=2,nligrp
  311.             incpp=posinc(inc)
  312.             ipp=ipt8.num(noelep(inc),j)
  313.             if (ielim(icpr(ipp),incpp).eq.1) then
  314.               ipt8.num(1,j)=0
  316.               goto 210
  317.             endif
  318.             remax=max(remax,abs(re(1,inc,j)))
  319.  240      continue
  320. C
  321. C         Choix du pivot
  322.           incf=0
  323.           remaz=remax*0.9
  324.           do 250 inc=2,nligrp
  325.             incpp=posinc(inc)
  326.             ipp=ipt8.num(noelep(inc),j)
  327.             if (iautr(icpr(ipp),incpp).eq.1) goto 250
  328.             if (abs(re(1,inc,j)).lt.remaz) goto 250
  329. *           if (icomb(icpr(ipp),incpp).eq.1) then
  330.               incf=inc
  331.               goto 260
  332. *           endif
  333.  250      continue
  334.  260      continue
  335.           ince=incf
  336.           if (incf.eq.0) ince=2
  337. C
  338. C         Traitement de l'inconnue incp du noeud ip
  339.           incp=posinc(ince)
  340.           ip=ipt8.num(noelep(ince),j)
  341. C
  342. C         Le pivot est il correct
  343.           remax=remax*1d-2
  344.           if (abs(re(1,ince,j)).le.remax) then
  345.             ipt8.num(1,j)=0
  346.             nbpiv=nbpiv+1
  347.             goto 210
  348.           endif
  349. C
  350. C         Cette inconnue apparait-elle dans d'autres CL
  351.           if (ipass.eq.1.and.icomb(icpr(ip),incp).ne.1) then
  352.             ipt8.num(1,j)=0
  354.             goto 210
  355.           endif
  356. C
  357. C         Cette inconnue apparait-elle dans une dependance
  358.           if (iautr(icpr(ip),incp).eq.1) then
  359.             ipt8.num(1,j)=0
  361.             goto 210
  362.           endif
  363. C
  364. C         Cette inconnue apparait-elle deux fois dans la relation
  365.           ideux=0
  366.           do inc=2,nligrp
  367.          if (ideja(icpr(ipt8.num(noelep(inc),j)),posinc(inc)).eq.1) then
  368.               ideux=inc
  369.             else
  370.               ideja(icpr(ipt8.num(noelep(inc),j)),posinc(inc))=1
  371.             endif
  372.           enddo
  373.           do inc=2,nligrp
  374.             ideja(icpr(ipt8.num(noelep(inc),j)),posinc(inc))=0
  375.           enddo
  376.           if (ideux.ne.0) then
  377.             moterr(1:4)=lisinc(ideux)
  378.             interr(1)=ipt8.num(noelep(ideux),j)
  379.             call erreur(-361)
  380.             ipt8.num(1,j)=0
  381.             goto 210
  382.           endif
  383. C
  384. C         Nouvelle dependance
  385.           nbdepe=nbdepe+1
  386.           nbdep=nbdep+1
  387. C         write (ioimp,*) 'Elimination noeud,inco,posi',ip,lisinc(ince),ince
  388. C         Reperer l'inconnue eliminee et le noeud 
  389.           ipt8.num(1,j)=ince
  390.           idata(1,ince)=idata(1,ince)+1
  391.           ielim(icpr(ip),incp)=1
  392.           do 280 inc=2,nligrp
  393.             iautr(icpr(ipt8.num(noelep(inc),j)),posinc(inc))=1
  394.  280      continue
  395. C
  396.  210    continue
  397.         segsup trav3
  398. C
  399. C       Creation de ri1 et ri2 pour scinder la sous-matrice irig
  400. C       ---------------------------------------------------------------
  401. C       Dimensions communes a RI1 et RI2
  402.         nbnn=num(/1)
  403.         nbsous=0
  404.         nbref=0
  405.         nligrd=re(/1)
  406.         nligrp=re(/2)
  407. C
  408. C       Creation de RI2 : rigidites elementaires a conserver
  409.         nbelem=num(/2)-nbdepe
  410.         if (nbelem.gt.0) then
  411.           segini,ipt2
  412.           ipt2.itypel=itypel
  413.           nelrig=nbelem
  414.           rigrel=0
  415.           segini,xmatr2
  416.           xmatr2.symre=symre
  417.           ri2.irigel(1,irig)=ipt2
  418.           ri2.irigel(3,irig)=descr
  419.           ri2.irigel(4,irig)=xmatr2
  420.           do iii=5,8
  421.             ri2.irigel(iii,irig)=ri4.irigel(iii,irig)
  422.           ENDDO
  423.           ri2.coerig(irig)=ri4.coerig(irig)
  424.         else
  425.           ri2.irigel(1,irig)=0
  426.           xmatr2=0
  427.         endif
  428. C
  429. C       Creation de RI1 : rigidites elementaires a eliminer. 
  430. C       L'inconnue a eliminer doit etre en 2eme position (apres LX)
  431. C       Si l'inconnue a eliminer n'est pas celle apparaissant en   
  432. C       deuxieme position il faut pivoter la rigidite elementaire 
  433. C       et le descripteur associe
  434.         ri1p=ri1
  435.         nrigel=0
  436.         do kkk=1,nligrp
  437.           if (idata(1,kkk).gt.0) nrigel=nrigel+1
  438.         enddo
  439.         nbpvt=nbpvt+nrigel
  440.         segini,ri1
  441.         ri1.iforig=iforig
  442.         ri1.mtymat=typmat
  443.         icpt=0
  444.         do 25 jjj=1,nligrp
  445.           nelrig=idata(1,jjj)
  446. C         Nombre d'elements elimines en choisissant la jjjeme inconnue
  447.           if (nelrig.eq.0) goto 25
  448.           nbelem=nelrig
  449.           segini,ipt1
  450.           ipt1.itypel=itypel
  451.           rigrel=0
  452.           segini,xmatr1
  453.           xmatr1.symre=symre
  454.           des1=descr
  455.           if (jjj.ne.2) then
  456.             segini,des1=descr
  457.             co1=des1.lisinc(2)
  458.             des1.lisinc(2)=des1.lisinc(jjj)
  459.             des1.lisinc(jjj)=co1
  460.             co1=des1.lisdua(2)
  461.             des1.lisdua(2)=des1.lisdua(jjj)
  462.             des1.lisdua(jjj)=co1
  463.             noe=des1.noelep(2)
  464.             des1.noelep(2)=des1.noelep(jjj)
  465.             des1.noelep(jjj)=noe
  466.             noe=des1.noeled(2)
  467.             des1.noeled(2)=des1.noeled(jjj)
  468.             des1.noeled(jjj)=noe
  469.           endif
  470. C
  471.           icpt=icpt+1
  472.           ri1.irigel(1,icpt)=ipt1
  473.           ri1.irigel(3,icpt)=des1
  474.           ri1.irigel(4,icpt)=xmatr1
  475.           do iii=5,7
  476.             ri1.irigel(iii,icpt)=ri4.irigel(iii,irig)
  477.           enddo
  478.           ri1.irigel(8,icpt)=1
  479.           ri1.coerig(icpt)=ri4.coerig(irig)
  480. C
  481. C         Compteur des elements et identifiant de la rigidite elem
  482.           idata(1,jjj)=1
  483.           idata(2,jjj)=icpt
  484.  25     continue
  485. C
  486. C       Remplir ri1 et ri2 en creant les xmatri/descr/maillages
  487. C       ---------------------------------------------------------------
  488.         idec=0
  489.         do 300 j=1,num(/2)
  490.           if (ipt8.num(1,j).eq.0) then
  491.             idec=idec+1
  492.             do 310 i=1,num(/1)
  493.              ipt2.num(i,idec)=num(i,j)
  494.  310        continue
  495.             do io=1,nligrp
  496.               do iu=1,nligrd
  497.                 xmatr2.re(iu,io,idec)=re(iu,io,j)
  498.               enddo
  499.             enddo
  500.           else
  501.             ince=ipt8.num(1,j)
  502.             iriel=idata(2,ince)
  503.             ipt1=ri1.irigel(1,iriel)
  504.             xmatr1=ri1.irigel(4,iriel)
  505.             ielt=idata(1,ince)
  506.             idata(1,ince)=idata(1,ince)+1
  507.             do 320 i=1,num(/1)
  508.               ipt1.num(i,ielt)=num(i,j)
  509.  320        continue
  510.             do io=1,nligrp
  511.               do iu=1,nligrd
  512.                 xmatr1.re(iu,io,ielt)=re(iu,io,j)
  513.               enddo
  514.             enddo
  515. C
  516. C           Pivoter les lignes/colonnes ince et 2
  517.             if (ince.ne.2) then
  518.               do 1130 il=1,nligrd
  519.                 ret=xmatr1.re(il,2,ielt)
  520.                 xmatr1.re(il,2,ielt)=xmatr1.re(il,ince,ielt)
  521.                 xmatr1.re(il,ince,ielt)=ret
  522.  1130         continue
  523.               do 1160 il=1,nligrp
  524.                 ret=xmatr1.re(2,il,ielt)
  525.                 xmatr1.re(2,il,ielt)=xmatr1.re(ince,il,ielt)
  526.                 xmatr1.re(ince,il,ielt)=ret
  527.  1160         continue
  528.             endif
  529. C
  530.           endif
  531.  300    continue
  532. C       ---------------------------------------------------------------
  533. C
  534.         call fusrig(ri1p,ri1,ri1f)
  535.         ri1=ri1f
  536.         if (xmatr2.ne.0) segdes,xmatr2
  537.         segsup,trav5
  538.         goto 200
  539. C
  540.  190    continue
  541. C
  542. C       Sous-matrice irig a conserver integralement
  543.         ri2.irigel(1,irig)=ri4.irigel(1,irig)
  544.         ri2.irigel(3,irig)=ri4.irigel(3,irig)
  545.         ri2.irigel(4,irig)=ri4.irigel(4,irig)
  546.         do iii=5,7
  547.           ri2.irigel(iii,irig)=ri4.irigel(iii,irig)
  548.         enddo
  549.         ri2.irigel(8,irig)=0
  550.         ri2.coerig(irig)=ri4.coerig(irig)
  551. C
  552.  200  continue
  553. C     -----------------------------------------------------------------
  554.       segsup trav4
  555. C
  556. C     Compression de ri2
  557.       idec=0
  558.       do 600 irig=1,nbprl
  559.         meleme=ri2.irigel(1,irig)
  560.         if (meleme.eq.0) then
  561.           idec=idec+1
  562.         else
  563.           do 610 ir=1,8
  564.            ri2.irigel(ir,irig-idec)=ri2.irigel(ir,irig)
  565.  610      continue
  566.           ri2.coerig(irig-idec)=ri2.coerig(irig)
  567.         endif
  568.  600  continue
  569.       nrigel=nbprl-idec
  570. C     write (ioimp,*) ' dimension de ri2 ',nrigel
  571.       segadj,ri2
  572. C
  573. C     On va voir si on ne peut pas faire pivoter ri2
  574.       if (ipass.eq.2) goto 2001
  575.       ri1s=ri1
  576.       ri4=ri2
  577.       nbpiv=0
  579.       ipass=ipass+1
  580.       goto 2000
  581. C
  582.  2001 CONTINUE
  583. C     -----------------------------------------------------------------
  584. C
  585. C     RI1 : rigidites elementaires a eliminer
  586.       call fusrig(ri1s,ri1,ri1f)
  587.       ri1=ri1f
  588. C     RI2 : rigidites elementaires a conserver
  589.       call fusrig(ri3,ri2,ri2f)
  590.       ri2=ri2f
  591. C
  592.       segsup trav1,trav2,icpr
  593. C
  594.       if (iimpi.ne.0) then
  595.       write(ioimp,*)'nombre de relations eliminees',nbdep
  596.       write(ioimp,*)'nombre de relations gardees a cause du pivot',nbpiv
  597.       write(ioimp,*)'nombre de relations gardees car non independantes',
  599.       write(ioimp,*)'nombre de paquets pivotes',nbpvt
  600.       endif
  601. C
  602.  2002 CONTINUE
  603. C     -----------------------------------------------------------------
  604. C     Dualisation des multiplicateurs de Lagrange
  605. C     -----------------------------------------------------------------
  606. C     si on a des conditions unilaterales, on ne dualise pas, ce sera fait
  607. C     dans le resou de unilater
  608.       IF (BDBLX) CALL DBBLX(RI2)
  609. C
  610. CC    write (ioimp,*) ' matrice ri1 '
  611. CC    call prrigi(ri1,0)
  612. CC    write (ioimp,*) ' matrice ri2 '
  613. CC    call prrigi(ri2,0)
  614. CC    segact,ri1,ri2
  615. CC    write(ioimp,*) ' sortie de separm '
  616. **    call ooodmp(0)
  617. **    nbap=oooval(2,1)
  618. **    write(ioimp,*) 'nb segmts dans separm avant apres ',nbav,nbap
  619.       END
  620.  
  621.  

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