Télécharger la plaquette Cast3M


fr en

Télécharger menag1.eso

Retour à la liste

Numérotation des lignes : 

menag1

  1. C MENAG1    SOURCE    OF166741  24/10/21    21:15:19     12042          
  2.  
  3. C  SUPPRIMER LES SEGMENTS INDESIRABLES
  4.  
  5.       SUBROUTINE MENAG1(ISLIS)
  6.  
  7.       IMPLICIT INTEGER(I-N)
  8.       IMPLICIT REAL*8 (A-H,O-Z)
  9.  
  10. -INC CCNOYAU
  11. -INC CCPRECO
  12.  
  13. -INC SMELEME
  14.       SEGMENT ISLIS(NP)
  15.       SEGMENT ISLI2(0)
  16.       segment isli3(0)
  17.       SEGMENT IBLIS(ISLIS(/1))
  18.  
  19. C  LISTE DES SEGMENTS
  20.       CALL OOOLIS(ISLIS)
  21.       SEGINI IBLIS
  22. C  TRI
  23.       CALL TRIENT(ISLIS(1),IBLIS(1),ISLIS(/1))
  24. C  LISTE DES SEGMENTS INITIAUX
  25.       ISLI2=NOYSEG
  26.       SEGACT ISLI2
  27.  
  28. C  liste des segments du preconditionnement des MELEME
  29.       segini isli3
  30.       do 10 ip=1,npreco
  31.        meleme=prenum(ip)
  32.        if (meleme.eq.0) goto 10
  33.        isli3(**)=meleme
  34.        segact meleme
  35.        do 20 is=1,lisous(/1)
  36.          isli3(**)=lisous(is)
  37.   20   continue
  38.       segdes,meleme
  39.   10  continue
  40.  
  41. C  liste des segments du preconditionnement des MLENTI dans REDUAF
  42.       DO 30 ith1=1,NBASMA+1
  43.         DO 40 ip=1,NTRIPL
  44.           mlenti=PMLENT(ip,ith1)
  45.           if (mlenti.EQ.0) GOTO 40
  46.           isli3(**)=mlenti
  47.   40    CONTINUE
  48.   30  CONTINUE
  49.  
  50. C  liste des segments du preconditionnement de ACTOBJ
  51.       DO 50 ith1=1,NBASMA+1
  52.         iseg=PACTOB(ith1)
  53.         if(iseg.EQ.0) GOTO 50
  54.         isli3(**)=iseg
  55.   50  CONTINUE
  56.  
  57.  
  58.        if (isli3(/1).ne.0) CALL TRIENT(ISLI3(1),IBLIS(1),ISLI3(/1))
  59.        SEGSUP IBLIS
  60. C  OTER LA DEUXIEME LISTE A LA PREMIERE
  61.       CALL MENAG3(ISLIS,ISLI2)
  62.       SEGDES ISLI2
  63. C  OTER LA TROISIEME LISTE
  64.       CALL MENAG3(ISLIS,ISLI3)
  65.  
  66.       segsup isli3
  67.  
  68. c      return
  69.       END
  70.  
  71.  
  72.  

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