Télécharger la plaquette Cast3M


fr en

Télécharger menag4.eso

Retour à la liste

Numérotation des lignes : 

menag4

  1. C MENAG4    SOURCE    OF166741  24/06/19    21:15:11     11942          
  2. C  SUPPRIMER LES SEGMENTS INDESIRABLES
  3. C
  4.       SUBROUTINE MENAG4(ISLIS)
  5.       IMPLICIT INTEGER(I-N)
  6.  
  7. -INC PPARAM
  8.  
  9. -INC CCPRECO
  10.  
  11. C==DEB= FORMULATION HHO == Includes specifiques ========================
  12. -INC CCHHOPA
  13. -INC CCHHOPR
  14. C==FIN= FORMULATION HHO ================================================
  15.  
  16.       SEGMENT ISLIS(NP)
  17.       SEGMENT ISEG(0)
  18.  
  19.       LOGICAL OOOVP1
  20.  
  21.       IPREC=0
  22.       DO 10 I=1,ISLIS(/1)
  23.         ISEG=ISLIS(I)
  24.         IF (ISEG.EQ.ISLIS) GOTO 10
  25.         IF (ISEG.EQ.IPREC) GOTO 10
  26.         IPREC=ISEG
  27.         SEGSUP,ISEG
  28.   10  CONTINUE
  29.       SEGSUP,ISLIS
  30.  
  31. C     Vidange des queues de DESACTIVATION et SUPPRESSION (action faite par lots en temps normal)
  32. C     ATTENTION : On n'est pas protege par le GLOBAL LOCK, seulement par le LOCK du menage
  33.       call ooodeq(0)
  34.       call ooosuq(0)
  35.  
  36. C     Verification dans le CCPRECO pour le REDU : On retire les OBJETS que le menage a supprime
  37.       DO 144 ITH1 = 1, NBASMA+1
  38.         ITAILL = NBPRRE(ith1)
  39.         IF (ITAILL .EQ. 0) GOTO 144
  40.         ICOUR = 0
  41.         DO 145 IPRECO = 1, ITAILL
  42.           IMO  = PRECMO(IPRECO,ITH1)
  43.           IF (IMO .EQ. 0) GOTO 145
  44.           ICH1 = PRECM1(IPRECO,ITH1)
  45.           ICH2 = PRECM2(IPRECO,ITH1)
  46.  
  47. C         Verification VALIDITE POINTEUR
  48.           IF(.NOT. (OOOVP1(IMO).AND.OOOVP1(ICH1).AND.OOOVP1(ICH2)))THEN
  49.             PRECMO(IPRECO,ith1) = 0
  50.             PRECM1(IPRECO,ith1) = 0
  51.             PRECM2(IPRECO,ith1) = 0
  52.             PRECM3(IPRECO,ith1) = 0
  53.             PRECM4(IPRECO,ith1) = 0
  54.             PRECM5(IPRECO,ith1) = 0
  55.  
  56.           ELSE
  57. C           Le CCPRECO pour le REDU est retasse
  58.             ICOUR = ICOUR + 1
  59.             PRECMO(ICOUR,ith1) = PRECMO(IPRECO,ith1)
  60.             PRECM1(ICOUR,ith1) = PRECM1(IPRECO,ith1)
  61.             PRECM2(ICOUR,ith1) = PRECM2(IPRECO,ith1)
  62.             PRECM3(ICOUR,ith1) = PRECM3(IPRECO,ith1)
  63.             PRECM4(ICOUR,ith1) = PRECM4(IPRECO,ith1)
  64.             PRECM5(ICOUR,ith1) = PRECM5(IPRECO,ith1)
  65.           ENDIF
  66.  145    CONTINUE
  67.         NBPRRE(ith1) = ICOUR
  68.  144  CONTINUE
  69.  
  70. C     Verification dans le CCPRECO pour les MMODEL etendus (modete) : On supprime ceux que le menage veut supprimer
  71.       DO 151 ITH1 = 1, NBASMA+1
  72.         ITAILL = NBMOMO(ith1)
  73.         IF (ITAILL .EQ. 0) GOTO 151
  74.         ICOUR = 0
  75.         DO 152 IPRECO = 1, ITAILL
  76.           IMO1 = PMOMO1(IPRECO,ITH1)
  77.           IMO2 = PMOMO2(IPRECO,ITH1)
  78.           IF (IMO1 .EQ. 0) GOTO 152
  79.  
  80. C         Verification VALIDITE POINTEUR
  81.           IF(.NOT. (OOOVP1(IMO1).AND.OOOVP1(IMO2)))THEN
  82.             PMOMO1(IPRECO,ith1) = 0
  83.             PMOMO2(IPRECO,ith1) = 0
  84.  
  85.           ELSE
  86. C           Le CCPRECO pour le REDU est retasse
  87.             ICOUR = ICOUR + 1
  88.             PMOMO1(ICOUR,ith1) = PMOMO1(IPRECO,ith1)
  89.             PMOMO2(ICOUR,ith1) = PMOMO2(IPRECO,ith1)
  90.           ENDIF
  91.  152    CONTINUE
  92.         NBMOMO(ith1) = ICOUR
  93.  151  CONTINUE
  94.  
  95. C Rebelote pour le preconditionnement de chame1
  96.       do 170 ith=0,nbasma
  97.        do 171 iprec=nprcha,1,-1
  98.          ich=iprchl(iprec,ith)
  99.          if (.not.ooovp1(ich)) then
  100.          do 172 ipr=iprec,nprcha-1
  101.            iprma(ipr,ith) =iprma(ipr+1,ith)
  102.            iprhoa(ipr,ith)=iprhoa(ipr+1,ith)
  103.            iprmo(ipr,ith) =iprmo(ipr+1,ith)
  104.            iprhom(ipr,ith)=iprhom(ipr+1,ith)
  105.            iprchp(ipr,ith)=iprchp(ipr+1,ith)
  106.            iprhoc(ipr,ith)=iprhoc(ipr+1,ith)
  107.            iprsu(ipr,ith) =iprsu(ipr+1,ith)
  108.            iprcha(ipr,ith)=iprcha(ipr+1,ith)
  109.            iprchl(ipr,ith)=iprchl(ipr+1,ith)
  110.  172     continue
  111.            iprchp(nprcha,ith) =0
  112.          endif
  113.  171   continue
  114.  170  continue
  115.  
  116. C==DEB= FORMULATION HHO == Traitements specifiques ====================
  117. C Verification si le menage veut supprimer les maillages HHO
  118.       IF (NUFHHO .GT. 0) THEN
  119. c-dbg      IF (MSQHHO .GT. 0) THEN
  120.         IF ( OOOVP1(MSQHHO) .AND. OOOVP1(MCEHHO) .AND.
  121.      &       OOOVP1(MPFHHO) .AND. OOOVP1(MPCHHO) ) THEN
  122. c-dbg          write(6,*) 'MENAG4 - HHO -> OK Pointeurs Maillages conserves'
  123.         ELSE
  124.           write(6,*) 'MENAG4 - HHO -> PB Pointeurs Maillages detruits'
  125.         END IF
  126.       END IF
  127. C==FIN= FORMULATION HHO ================================================
  128.  
  129. c      RETURN
  130.       END
  131.  
  132.  
  133.  
  134.  

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