Sources Esope | Cast3M

dbbcf
C DBBCF     SOURCE    CB215821  20/11/25    13:24:02     10792          
*  dedualise les valeurs d'un champ en fonction d'un meleme de dedoublement de noeuds
*
      subroutine dbbcf(mchpoi,ipt8)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC SMELEME
-INC SMCHPOI
-INC SMCOORD
      segment valc(ipt8.num(/2))
      segment ivalc(ipt8.num(/2))
      segment trav
      integer lag1(nbpts)
      endsegment
*  ne fonctionne que pour des LX, on suppose qu'il n'y a qu'une inconnue
*  par noeud dédoublé
      if (ipt8.eq.0) return
      segact mchpoi,ipt8
      segini valc,ivalc
      segini trav
      do 300 i=1,ipt8.num(/2)
      lag1(ipt8.num(1,i))=i
      lag1(ipt8.num(2,i))=i
 300  continue
      do 10 isoupo=1,ipchp(/1)
       msoupo=ipchp(isoupo)
       segact msoupo*mod
       if (nocomp(/2).ne.1) goto 11
       if (nocomp(1).ne.'LX') goto 11
       meleme=igeoc
       mpoval=ipoval
       segini,ipt1=meleme,mpova1=mpoval
       nbnn=ipt1.num(/1)
       nbelem=ipt1.num(/2)
       nbele=nbelem
       nbsous=0
       nbref=0
       ic=0
       do 100 j=1,nbele
       val=mpova1.vpocha(j,1)
       if (lag1(ipt1.num(1,j)).ne.0) then
       jj=lag1(ipt1.num(1,j))
         valc(jj)=valc(jj)+val
         if (ivalc(jj).ne.0) then
           ipt1.num(1,ivalc(jj))=ipt8.num(1,jj)
           mpova1.vpocha(ivalc(jj),1)=valc(jj)
           goto 100
         endif
         ivalc(jj)=ic+1
        endif
 110   continue
        ic=ic+1
        ipt1.num(1,ic)=ipt1.num(1,j)
        mpova1.vpocha(ic,1)=val
 100   continue
       nbelem=ic
       segadj ipt1
       n=ic
       nc=1
       segadj mpova1
       igeoc=ipt1
       ipoval=mpova1
       segsup mpoval
  11   continue
  10   continue
       segsup valc,ivalc,trav
       end