Sources Esope | Cast3M

chanl2
C CHANL2    SOURCE    GOUNAND   24/10/08    21:15:02     12025          
      SUBROUTINE CHANL2(IPT1,IPT2)
*
*  ce sub fait passer tous les elemnts quadratique en lineaire,
*  il conserve le nombre d'elements
*  modif SG 01/2014 : passage des QUAFs aux linéaires
 
      IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCOPTIO
-INC SMELEME
      logical ltelq
      SEGMENT INOO
      INTEGER INOU(NA)
      ENDSEGMENT
 
      CALL ACTOBJ('MAILLAGE',IPT1,1)
      MELEME=IPT1
      NBNN= NUM(/1)
      NBELEM=NUM(/2)
      NBSOUS=LISOUS(/1)
      NBREF=0
      NA= MAX(NBSOUS,1)
      SEGINI INOO
      DO 100 I=1,MAX(IPT1.LISOUS(/1),1)
         IF( IPT1.LISOUS(/1).NE.0) THEN
            MELEME=IPT1.LISOUS(I)
         ENDIF
         NBELEM=NUM(/2)
         NBSOUS=0
         NBREF=0
         IF( ITYPEL.EQ.3)THEN
*  cas des seg3 ---> seg2
            NBNN=2
            SEGINI IPT2
            IPT2.ITYPEL=2
            INOU(I) = IPT2
            DO 1 K=1,NBELEM
               IPT2.NUM(1,K)=NUM(1,K)
               IPT2.NUM(2,K)=NUM(3,K)
               IPT2.ICOLOR(K)=ICOLOR(K)
 1          CONTINUE
         ELSEIF( ITYPEL.EQ.6. OR. ITYPEL.EQ.7) THEN
*   cas des tri6,tri7 ---> tri3
            NBNN=3
            SEGINI IPT2
            IPT2.ITYPEL=4
            INOU(I) = IPT2
            DO 2 K=1,NBELEM
               IPT2.NUM(1,K)=NUM(1,K)
               IPT2.NUM(2,K)=NUM(3,K)
               IPT2.NUM(3,K)=NUM(5,K)
               IPT2.ICOLOR(K)=ICOLOR(K)
 2          CONTINUE
         ELSEIF( ITYPEL.EQ.10 . OR. ITYPEL.EQ.11) THEN
* cas des qua8,qua9-----> qua4
            NBNN=4
            SEGINI IPT2
            IPT2.ITYPEL=8
            INOU(I) = IPT2
            DO 3 K=1,NBELEM
               IPT2.NUM(1,K)=NUM(1,K)
               IPT2.NUM(2,K)=NUM(3,K)
               IPT2.NUM(3,K)=NUM(5,K)
               IPT2.NUM(4,K)=NUM(7,K)
               IPT2.ICOLOR(K)=ICOLOR(K)
 3          CONTINUE
         ELSEIF( ITYPEL.EQ.13) THEN
*4 cas des rac3 ---> rac2
            NBNN=4
            SEGINI IPT2
            IPT2.ITYPEL=12
            INOU(I) = IPT2
            DO 4 K=1,NBELEM
               IPT2.NUM(1,K)=NUM(1,K)
               IPT2.NUM(2,K)=NUM(3,K)
               IPT2.NUM(3,K)=NUM(4,K)
               IPT2.NUM(4,K)=NUM(6,K)
               IPT2.ICOLOR(K)=ICOLOR(K)
 4          CONTINUE
         ELSEIF( ITYPEL.EQ.15.OR.ITYPEL.EQ.33) THEN
*5 cas des  cu20, cu27 ---> cub8
            NBNN=8
            SEGINI IPT2
            IPT2.ITYPEL=14
            INOU(I) = IPT2
            DO 5 K=1,NBELEM
               IPT2.NUM(1,K)=NUM(1,K)
               IPT2.NUM(2,K)=NUM(3,K)
               IPT2.NUM(3,K)=NUM(5,K)
               IPT2.NUM(4,K)=NUM(7,K)
               IPT2.NUM(5,K)=NUM(13,K)
               IPT2.NUM(6,K)=NUM(15,K)
               IPT2.NUM(7,K)=NUM(17,K)
               IPT2.NUM(8,K)=NUM(19,K)
               IPT2.ICOLOR(K)=ICOLOR(K)
 5          CONTINUE
         ELSEIF( ITYPEL.EQ.17.OR.ITYPEL.EQ.34) THEN
