Télécharger la plaquette Cast3M


fr en

Télécharger menag5.eso

Retour à la liste

Numérotation des lignes : 

menag5

  1. C MENAG5    SOURCE    PV        17/12/05    21:16:47     9646           
  2. C  SUPPRIMER LES SEGMENTS INDESIRABLES
  3. C
  4.       SUBROUTINE MENAG5(JCOLAC,ITL)
  5. *
  6.       IMPLICIT INTEGER(I-N)
  7.       integer i,ipile,islis
  8.       integer j,lisli2
  9.       integer jcolac
  10.  
  11. -INC PPARAM
  12. -INC CCOPTIO
  13. -INC COCOLL
  14. -INC TMCOLAC
  15.       pointeur tcolac.icolac
  16.       pointeur ptest.ilisse
  17.  
  18.       SEGMENT ISLI2(0)
  19.       SEGMENT ITL(0)
  20. *
  21. *
  22. *  EXTRAIRE DE JCOLAC LA LISTES DES SEGMENTS
  23. *
  24.       pointeur piles.LISPIL
  25.  
  26.       CALL MENAG2(ISLI2,JCOLAC)
  27. *
  28. *  RAJOUTER EVENTUELLEMENT L'ITLAC DES MELEME
  29. *
  30.       IF (ITL.NE.0) THEN
  31.        LISLI2=ISLI2(/1)
  32.        DO 10 I=1,LISLI2
  33.         IF (ISLI2(I).LT.ITL) GOTO 10
  34.          ISLI2(**)=ISLI2(LISLI2)
  35.          DO 20 J=LISLI2,I+1,-1
  36.           ISLI2(J)=ISLI2(J-1)
  37.   20     CONTINUE
  38.          ISLI2(I)=ITL
  39.          GOTO 30
  40.   10   CONTINUE
  41.        ISLI2(**)=ITL
  42.   30   CONTINUE
  43.       ENDIF
  44. *
  45. *  LISTE DES SEGMENTS CONTENUS DANS L'ENSEMBLE DES OBJETS
  46. *
  47.       CALL MENAG1(ISLIS)
  48. *
  49. *  mise a jour des piles d'objets deja sauves. Mise a zero de ceux
  50. *  qui n'existent plus
  51. *
  52.       CALL MENAG7(JCOLAC,IPSAUV)
  53. C     mise a jour des piles d'objets communiques
  54.       if(piComm.gt.0) then
  55.          piles=piComm
  56.          segact piles
  57.          do ipile=1,piles.proc(/1)
  58.             tcolac =  piles.proc(ipile)
  59.             segact tcolac*mod
  60.             ilisse = tcolac.ilissg
  61.             segact ilisse*mod
  62. C            write(6,*) 'Menage dans pile', ipile,tcolac,ilisse
  63.  
  64.             call menag7(jcolac, tcolac)
  65.             segdes ilisse
  66.             segdes tcolac
  67.          enddo
  68.          segdes piles
  69.       endif
  70.  
  71. *
  72. *  OTER DE CETTE LISTE LA LISTE DES SEGMENTS A GARDER
  73. *
  74.       CALL MENAG3(ISLIS,ISLI2)
  75. *
  76. *  DETRUIRE CES SEGMENTS
  77. *
  78.       CALL MENAG4(ISLIS)
  79. *
  80.       END
  81.  
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  

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