Télécharger la plaquette Cast3M


fr en

Télécharger dbbcd.eso

Retour à la liste

Numérotation des lignes : 

dbbcd

  1. C DBBCD     SOURCE    PV        21/01/29    21:15:15     10866          
  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.  
  8. -INC PPARAM
  9. -INC CCOPTIO
  10. -INC SMELEME
  11. -INC SMCHPOI
  12. -INC SMCOORD
  13.       segment valc(ipt8.num(/2))
  14.       segment ivalc(ipt8.num(/2))
  15.       segment trav
  16.       integer lag1(nbpts)
  17.       endsegment
  18. *  ne fonctionne que pour des FLX, on suppose qu'il n'y a qu'une inconnue
  19. *  par noeud dédoublé
  20.       if (ipt8.eq.0) return
  21.       segact mchpoi,ipt8
  22. **    call echpo(mchpoi,1)
  23. **    call ecmail(ipt8,1)
  24. **    segact mchpoi,ipt8
  25.       segini valc,ivalc
  26.       segini trav
  27.       do 300 i=1,ipt8.num(/2)
  28.       lag1(ipt8.num(1,i))=i
  29.       lag1(ipt8.num(2,i))=i
  30.  300  continue
  31.       do 10 isoupo=1,ipchp(/1)
  32.        msoupo=ipchp(isoupo)
  33.        segact msoupo*mod
  34.        if (nocomp(/2).ne.1) goto 11
  35.        if (nocomp(1).ne.'FLX') goto 11
  36.        meleme=igeoc
  37.        mpoval=ipoval
  38.        segini,ipt1=meleme,mpova1=mpoval
  39.        nbnn=ipt1.num(/1)
  40.        nbelem=ipt1.num(/2)
  41.        nbele=nbelem
  42.        nbsous=0
  43.        nbref=0
  44.        ic=0
  45.        do 100 j=1,nbele
  46.        val=mpova1.vpocha(j,1)
  47.        if (lag1(ipt1.num(1,j)).ne.0) then
  48.        jj=lag1(ipt1.num(1,j))
  49.          valc(jj)=  +val
  50.          if (ivalc(jj).ne.0) then
  51.            ipt1.num(1,ivalc(jj))=ipt8.num(1,jj)
  52.            mpova1.vpocha(ivalc(jj),1)=valc(jj)
  53.            goto 100
  54.          endif
  55.          ivalc(jj)=ic+1
  56.         endif
  57.  110   continue
  58.         ic=ic+1
  59.         ipt1.num(1,ic)=ipt1.num(1,j)
  60.         mpova1.vpocha(ic,1)=val
  61.  100   continue
  62.        nbelem=ic
  63.        segadj ipt1
  64. **     segdes ipt1
  65.        n=ic
  66.        nc=1
  67.        segadj mpova1
  68. **     segdes mpova1
  69.        igeoc=ipt1
  70.        ipoval=mpova1
  71.        segsup mpoval
  72. **     segdes meleme
  73.   11   continue
  74. **     segdes msoupo
  75.   10   continue
  76.        segsup valc,ivalc,trav
  77.        return
  78.        end
  79.  
  80.  
  81.  
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  
  88.  

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