Télécharger crepi0.eso

Retour à la liste

Numérotation des lignes :

  1. C CREPI0 SOURCE PV 16/11/26 21:15:28 9205
  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.  
  31. ILISSE = ILISSG
  32. SEGACT ILISSE*MOD
  33. *
  34. * pour les piles des tables (N° 10) et des OBJETS(N° 44) on
  35. * duplique les objets existants AU niveau de l'attribution des noms
  36. * il faudra parcourir la pile en sens inverse
  37. * idem pour les config
  38. ITLACC=KCOLA(10)
  39. IN=ITLAC(/1)
  40. IF(IN.NE.0) THEN
  41. DO 1 J=1,IN
  42. IF(ITLAC(J).NE.0) THEN
  43. * ITLAC(**)=ITLAC(J)
  44. ILISEG((ITLAC(J)-1)/npgcd)=0
  45. ITLAC(J)=0
  46. ENDIF
  47. 1 CONTINUE
  48. ENDIF
  49. ITLACC=KCOLA(44)
  50. IN=ITLAC(/1)
  51. IF(IN.NE.0) THEN
  52. DO 3 J=1,IN
  53. IF(ITLAC(J).NE.0) THEN
  54. * ITLAC(**)=ITLAC(J)
  55. ILISEG((ITLAC(J)-1)/npgcd)=0
  56. ITLAC(J)=0
  57. ENDIF
  58. 3 CONTINUE
  59. ENDIF
  60. C pour les configu on met en premier la configuration courante
  61. ITLACC=KCOLA(33)
  62. * ITLAC(**)=MCOORD
  63. IN=ITLAC(/1)
  64. **** IF(IN.NE.1) THEN
  65. * on resauve toujours la configuration courante au cas ou il y ait eu renumerotation
  66. DO 4 J=1,IN
  67. IF(ITLAC(J).NE.0) THEN
  68. * IF(ITLAC(J).NE.MCOORD)ITLAC(**)=ITLAC(J)
  69. ILISEG((ITLAC(J)-1)/npgcd)=0
  70. ITLAC(J)=0
  71. ENDIF
  72. 4 CONTINUE
  73. ** ENDIF
  74. RETURN
  75. END
  76.  
  77.  
  78.  
  79.  
  80.  
  81.  
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  

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