Télécharger rest.eso

Retour à la liste

Numérotation des lignes :

  1. C REST SOURCE PV 16/11/26 21:16:22 9205
  2. SUBROUTINE REST
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C=======================================================================
  6. C DIRECTIVE RESTITUER
  7. C ----------------
  8. C
  9. C
  10. C BUT: LECTURE ET RESTAURATION DES OBJETS NOMMES ET DE CEUX QU ILS
  11. C SOUS-TENDENT, SUR LE FICHIER IORES
  12. C IORESSAU EST DEFINI PAR: OPTIO RESTSAUV IORESSAU ;
  13. C
  14. C
  15. C ON SAIT RESTITUER LES OBJETS DONT LE TYPE EST CONTENU
  16. C DANS LE SP TYPFIL
  17. C
  18. C APPELLE TYPFIL CREPIL LIPIL
  19. C ECRIT PAR FARVACQUE
  20. C REPRIS PAR LENA
  21. C ---------------------------------------------------------------------
  22. C=======================================================================
  23. -INC TMCOLAC
  24. -INC CCOPTIO
  25. -INC CCFXDR
  26. C
  27. C
  28. CHARACTER*8 ITYPE
  29. CHARACTER*72 LABEL
  30. CHARACTER*4 MOFORM(2)
  31. DATA MOFORM/'FORM','LABE'/
  32. C
  33. IFORM=0
  34. ISTOPR=1000000
  35. LABEL= ' '
  36. 1 CONTINUE
  37. CALL LIRMOT(MOFORM,2,IRET,0)
  38. IF(IRET.EQ.1) THEN
  39. IFORM=1
  40. if(irefor.ne.iform) then
  41. call erreur(21)
  42. return
  43. endif
  44. GO TO 1
  45. ELSEIF(IRET.EQ.2) THEN
  46. CALL LIRCHA ( LABEL,1,IRETOU)
  47. IF(IERR.NE.0) RETURN
  48. IF( LABEL(1:5).EQ.'AUTO ') THEN
  49. LABEL='LABEL AUTOMATIQUE :'
  50. CALL LIRENT (ILABAU,1,IRETOU)
  51. IF(IERR.NE.0) RETURN
  52. WRITE(LABEL(20:23),FMT='(I4)') ILABAU
  53. ENDIF
  54. GO TO 1
  55. ENDIF
  56. iform=irefor
  57. * write (6,*) ' iformx dans rest ',iformx
  58. if (iformx.eq.2) iform=2
  59. C
  60. C **** ICOLAC EST INITIALISEE DANS CREPIL
  61. ITYPE=' '
  62. K=-1
  63. CALL TYPFIL( ITYPE,K)
  64. NITLAC=-K
  65. CALL CREPIL(ICOLAC,NITLAC)
  66. CCC IF (IIMPI.EQ.5)WRITE (IOIMP,801) NITLAC
  67. 801 FORMAT(' NOMBRE DE PILES CREEES : ',I5)
  68. C-------------------------------------------------------------
  69. if (iform.ne.2) REWIND IORES
  70. * if (iform.eq.2) ios=IXDRREWIND( ixdrw )
  71. C *** LECTURE SUR LE FICHIER DE RESTAURATION
  72. C --- LECTURE DES PILES
  73. IFIN=0
  74. IRET=0
  75. ISNIV=IONIVE
  76. CALL LIPIL (ICOLAC,IFIN,IRET,IFORM,LABEL)
  77. IF (IRET.NE.0) GO TO 5000
  78. IF (IIMPI.EQ.5)WRITE (IOIMP,805)
  79. 805 FORMAT(' RESTAURATION EFFECTUEE ')
  80. C --- IMPRESSIONS INTERMEDIAIRES DES PILES
  81. IVOULU=0
  82. C-------------------------------------------------------------
  83. C --- RESTAURATION DES POINTEURS
  84. CALL RESTPI (ICOLAC)
  85. IF (IIMPI.EQ.5)WRITE (IOIMP,806)
  86. 806 FORMAT(' RESTAURATION DES POINTEURS EFFECTUEE ')
  87. * fusion des éventuels doubles multiplicateurs de L
  88. IF (IONIVE.LE.15) CALL DBBSUP(ICOLAC)
  89. C-------------------------------------------------------------
  90. CALL ERREUR(-277)
  91. C MODI N.BLAY LE 17/09/91 COHERENCE AVEC SAUV-----------------
  92. if (iform.ne.2) REWIND IORES
  93. if (iform.eq.2) ios=IXDRREWIND( ixdrr )
  94. 1000 CONTINUE
  95. C --- SUPPRESSION DES PILES (IVOULU=0)
  96. IVOULU=10000
  97. CALL SUPPIL (ICOLAC,IVOULU)
  98. IF (IIMPI.EQ.5)WRITE (IOIMP,807)
  99. 807 FORMAT(' SUPPRESSION DES PILES EFFECTUEE ')
  100. * on ne sait pas sauver en dessous de 16 a cause des mult de L
  101. IONIVE=max(ISNIV,16)
  102. GO TO 11
  103. C-------------------------------------------------------------
  104. 5000 CONTINUE
  105. CALL ERREUR(559)
  106. GO TO 1000
  107. 11 RETURN
  108. END
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  

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