Esope source files

   1 : C DBBCF     SOURCE    PV        06/03/14    21:15:01     5334           
   2 : *  dedualise les valeurs d'un champ en fonction d'un meleme de dedoublement de noeuds
   3 : *
   4 :       subroutine dbbcf(mchpoi,ipt8)
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 : -INC CCOPTIO
   8 : -INC SMELEME
   9 : -INC SMCHPOI
  10 : -INC SMCOORD
  11 :       segment valc(ipt8.num(/2))
  12 :       segment ivalc(ipt8.num(/2))
  13 :       segment trav
  14 :       integer lag1(xcoor(/1)/(idim+1))
  15 :       endsegment
  16 : *  ne fonctionne que pour des LX, on suppose qu'il n'y a qu'une inconnue
  17 : *  par noeud dédoublé
  18 :       if (ipt8.eq.0) return
  19 :       segact mchpoi,ipt8
  20 :       segini valc,ivalc
  21 :       segini trav
  22 :       do 300 i=1,ipt8.num(/2)
  23 :       lag1(ipt8.num(1,i))=i
  24 :       lag1(ipt8.num(2,i))=i
  25 :  300  continue
  26 :       do 10 isoupo=1,ipchp(/1)
  27 :        msoupo=ipchp(isoupo)
  28 :        segact msoupo*mod
  29 :        if (nocomp(/2).ne.1) goto 11
  30 :        if (nocomp(1).ne.'LX') goto 11
  31 :        meleme=igeoc
  32 :        mpoval=ipoval
  33 :        segini,ipt1=meleme,mpova1=mpoval
  34 :        nbnn=ipt1.num(/1)
  35 :        nbelem=ipt1.num(/2)
  36 :        nbele=nbelem
  37 :        nbsous=0
  38 :        nbref=0
  39 :        ic=0
  40 :        do 100 j=1,nbele
  41 :        val=mpova1.vpocha(j,1)
  42 :        if (lag1(ipt1.num(1,j)).ne.0) then
  43 :        jj=lag1(ipt1.num(1,j))
  44 :          valc(jj)=valc(jj)+val
  45 :          if (ivalc(jj).ne.0) then
  46 :            ipt1.num(1,ivalc(jj))=ipt8.num(1,jj)
  47 :            mpova1.vpocha(ivalc(jj),1)=valc(jj)
  48 :            goto 100
  49 :          endif
  50 :          ivalc(jj)=ic+1
  51 :         endif
  52 :  110   continue
  53 :         ic=ic+1
  54 :         ipt1.num(1,ic)=ipt1.num(1,j)
  55 :         mpova1.vpocha(ic,1)=val
  56 :  100   continue
  57 :        nbelem=ic
  58 :        segadj ipt1
  59 :        segdes ipt1
  60 :        n=ic
  61 :        nc=1
  62 :        segadj mpova1
  63 :        segdes mpova1
  64 :        igeoc=ipt1
  65 :        ipoval=mpova1
  66 :        segsup mpoval
  67 :        segdes meleme
  68 :   11   continue
  69 :        segdes msoupo
  70 :   10   continue 
  71 :        segsup valc,ivalc,trav
  72 :        return
  73 :        end
  74 : 
  75 :  
  76 :  
  77 :  
  78 :