Télécharger la plaquette Cast3M


fr en

Télécharger cupcfg.eso

Retour à la liste

Numérotation des lignes : 

cupcfg

  1. C CUPCFG    SOURCE    PV        20/03/30    21:17:04     10567          
  2.       subroutine cupcfg(bu,bufPos,pConfi)
  3. C=======================================================================
  4. C  Sous-programme cupcfg (COLlaborateur UnPAquettage ConFiGuration)
  5. C  Lit la configuration dans le buffer et l'integre a la configuration
  6. C  pConfi si elle existe (pConfi different de 0 ou en alloue une en
  7. C  copiant la config actuelle si pConfi=0
  8. C=======================================================================
  9.       integer i
  10.       integer bufPos
  11.       integer nNoCo,iNoCo
  12.       integer lonBuf
  13.       integer iDiDis,bkidim
  14.       integer nbpts
  15.       integer posAv,posAp
  16.  
  17. -INC PPARAM
  18. -INC CCOPTIO
  19. -INC TMCOLAC
  20. -INC SMCOORD
  21.       segment BUFFER
  22.          character ffer(lonBuf)
  23.       endsegment
  24.       pointeur bu.BUFFER
  25.       pointeur pConfi.MCOORD
  26.  
  27. C      write(ioimp,*) 'Entree dans CUPCFG'
  28. C      write(ioimp,*)'Pointeur recu',pConfi
  29.  
  30.       nNoCo=0
  31.       iDiDis=0
  32. C     Paquettage de la configration tronquée et reordonnée selon la
  33. C     liste de noeud listNoe
  34.       lonBuf=bu.ffer(/2)
  35.       call mpiupI( nNoCo,1, bu,bufPos)
  36.       call mpiupI( iDiDis,1, bu,bufPos)
  37.       bkidim=IDIM
  38.       IDIM=iDiDis
  39.       nbpts=nNoCo
  40.       if(pConfi .eq. 0) then
  41.          segini pConfi
  42.       else
  43. C       Attention, l'objet configuration sera completement ecrase
  44.         if(pConfi.eq.mcoord) then
  45. C          Ce n'est pas une bonne idee d'appeler cette fonction avec la
  46. C          configuration actuelle
  47.            segdes pConfi
  48.         endif
  49.         segact pConfi*mod
  50.         if(pConfi.xcoor(/1).lt.(nNoCo*(iDiDis+1))) then
  51.            segadj pConfi
  52.         endif
  53.       endif
  54.       IDIM=bkidim
  55.       call mpiupR( pConfi.xcoor(1),(iDiDis+1)*nNoCo, bu,bufPos)
  56. C     Prise en compte des differences de dimensions
  57.       if(IDIM.ne.iDiDis) then
  58.          if(IDIM.lt.iDiDis) then
  59. C        Compression
  60.             do iNoCo=1,nNoCo
  61.                posAv=(iDiDis+1)*(iNoCo-1)
  62.                posAp=(  IDIM+1)*(iNoCo-1)
  63.                do i=1,IDIM
  64.                   pConfi.xcoor(posAp+i)=pConfi.xcoor(posAv+i)
  65.                enddo
  66.                pConfi.xcoor(posAp+IDIM+1)=pConfi.xcoor(posAv+iDiDis+1)
  67.             enddo
  68.             segadj pConfi
  69.          else
  70. C        Dilatation
  71.             segadj pConfi
  72.             do iNoCo=nNoCo,1,-1
  73.                posAv=(iDiDis+1)*(iNoCo-1)
  74.                posAp=(  IDIM+1)*(iNoCo-1)
  75.                pConfi.xcoor(posAp+IDIM+1)=pConfi.xcoor(posAv+iDiDis+1)
  76.                do i=IDIM,iDiDis+1,-1
  77.                   pConfi.xcoor(posAp+i)=0
  78.                enddo
  79.                do i=iDiDis,1,-1
  80.                   pConfi.xcoor(posAp+i)=pConfi.xcoor(posAv+i)
  81.                enddo
  82.             enddo
  83.          endif
  84.       endif
  85.       segdes pConfi
  86.       if(pConfi.eq.mcoord) then
  87.          segact pConfi
  88.       endif
  89. C      write(ioimp,*) 'Sortie de CUPCFG'
  90.       end
  91.  
  92.  
  93.  
  94.  
  95.  
  96.  
  97.  

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