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

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