Télécharger la plaquette Cast3M


fr en

Télécharger restme.eso

Retour à la liste

Numérotation des lignes : 

restme

  1. C RESTME    SOURCE    PV        17/12/05    21:17:14     9646           
  2.       SUBROUTINE RESTME  (ITLACC,IMAX1,ICOLAC,IDEB)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. C=======================================================================
  6. C   RESTAURATION DES POINTEURS
  7. C
  8. C   APPELE PAR RESTPI
  9. C   APPELLE : ERREUR
  10. C=======================================================================
  11. C  TABLEAU KCOLA : VOIR LE SOUS-PROGRAMME TYPFIL
  12. C=======================================================================
  13.  
  14. -INC PPARAM
  15. -INC CCOPTIO
  16. -INC SMELEME
  17. -INC TMCOLAC
  18. -INC CCGEOME
  19. C=======================================================================
  20. C                      A EXAMINER.
  21. C                    APRES, CONTIENTPOUR CHAQUE PILE LE NBRE D'OBJETS A
  22. C                    SORTIR
  23. C=======================================================================
  24. C
  25. C
  26. C
  27. C****** BOUCLE SUR LES FILES DE SORTIE IFILE=1,NITLAC******************
  28. C
  29. C     ****************************** MELEME ****************************
  30.       ITLAC1=KCOLA(32)
  31.  6001 CONTINUE
  32. *  restauration ilgni
  33.       if (ideb.eq.1)  then
  34.         if ((ilgni.ne.0)  .and. (itlac1.itlac(/1) .GT. ilgni))
  35.      &       ilgni=itlac1.itlac(ilgni)
  36.       endif
  37. *
  38.       DO 20 I=IDEB,IMAX1
  39.       MELEME=ITLAC(I)
  40.       IF (MELEME.EQ.0) GO TO 20
  41.       SEGACT MELEME*MOD
  42.       IF (LISOUS(/1).EQ.0) GOTO 21
  43.       DO 1003 J=1,LISOUS(/1)
  44.       LISOUS(J)=ITLAC(LISOUS(J))
  45.  1003 CONTINUE
  46.   21  CONTINUE
  47.       IF (LISREF(/1).EQ.0) GOTO 25
  48.       DO 1004 J=1,LISREF(/1)
  49.       LISREF(J)=ITLAC(LISREF(J))
  50.  1004 CONTINUE
  51.   25  CONTINUE
  52.       IF(NUM(/2).EQ.0) GO TO  60
  53.       IF(IONIVE.GT.9) THEN
  54.         DO 61 K2=1,NUM(/2)
  55.         DO 61 K1=1,NUM(/1)
  56.           NUM(K1,K2) = ITLAC1.ITLAC(NUM(K1,K2))
  57.   61    CONTINUE
  58.       ENDIF
  59.   60  CONTINUE
  60.       SEGDES MELEME
  61.   20  CONTINUE
  62.       GOTO 1098
  63. C***********************************************************************
  64.  1098 CONTINUE
  65. C*********************************************************************
  66. C
  67.       RETURN
  68.       END
  69.  
  70.  
  71.  
  72.  

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