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    PV090527  25/01/08    21:15:06     12111          
  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.             PRECM6(IPRECO,ith1) = 0
  56.  
  57.           ELSE
  58. C           Le CCPRECO pour le REDU est retasse
  59.             ICOUR = ICOUR + 1
  60.             PRECMO(ICOUR,ith1) = PRECMO(IPRECO,ith1)
  61.             PRECM1(ICOUR,ith1) = PRECM1(IPRECO,ith1)
  62.             PRECM2(ICOUR,ith1) = PRECM2(IPRECO,ith1)
  63.             PRECM3(ICOUR,ith1) = PRECM3(IPRECO,ith1)
  64.             PRECM4(ICOUR,ith1) = PRECM4(IPRECO,ith1)
  65.             PRECM5(ICOUR,ith1) = PRECM5(IPRECO,ith1)
  66.             PRECM6(ICOUR,ith1) = PRECM6(IPRECO,ith1)
  67.           ENDIF
  68.  145    CONTINUE
  69.         NBPRRE(ith1) = ICOUR
  70.  144  CONTINUE
  71.  
  72. C     Verification dans le CCPRECO pour les MMODEL etendus (modete) : On supprime ceux que le menage veut supprimer
  73.       DO 151 ITH1 = 1, NBASMA+1
  74.         ITAILL = NBMOMO(ith1)
  75.         IF (ITAILL .EQ. 0) GOTO 151
  76.         ICOUR = 0
  77.         DO 152 IPRECO = 1, ITAILL
  78.           IMO1 = PMOMO1(IPRECO,ITH1)
  79.           IMO2 = PMOMO2(IPRECO,ITH1)
  80.           IF (IMO1 .EQ. 0) GOTO 152
  81.  
  82. C         Verification VALIDITE POINTEUR
  83.           IF(.NOT. (OOOVP1(IMO1).AND.OOOVP1(IMO2)))THEN
  84.             PMOMO1(IPRECO,ith1) = 0
  85.             PMOMO2(IPRECO,ith1) = 0
  86.  
  87.           ELSE
  88. C           Le CCPRECO pour le REDU est retasse
  89.             ICOUR = ICOUR + 1
  90.             PMOMO1(ICOUR,ith1) = PMOMO1(IPRECO,ith1)
  91.             PMOMO2(ICOUR,ith1) = PMOMO2(IPRECO,ith1)
  92.           ENDIF
  93.  152    CONTINUE
  94.         NBMOMO(ith1) = ICOUR
  95.  151  CONTINUE
  96.  
  97. C Rebelote pour le preconditionnement de chame1
  98.       do 170 ith=0,nbasma
  99.        do 171 iprec=nprcha,1,-1
  100.          ich=iprchl(iprec,ith)
  101.          if (.not.ooovp1(ich)) then
  102.          do 172 ipr=iprec,nprcha-1
  103.            iprma(ipr,ith) =iprma(ipr+1,ith)
  104.            iprhoa(ipr,ith)=iprhoa(ipr+1,ith)
  105.            iprmo(ipr,ith) =iprmo(ipr+1,ith)
  106.            iprhom(ipr,ith)=iprhom(ipr+1,ith)
  107.            iprchp(ipr,ith)=iprchp(ipr+1,ith)
  108.            iprhoc(ipr,ith)=iprhoc(ipr+1,ith)
  109.            iprsu(ipr,ith) =iprsu(ipr+1,ith)
  110.            iprcha(ipr,ith)=iprcha(ipr+1,ith)
  111.            iprcnf(ipr,ith)=iprcnf(ipr+1,ith)
  112.            iprchl(ipr,ith)=iprchl(ipr+1,ith)
  113.  172     continue
  114.            iprchp(nprcha,ith) =0
  115.          endif
  116.  171   continue
  117.  170  continue
  118.  
  119. C PRECOnditionnement "CMODPG" des MODELEs (pimodl.eso) :
  120.       DO ith1 = 1, NBASMA+1
  121.         ITAILL = NBMODP(ith1)
  122.         IF (ITAILL .GT. 0) THEN
  123.           icour = 0
  124.           DO ipreco = 1, ITAILL
  125.             IMO1 = PMODPE(ipreco,ith1)
  126.             IF (IMO1 .GT. 0) THEN
  127. C         Verification VALIDITE POINTEUR
  128.               IMA2 = PMADPS(ipreco,ith1)
  129.               IF (.NOT. (OOOVP1(IMO1).AND.OOOVP1(IMA2))) THEN
  130.                 PMODPE(ipreco,ith1) = 0
  131.                 PMODPH(ipreco,ith1) = 0
  132.                 PMODPS(ipreco,ith1) = 0
  133.                 PMADPS(ipreco,ith1) = 0
  134.               ELSE
  135. C              Le PREConditionnement CMODPG est retasse
  136.                 icour = icour + 1
  137.                 PMODPE(icour,ith1) = PMODPE(ipreco,ith1)
  138.                 PMODPH(icour,ith1) = PMODPH(ipreco,ith1)
  139.                 PMODPS(icour,ith1) = PMODPS(ipreco,ith1)
  140.                 PMADPS(icour,ith1) = PMADPS(ipreco,ith1)
  141.               ENDIF
  142.             ENDIF
  143.           ENDDO
  144.           NBMOCV(ith1) = icour
  145.         ENDIF
  146.       ENDDO
  147.  
  148. C PRECOnditionnement "CMOCNV" des MODELEs de CONVECTION (selmod.eso) :
  149.       DO ith1 = 1, NBASMA+1
  150.         ITAILL = NBMOCV(ith1)
  151.         IF (ITAILL .GT. 0) THEN
  152.           icour = 0
  153.           DO ipreco = 1, ITAILL
  154.             IMO1 = PMOCVE(ipreco,ith1)
  155.             IF (IMO1 .GT. 0) THEN
  156. C         Verification VALIDITE POINTEUR
  157.               IMO2 = PMOCVS(ipreco,ith1)
  158.               IF (.NOT. (OOOVP1(IMO1).AND.OOOVP1(IMO2))) THEN
  159.                 PMOCVE(ipreco,ith1) = 0
  160.                 PMOCVH(ipreco,ith1) = 0
  161.                 PMOCVS(ipreco,ith1) = 0
  162.               ELSE
  163. C              Le PREConditionnement CMOCNV est retasse
  164.                 icour = icour + 1
  165.                 PMOCVE(icour,ith1) = PMOCVE(ipreco,ith1)
  166.                 PMOCVH(icour,ith1) = PMOCVH(ipreco,ith1)
  167.                 PMOCVS(icour,ith1) = PMOCVS(ipreco,ith1)
  168.               ENDIF
  169.             ENDIF
  170.           ENDDO
  171.           NBMOCV(ith1) = icour
  172.         ENDIF
  173.       ENDDO
  174.  
  175. C==DEB= FORMULATION HHO == Traitements specifiques ====================
  176. C Verification si le menage veut supprimer les maillages HHO
  177.       IF (NUFHHO .GT. 0) THEN
  178. c-dbg      IF (MSQHHO .GT. 0) THEN
  179.         IF ( OOOVP1(MSQHHO) .AND. OOOVP1(MCEHHO) .AND.
  180.      &       OOOVP1(MPFHHO) .AND. OOOVP1(MPCHHO) ) THEN
  181. c-dbg          write(6,*) 'MENAG4 - HHO -> OK Pointeurs Maillages conserves'
  182.         ELSE
  183.           write(6,*) 'MENAG4 - HHO -> PB Pointeurs Maillages detruits'
  184.         END IF
  185.       END IF
  186. C==FIN= FORMULATION HHO ================================================
  187.  
  188. c      RETURN
  189.       END
  190.  
  191.  
  192.  
  193.  

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