Télécharger cupcfg.eso

Retour à la liste

Numérotation des lignes :

  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