Esope source files

   1 : C DBBCD     SOURCE    PV        07/08/03    21:15:03     5835           
   2 : *  dedualise les valeurs d'un champ en fonction d'un meleme de dedoublement de noeuds
   3 : *
   4 :       subroutine dbbcd(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 FLX, 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
  19 : **    call echpo(mchpoi,1)
  19 : **    call ecmail(ipt8,1)
  20 : **    segact mchpoi,ipt8
  21 :       segini valc,ivalc
  22 :       segini trav
  23 :       do 300 i=1,ipt8.num(/2)
  24 :       lag1(ipt8.num(1,i))=i
  25 :       lag1(ipt8.num(2,i))=i
  26 :  300  continue
  27 :       do 10 isoupo=1,ipchp(/1)
  28 :        msoupo=ipchp(isoupo)
  29 :        segact msoupo*mod
  30 :        if (nocomp(/2).ne.1) goto 11
  31 :        if (nocomp(1).ne.'FLX') goto 11
  32 :        meleme=igeoc
  33 :        mpoval=ipoval
  34 :        segini,ipt1=meleme,mpova1=mpoval
  35 :        nbnn=ipt1.num(/1)
  36 :        nbelem=ipt1.num(/2)
  37 :        nbele=nbelem
  38 :        nbsous=0
  39 :        nbref=0
  40 :        ic=0
  41 :        do 100 j=1,nbele
  42 :        val=mpova1.vpocha(j,1)
  43 :        if (lag1(ipt1.num(1,j)).ne.0) then
  44 :        jj=lag1(ipt1.num(1,j))
  45 :          valc(jj)=  +val
  46 :          if (ivalc(jj).ne.0) then
  47 :            ipt1.num(1,ivalc(jj))=ipt8.num(1,jj)
  48 :            mpova1.vpocha(ivalc(jj),1)=valc(jj)
  49 :            goto 100
  50 :          endif
  51 :          ivalc(jj)=ic+1
  52 :         endif
  53 :  110   continue
  54 :         ic=ic+1
  55 :         ipt1.num(1,ic)=ipt1.num(1,j)
  56 :         mpova1.vpocha(ic,1)=val
  57 :  100   continue
  58 :        nbelem=ic
  59 :        segadj ipt1
  60 :        segdes ipt1
  61 :        n=ic
  62 :        nc=1
  63 :        segadj mpova1
  64 :        segdes mpova1
  65 :        igeoc=ipt1
  66 :        ipoval=mpova1
  67 :        segsup mpoval
  68 :        segdes meleme
  69 :   11   continue
  70 :        segdes msoupo
  71 :   10   continue 
  72 :        segsup valc,ivalc,trav
  73 :        return
  74 :        end
  75 : 
  76 :  
  77 :  
  78 :  
  79 :  
  80 :