Télécharger cupcfg.eso

Retour à la liste

Numérotation des lignes :

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

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