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

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