Télécharger crepi0.eso

Retour à la liste

Numérotation des lignes :

  1. C CREPI0 SOURCE PV 17/12/05 21:15:42 9646
  2. SUBROUTINE CREPI0(ICOLAC)
  3. IMPLICIT INTEGER(I-N)
  4. -INC TMCOLAC
  5. -INC SMCOORD
  6. -INC CCOPTIO
  7. SEGACT ICOLAC*MOD
  8. call ooohor(0,0)
  9. DO 2 I=1,KCOLA(/1)
  10. ITLACC=KCOLA(I)
  11. SEGACT ITLACC*MOD
  12. ISGTR=ICOLA(I)
  13. SEGACT ISGTR*MOD
  14. C write(6,*)' crepi0 itlacc isgtr',itlacc,isgtr
  15. 2 CONTINUE
  16. * pour les piles entiers flottant mot logique on réecrit tout
  17. ks=0
  18. do i=24,27
  19. itlacc=kcola(i)
  20. segsup itlacc
  21. segini itlacc
  22. mcola(i)=0
  23. kcola(i)=itlacc
  24. ISGTR=ICOLA(I)
  25. segsup isgtr
  26. segini isgtr
  27. icola(i)=isgtr
  28. kcolac(i)=0
  29. enddo
  30. * on vide la table inverse des reels
  31. ILISSE = ILISSF
  32. segact ilisse*mod
  33. do i=1,iliseg(/1)
  34. iliseg(i)=0
  35. enddo
  36.  
  37. ILISSE = ILISSG
  38. SEGACT ILISSE*MOD
  39. *
  40. * pour les piles des tables (N° 10) et des OBJETS(N° 44) on
  41. * duplique les objets existants AU niveau de l'attribution des noms
  42. * il faudra parcourir la pile en sens inverse
  43. * idem pour les config
  44. ITLACC=KCOLA(10)
  45. IN=ITLAC(/1)
  46. IF(IN.NE.0) THEN
  47. DO 1 J=1,IN
  48. IF(ITLAC(J).NE.0) THEN
  49. * ITLAC(**)=ITLAC(J)
  50. ILISEG((ITLAC(J)-1)/npgcd)=0
  51. ITLAC(J)=0
  52. ENDIF
  53. 1 CONTINUE
  54. ENDIF
  55. ITLACC=KCOLA(44)
  56. IN=ITLAC(/1)
  57. IF(IN.NE.0) THEN
  58. DO 3 J=1,IN
  59. IF(ITLAC(J).NE.0) THEN
  60. * ITLAC(**)=ITLAC(J)
  61. ILISEG((ITLAC(J)-1)/npgcd)=0
  62. ITLAC(J)=0
  63. ENDIF
  64. 3 CONTINUE
  65. ENDIF
  66. C pour les configu on met en premier la configuration courante
  67. ITLACC=KCOLA(33)
  68. * ITLAC(**)=MCOORD
  69. IN=ITLAC(/1)
  70. **** IF(IN.NE.1) THEN
  71. * on resauve toujours la configuration courante au cas ou il y ait eu renumerotation
  72. DO 4 J=1,IN
  73. IF(ITLAC(J).NE.0) THEN
  74. * IF(ITLAC(J).NE.MCOORD)ITLAC(**)=ITLAC(J)
  75. ILISEG((ITLAC(J)-1)/npgcd)=0
  76. ITLAC(J)=0
  77. ENDIF
  78. 4 CONTINUE
  79. ** ENDIF
  80. RETURN
  81. END
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  
  88.  
  89.  
  90.  
  91.  
  92.  
  93.  
  94.  

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