Sources Esope | Cast3M

depen3
C DEPEN3    SOURCE    PV090527  26/04/30    21:15:27     12529          
 
      SUBROUTINE depen3 (iri2,iri1)
c====================================================================
c   transformation d une matrice de relations en matrice de dependance
C
c     entrees:
c           mrigid  rigidité   [C]  de dependance  cree par  rela
c     sorties:
C           ri1   matrice de dependence
C
C      on conserve dans irigel(8,irig) le pointeur sur la matrice accro
C    d origine
C
c====================================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC SMRIGID
-INC SMELEME
-INC SMCOORD
 
-INC PPARAM
-INC CCOPTIO
-INC CCGEOME
-INC CCHAMP
-INC SMLMOTS
C
      mrigid=iri2
*      write(6,*) ' entree dans depen3'
*      call prrigi(mrigid)
      SEGACT MRIGID
C
       segini , ri1=mrigid
       iri1= ri1
       ri1.imgeo1=0
       ri1.imgeo2=0
       nrige = 8
       nrigel=irigel(/2)
       if( nrige.ne.ri1.irigel(/1)) segadj ri1
       idec=1
       irigg=0
       do 100 irig = 1,irigel(/2)
C   rectification des supports geometriques et matrices
       meleme = irigel(1,irig)
**     write(6,*) ' depen3 meleme itypel ',meleme,itypel
       xmatri = irigel(4,irig)
       segact ,meleme ,xmatri
       nbnn = num(/1)-idec
       if (nbnn.eq.0) then
          segdes meleme,xmatri
          goto 100
       endif
       irigg=irigg+1
       nbelem=num(/2)
       nelrig = nbelem
       nbsous=0
       nbref=0
       segini ,ipt1
       rigrel=0
       segini,xmatr1=xmatri
*      write(6,*) 'depen3 xmatri xmatr1',xmatri,xmatr1
       ri1.irigel(1,irigg)=ipt1
       ri1.irigel(4,irigg)=xmatr1
       ri1.irigel(7,irigg)=2
       ri1.coerig(irigg)=1.d0
C   on stocke ds irigel de 8 le meleme avec supports de LX
       ri1.irigel(8,irigg)=meleme
* superelement
       ipt1.itypel=28
       descr = irigel(3,irig)
       segact descr
       nligrp=lisinc(/2)-idec-1
       nligrd=2-idec
       segini des1
           nelrig=nbelem
           rigrel=0
*          write(6,*) 'nligrp nligrd nelrig rigrel',
*    >                 nligrp,nligrd,nelrig,rigrel   
*      write(6,*) 'xmatr1.re',xmatr1.re(/1),xmatr1.re(/2),xmatr1.re(/3)
           segadj xmatr1
       ri1.irigel(3,irigg) = des1
       do 110  iel=1,nbelem
*       xmatri=imattt(iel)
*       segact xmatri
       do 111  ip=1,nbnn
       ipt1.num(ip,iel)=num(ip+idec,iel)
111    continue
*       segini xmatr1
*       imatr1.imattt(iel) = xmatr1
       aa= re(1,2,iel)
       do 121 ic = 1,nligrp
       xmatr1.re(1,ic,iel)=(-re(1,ic+idec+1,iel)/aa)
121    continue
120    continue
*       segdes xmatri,xmatr1
110    continue
       do 130 il=1,nligrp
       des1.lisinc(il)= lisinc(il+idec+1)
       des1.noelep(il)= noelep(il+idec+1)-1
130    continue
       des1.lisdua(1)= lisinc(2)
       des1.noeled(1)= noelep(2)-1
C      write(6,*) ' depen3 irigel(8,irig) ' ,ri1.irigel(8,irig)
       segdes ipt1,meleme,xmatr1,descr,des1,xmatri
100    continue
       nrigel=irigg
       nrige=ri1.irigel(/1)
       segadj ri1
      segdes ri1,mrigid
*      call prrigi(ri1,1)
      RETURN
      END