Télécharger la plaquette Cast3M


fr en

Télécharger redumo.eso

Retour à la liste

Numérotation des lignes : 

redumo

  1. C REDUMO    SOURCE    OF166741  24/05/06    21:15:24     11082          
  2.  
  3.       SUBROUTINE REDUMO (IPMODL,IMEL, IRET)
  4.  
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8(A-H,O-Z)
  7. *______________________________________________________________________
  8. *
  9. *             REDU D'UN MODELE SUR MELEME    (APPELE PAR REDU)
  10. *
  11. *    ENTREES :
  12. *    ---------
  13. *       IPMODL  MODELE A REDUIRE (TYPE MMODEL)
  14. *       IMEL    MAILLAGE SUR LEQUEL ON DOIT REDUIRE (TYPE MELEME)
  15. *
  16. *    SORTIE :
  17. *    --------
  18. *       IRET    MODELE REDUIT
  19. *               = 0 SI PB
  20. *
  21. *    REMARQUE : ON SE LIMITE A NE POUVOIR REDUIRE UN MODELE QUE SUR
  22. *    ---------- UN MAILLAGE POUR LEQUEL TOUS SES ELEMENTS "ADHERENT"
  23. *               AU MODELE ET DE PLUS IL FAUT QU'A CHAQUE SOUS ZONE
  24. *               DU MAILLAGE IMEL CORRESPONDE UNE SOUS ZONE DANS LE
  25. *               MODELE (IE UNE SOUS ZONE DU MAILLAGE IMEL NE PEUT
  26. *               ETRE "A CHEVAL" SUR PLUSIEURS SOUS ZONES DU MODELE)
  27. *
  28. *               limitation levee par degay
  29. *               si le maillage est a cheval sur plusieurs sous zones
  30. *               on le tronconne en autant de morceaux
  31. *
  32. *       PASSAGE AUX NOUVEAUX MCHAMLS PAR JM CAMPENON LE 05 11 90
  33. *
  34. *______________________________________________________________________
  35. *
  36.  
  37. -INC PPARAM
  38. -INC CCOPTIO
  39. C==DEB= FORMULATION HHO == INCLUDE =====================================
  40. -INC CCHHOPA
  41. C==FIN= FORMULATION HHO ================================================
  42. *
  43. -INC SMCOORD
  44. -INC SMELEME
  45. -INC SMMODEL
  46. *
  47.       SEGMENT ICPR(NPT)
  48.       SEGMENT ICOM(NBEL)
  49.       SEGMENT  ITRA1
  50.          INTEGER ICC (IA+1)
  51.       ENDSEGMENT
  52.       segment itra2
  53.          INTEGER IRE(ima)
  54.       ENDSEGMENT
  55.       LOGICAL INIT,DEJA
  56. *
  57.       IRET=0
  58. *
  59.       DEJA = .FALSE.
  60.  
  61.  
  62. * on duplique le maillage pour pouvoir le modifier si besoin est
  63.       IPT1 = IMEL
  64.       SEGACT,IPT1
  65.       NBSOU1 = IPT1.LISOUS(/1)
  66.  
  67.       NBELEM = 1
  68.       IF (NBSOU1 .EQ. 0) THEN
  69. *       Un MAILLAGE VIDE normalement constitue a un NBSOUS = 0
  70.         NBELEM=IPT1.NUM(/2)
  71.       ENDIF
  72.  
  73. * CB215821 : Reduire un MMODEL sur un MAILLAGE VIDE ==> MMODEL VIDE
  74.       IF (NBELEM .EQ. 0) THEN
  75.         N1 = 0
  76.         SEGINI,MMODE1
  77.         SEGACT,MMODE1*NOMOD,IPT1*NOMOD
  78.         IRET = MMODE1
  79.         RETURN
  80.       ENDIF
  81.       NBELEM = 0
  82.  
  83. *
  84.       MMODEL = IPMODL
  85.       SEGACT MMODEL
  86.       SEGINI,MMODE1=MMODEL
  87.       NSOUS=KMODEL(/1)
  88. * CB215821 : Reduire un MMODEL VIDE sur un MAILLAGE ==> MMODEL VIDE
  89.       IF (NSOUS .EQ. 0) THEN
  90.         SEGACT,MMODE1*NOMOD,IPT1*NOMOD
  91.         IRET = MMODE1
  92.         RETURN
  93.       ENDIF
  94.  
  95. *
  96. *  FABRICATION DE ICPR QUI DIRA SI UN POINT DU MODELE EST TOUCHE PAR
  97. *  LE MAILLAGE IMEL ET SUR COMBIEN D'ELEMENTS ON VA TRAVAILLER PAR TYPE
  98. *  D'ELEMENTS
  99. *
  100.       NPT = nbpts
  101.       ICPR = 0
  102. *
  103.  
  104.  
  105.       MELEME = IPT1
  106. *
  107. *     BOUCLE CONDITIONNNELLE SUR LES SOUS ZONES DU MAILLAGE IMEL
  108. *
  109.       IBOU1 = 0
  110.       NS01  = 0
  111. *
  112.    1  CONTINUE
  113.          IBOU1 = IBOU1 + 1
  114.          IF (NBSOU1.NE.0) THEN
  115.             MELEME = IPT1.LISOUS(IBOU1)
  116.          ENDIF
  117.          SEGACT MELEME
  118. *
  119. *        NNNT :NB D'ELEMENTS DE IMEL POUR LA SOUS ZONE CONSIDEREE
  120.          NNNT=NUM(/2)
  121. *
  122. * Creation ou remise a zero du segment ICPR
  123.         IF (ICPR.EQ.0) THEN
  124.           SEGINI,ICPR
  125.         ELSE
  126.           DO i = 1, NPT
  127.             ICPR(i) = 0
  128.           ENDDO
  129.         ENDIF
  130. *
  131. *    CREATION D'UNE NUMEROTATION LOCALE
  132. *
  133.          IA=0
  134.          DO J=1,NNNT
  135.             DO K=1,NUM(/1)
  136.                ID=NUM(K,J)
  137.                IF (ICPR(ID).EQ.0) THEN
  138.                   IA=IA+1
  139.                   ICPR(ID)=IA
  140.                ENDIF
  141.             ENDDO
  142.          ENDDO
  143. *
  144. *        FABRICATION DE ITRA1 puis 2 :
  145. *              ICC DONNE LE NOMBRE D'ELEMENTS touchant le i eme noeud local
  146. *
  147.          SEGINI ITRA1
  148.          DO J=1,NNNT
  149.             DO K=1,NUM(/1)
  150.                ID=ICPR(NUM(K,J))
  151.                ICC(ID)=ICC(ID)+1
  152.             ENDDO
  153.          ENDDO
  154. *
  155. * fabrication de ire stocker les elements touchant le noeud i
  156. *
  157.          igt=icc(1)
  158.          DO j=2,ia
  159.            if( igt.lt.icc(j) ) igt = icc(j)
  160.            icc(j)=icc(j)+icc(j-1)
  161.          ENDDO
  162.          ima = icc(ia)
  163.          icc(ia+1) = ima
  164. *         write(6,*) 'taille de ire ', ima, ia,igt
  165.          segini itra2
  166.          DO j=1,NNNT
  167.             DO k=1,num(/1)
  168.                id=icpr(num(k,j))
  169.                ie = icc(id)
  170.                icc(id)=icc(id)-1
  171.                ire(ie)= j
  172.             ENDDO
  173.          ENDDO
  174. *
  175. *        IL FAUT MAINTENANT REGARDER SI DANS UNE SOUS ZONE IMODEL IL
  176. *        EXISTE LES ELEMENTS DE LA SOUS ZONE DU MELEME IMEL
  177. *        BOUCLE SUR LES SOUS ZONES DU MODELE
  178. *
  179.          IFLAG=0
  180.          IMOD1=0
  181.          DO I=1,KMODEL(/1)
  182.             SEGACT MELEME
  183. *            write(6,*) ' boucle 10 ibou1 i', ibou1, i
  184.             IMODEL=KMODEL(I)
  185.             SEGACT IMODEL
  186.             IPT2=IMAMOD
  187.             SEGACT IPT2
  188. *
  189.             IF(ITYPEL.NE.IPT2.ITYPEL) GO TO 11
  190. *
  191.             INIT=.FALSE.
  192.  
  193.             NBEL = NUM(/2)
  194.             SEGINI ICOM
  195. *
  196.             ICO=0
  197.             NBEL2=IPT2.NUM(/1)
  198.             DO K=1,IPT2.NUM(/2)
  199.                DO L=1,NBEL2
  200.                   ID=IPT2.NUM(L,K)
  201.                   IDD = ICPR(ID)
  202.                   IF(IDD.EQ.0) GO TO 12
  203.                ENDDO
  204. *
  205.                ID =IPT2.NUM(1,K)
  206.                IDD=ICPR(ID)
  207.                IDE=ICC(IDD)+1
  208. *
  209. *              OK L'ELEMENT K POSSEDE SES NOEUDS DANS IMEL
  210. *
  211.                IF(ITYPEL.EQ.1) THEN
  212.                   IRE1=IRE(ide)
  213.                   GOTO 20
  214.                ENDIF
  215. *
  216. *              CES NOEUDS CORRESPONDENT-T-ILS A UN MEME ELEMENT IRE1
  217. *
  218.                IDF=ICC(IDD+1)
  219.                DO L=IDE,IDF
  220.                   IRE1=IRE(L)
  221.                   DO M=2,NBEL2
  222.                      IDD2=ICPR(IPT2.NUM(M,K))
  223.                      IF(IDD2.EQ.0) GO TO 12
  224.                      IDE2=ICC(IDD2)+1
  225.                      IDF2=ICC(IDD2+1)
  226.                      DO 16 N=IDE2,IDF2
  227.                         IF(IRE(N).EQ.IRE1) GO TO 15
  228.    16                CONTINUE
  229.                      GO TO 14
  230.    15                CONTINUE
  231.                   ENDDO
  232. *
  233. *                 ON A TROUVE UN ELEMENT COMMUN AUX 2 MAILLAGES
  234. *
  235.                   GOTO 20
  236.    14             CONTINUE
  237.                ENDDO
  238. *
  239.                GOTO 12
  240. *
  241.    20          CONTINUE
  242.                IF (.NOT.INIT) INIT=.TRUE.
  243.                IFLAG=1
  244.                ICOM(IRE1)=1
  245.                ICO=ICO+1
  246.    12          CONTINUE
  247.             ENDDO
  248. *
  249.             IF (INIT) THEN
  250. *
  251. *              LE NB D'ELEMENTS EST-IL EGAL POUR LA SOUS ZONE IMEL ET
  252. *              LA SOUS ZONE DU MODELE
  253. *
  254. *               print *, 'element en commun' ,'ico=',ico,'nnnt=',nnnt
  255.                IF (ICO.EQ.NNNT) THEN
  256.                   NS01=NS01+1
  257.                   IF (NS01.GT.MMODE1.KMODEL(/1)) THEN
  258. **                    CALL ERREUR(845)
  259.                     write(ioimp,*) 'Elements du maillage en double ?'
  260.                     MOTERR(1:8)='MAILLAGE'
  261.                     MOTERR(9:16)='MODELE'
  262.                     CALL ERREUR(135)
  263.                     SEGACT,IPT1*NOMOD
  264.                     SEGSUP MMODE1
  265.                     GOTO 901
  266.                   ENDIF
  267.                   IMOD1=IMOD1+1
  268.                   SEGINI,IMODE1=IMODEL
  269. C    Dans le cas DARCY on ignore la table de préconditionnement afin de
  270. C    pouvoir la recalculer correctement par la suite
  271.          NFOR=IMODE1.FORMOD(/2)
  272.          CALL PLACE (IMODE1.FORMOD,NFOR,IDARC,'DARCY')
  273.          CALL PLACE (IMODE1.FORMOD,NFOR,IEULE,'EULER')
  274.          CALL PLACE (IMODE1.FORMOD,NFOR,INAVI,'NAVIER_STOKES')
  275.          IF((IDARC.NE.0).OR.(INAVI.NE.0).OR.(IEULE.NE.0))
  276.      &    IMODE1.INFMOD(2)=0
  277.                   MMODE1.KMODEL(NS01)=IMODE1
  278.                   IMODE1.IMAMOD=MELEME
  279. C* Cas particulier : Elements type XFEM
  280.                   IF (NUMMFR(IMODE1.NEFMOD).EQ.63)
  281.      &              CALL PARTXR(IMODEL,0,IMODE1)
  282. C==DEB= FORMULATION HHO == Cas particulier HHO =========================
  283.                   IF (IMODE1.NEFMOD.EQ.HHO_NUM_ELEMENT) THEN
  284.                     CALL HHOPAR(IMODE1,iret)
  285.                     if (iret.ne.0) return
  286.                   END IF
  287. C==FIN= FORMULATION HHO ================================================
  288. *        write(6,*) ' meleme imamod ' , meleme
  289. *
  290.                   SEGACT,IMODE1*NOMOD
  291.                ELSE
  292. *
  293. *           IL FAUT SCINDER LE SOUS MAILAGE EN DEUX
  294. *
  295. *       creation des deux maillages dont l'union est le maillage meleme
  296.                   NBNN = NUM(/1)
  297.                   NBELEM = ICO
  298.                   NBREF = 0
  299.                   NBSOUS = 0
  300.                   SEGINI IPT3
  301.                   NBELEM = NUM(/2) - ICO
  302.                   SEGINI IPT4
  303.                   IPT3.ITYPEL = ITYPEL
  304.                   IPT4.ITYPEL = ITYPEL
  305.                   I3 = 0
  306.                   I4 = 0
  307.                   DO 25 II=1,NUM(/2)
  308.                     IF (ICOM(II) .EQ. 1) THEN
  309. *                    l'element est commun aux deux maillages
  310.                      I3=I3+1
  311.                      IPT3.ICOLOR(I3)=ICOLOR(II)
  312.                      DO 23 JJ=1,NUM(/1)
  313.                         IPT3.NUM(JJ,I3)=NUM(JJ,II)
  314.    23                CONTINUE
  315.                     ELSE
  316. *                    l'element appartient seulement a meleme
  317.                      I4=I4+1
  318.                      IPT4.ICOLOR(I4)=ICOLOR(II)
  319.                      DO 24 JJ=1,NUM(/1)
  320.                         IPT4.NUM(JJ,I4)=NUM(JJ,II)
  321.    24                CONTINUE
  322.                     ENDIF
  323.    25            CONTINUE
  324. *
  325. *        modification de ipt1
  326. *
  327.                  NBREF =0
  328.                  NBELEM=0
  329.                  NBNN  =0
  330.                  IF (IPT1.LISOUS(/1) .EQ. 0) THEN
  331.                      NBSOUS=2
  332.                      SEGINI IPT5
  333.                      IPT5.LISOUS(1)=IPT3
  334.                      IPT5.LISOUS(2)=IPT4
  335.                      SEGACT,IPT1*NOMOD
  336.                      IPT1=IPT5
  337.                  ELSE
  338.                      IF (.NOT. DEJA) THEN
  339.                        SEGINI,IPT5=IPT1
  340.                        SEGACT,IPT1*NOMOD
  341.                        IPT1 = IPT5
  342.                      ENDIF
  343.                      NBSOUS=IPT1.LISOUS(/1)+1
  344.                      SEGADJ IPT1
  345.                      IPT1.LISOUS(IBOU1)=IPT3
  346.                      IPT1.LISOUS(NBSOUS)=IPT4
  347.                      SEGACT,MELEME*NOMOD
  348.                  ENDIF
  349.                  IBOU1=IBOU1-1
  350.                  NBSOU1=NBSOUS
  351.                  NS01=NS01-IMOD1
  352.                  SEGACT,IMODEL*NOMOD
  353.                  SEGSUP ICOM,ITRA1,ITRA2
  354.                  GOTO 1
  355. *
  356.                ENDIF
  357.             ENDIF
  358.             SEGSUP ICOM
  359.    11       CONTINUE
  360.             SEGACT,IMODEL*NOMOD
  361.          ENDDO
  362. *
  363.          SEGSUP,ITRA1,ITRA2
  364. C         SEGDES,MELEME,IPT2
  365.  
  366.          IF (IFLAG.EQ.0) THEN
  367. *
  368. *           ON N'A PAS TROUVE DE SOUS ZONE DANS LE MODELE QUI COR-
  369. *           RESPONDENT A UNE SOUS ZONE DE IMEL
  370. *
  371. *pv         MOTERR(1:8)='MAILLAGE'
  372. *pv         MOTERR(9:16)='MODELE'
  373. *pv         CALL ERREUR(135)
  374. *pv         SEGACT,IPT1*NOMOD
  375. *pv         SEGSUP MMODE1
  376. *pv         GOTO 901
  377.          ENDIF
  378. *
  379. *     FIN DE LA BOUCLE SUR LES SOUS ZONES DU MAILLAGE
  380. *
  381. **      print *, 'nbsou1=' , 'ibou1=' ,ibou1
  382.       IF (IBOU1 .LT. NBSOU1 ) GOTO 1
  383. *
  384.       SEGACT,IPT1*NOMOD
  385. **      print *,NS01,NSOUS
  386.       IF(NS01.NE.NSOUS) THEN
  387.          N1=NS01
  388.          SEGADJ,MMODE1
  389.       ENDIF
  390.       IRET=MMODE1
  391.       SEGACT,MMODE1*NOMOD
  392.  901  CONTINUE
  393.       SEGACT,MMODEL*NOMOD
  394. C- Un peu de menage
  395.       IF (ICPR.GT.0) SEGSUP,ICPR
  396.  
  397.       END
  398.  
  399.  
  400.  

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