*6 cas des  pr15, pr21 ---> pri6
            NBNN=6
            SEGINI IPT2
            IPT2.ITYPEL=16
            INOU(I) = IPT2
            DO 6 K=1,NBELEM
               IPT2.NUM(1,K)=NUM(1,K)
               IPT2.NUM(2,K)=NUM(3,K)
               IPT2.NUM(3,K)=NUM(5,K)
               IPT2.NUM(4,K)=NUM(10,K)
               IPT2.NUM(5,K)=NUM(12,K)
               IPT2.NUM(6,K)=NUM(14,K)
               IPT2.ICOLOR(K)=ICOLOR(K)
 6          CONTINUE
         ELSEIF( ITYPEL.EQ.20. OR. itypel.eq.21) THEN
*7 cas des  lia6,lia8 ---> lia3,lia4
            NBNN=6
            IF(ITYPEL.EQ.21) NBNN=8
            SEGINI IPT2
            IPT2.ITYPEL=18
            IF(ITYPEL.EQ.21)IPT2.ITYPEL=19
            INOU(I) = IPT2
            DO 7 K=1,NBELEM
               IPT2.NUM(1,K)=NUM(1,K)
               IPT2.NUM(2,K)=NUM(3,K)
               IPT2.NUM(3,K)=NUM(5,K)
               IPT2.NUM(4,K)=NUM(7,K)
               IPT2.NUM(5,K)=NUM(9,K)
               IPT2.NUM(6,K)=NUM(11,K)
               IPT2.ICOLOR(K)=ICOLOR(K)
               IF( ITYPEL.EQ.21) THEN
                  IPT2.NUM(7,K)=NUM(13,K)
                  IPT2.NUM(8,K)=NUM(15,K)
               ENDIF
 7          CONTINUE
            SEGDES IPT2
         ELSEIF( ITYPEL.EQ.24.OR.ITYPEL.EQ.35) THEN
*8 cas des  te10, te15 ---> te4
            NBNN=4
            SEGINI IPT2
            IPT2.ITYPEL=23
            INOU(I) = IPT2
            DO 8 K=1,NBELEM
               IPT2.NUM(1,K)=NUM(1,K)
               IPT2.NUM(2,K)=NUM(3,K)
               IPT2.NUM(3,K)=NUM(5,K)
               IPT2.NUM(4,K)=NUM(10,K)
               IPT2.ICOLOR(K)=ICOLOR(K)
 8          CONTINUE
            SEGDES IPT2
         ELSEIF( ITYPEL.EQ.26.OR.ITYPEL.EQ.36) THEN
*9 cas des  py13, py19 ---> pyr5
            NBNN=5
            SEGINI IPT2
            IPT2.ITYPEL=25
            INOU(I) = IPT2
            DO 9 K=1,NBELEM
               IPT2.NUM(1,K)=NUM(1,K)
               IPT2.NUM(2,K)=NUM(3,K)
               IPT2.NUM(3,K)=NUM(5,K)
               IPT2.NUM(4,K)=NUM(7,K)
               IPT2.NUM(5,K)=NUM(13,K)
               IPT2.ICOLOR(K)=ICOLOR(K)
 9          CONTINUE
         ELSE
*tous les autres elements : on engrange
            INOU(I) = MELEME
         ENDIF
 100  CONTINUE
* on fusionne les sous parties
      II=INOU(/1)
      IRETOU=INOU(1)
      IF(II.EQ.1) GO TO 15
      DO 16 J=2,II
         INN=INOU(J)
         ltelq=.false.
         CALL FUSE( IRETOU,INN,IPT5,ltelq)
         IRETOU=IPT5
 16   CONTINUE
 15   CONTINUE
      IPT2=IRETOU
      CALL ACTOBJ('MAILLAGE',IPT2,1)
      RETURN
      END