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/10/21    21:15:19     12042          
  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 PRECOnditionnement "CMODPG" des MODELEs (pimodl.eso) :
  117.       DO ith1 = 1, NBASMA+1
  118.         ITAILL = NBMODP(ith1)
  119.         IF (ITAILL .GT. 0) THEN
  120.           icour = 0
  121.           DO ipreco = 1, ITAILL
  122.             IMO1 = PMODPE(ipreco,ith1)
  123.             IF (IMO1 .GT. 0) THEN
  124. C         Verification VALIDITE POINTEUR
  125.               IMA2 = PMADPS(ipreco,ith1)
  126.               IF (.NOT. (OOOVP1(IMO1).AND.OOOVP1(IMA2))) THEN
  127.                 PMODPE(ipreco,ith1) = 0
  128.                 PMODPH(ipreco,ith1) = 0
  129.                 PMODPS(ipreco,ith1) = 0
  130.                 PMADPS(ipreco,ith1) = 0
  131.               ELSE
  132. C              Le PREConditionnement CMODPG est retasse
  133.                 icour = icour + 1
  134.                 PMODPE(icour,ith1) = PMODPE(ipreco,ith1)
  135.                 PMODPH(icour,ith1) = PMODPH(ipreco,ith1)
  136.                 PMODPS(icour,ith1) = PMODPS(ipreco,ith1)
  137.                 PMADPS(icour,ith1) = PMADPS(ipreco,ith1)
  138.               ENDIF
  139.             ENDIF
  140.           ENDDO
  141.           NBMOCV(ith1) = icour
  142.         ENDIF
  143.       ENDDO
  144.  
  145. C PRECOnditionnement "CMOCNV" des MODELEs de CONVECTION (selmod.eso) :
  146.       DO ith1 = 1, NBASMA+1
  147.         ITAILL = NBMOCV(ith1)
  148.         IF (ITAILL .GT. 0) THEN
  149.           icour = 0
  150.           DO ipreco = 1, ITAILL
  151.             IMO1 = PMOCVE(ipreco,ith1)
  152.             IF (IMO1 .GT. 0) THEN
  153. C         Verification VALIDITE POINTEUR
  154.               IMO2 = PMOCVS(ipreco,ith1)
  155.               IF (.NOT. (OOOVP1(IMO1).AND.OOOVP1(IMO2))) THEN
  156.                 PMOCVE(ipreco,ith1) = 0
  157.                 PMOCVH(ipreco,ith1) = 0
  158.                 PMOCVS(ipreco,ith1) = 0
  159.               ELSE
  160. C              Le PREConditionnement CMOCNV est retasse
  161.                 icour = icour + 1
  162.                 PMOCVE(icour,ith1) = PMOCVE(ipreco,ith1)
  163.                 PMOCVH(icour,ith1) = PMOCVH(ipreco,ith1)
  164.                 PMOCVS(icour,ith1) = PMOCVS(ipreco,ith1)
  165.               ENDIF
  166.             ENDIF
  167.           ENDDO
  168.           NBMOCV(ith1) = icour
  169.         ENDIF
  170.       ENDDO
  171.  
  172. C==DEB= FORMULATION HHO == Traitements specifiques ====================
  173. C Verification si le menage veut supprimer les maillages HHO
  174.       IF (NUFHHO .GT. 0) THEN
  175. c-dbg      IF (MSQHHO .GT. 0) THEN
  176.         IF ( OOOVP1(MSQHHO) .AND. OOOVP1(MCEHHO) .AND.
  177.      &       OOOVP1(MPFHHO) .AND. OOOVP1(MPCHHO) ) THEN
  178. c-dbg          write(6,*) 'MENAG4 - HHO -> OK Pointeurs Maillages conserves'
  179.         ELSE
  180.           write(6,*) 'MENAG4 - HHO -> PB Pointeurs Maillages detruits'
  181.         END IF
  182.       END IF
  183. C==FIN= FORMULATION HHO ================================================
  184.  
  185. c      RETURN
  186.       END
  187.  
  188.  
  189.  

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