Sources Esope | Cast3M

cqf2ln
C CQF2LN    SOURCE    CHAT      05/01/12    22:27:26     5004
      SUBROUTINE CQF2LN(MELEME,MLINE)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C************************************************************************
C Ce sp transforme des éléments QUAF pris
C dans la liste ci-dessous
C SEG3 TRI7 QUA9 CU27 PR21 TE15 PY19
C  3    7    11   33   34   35   36
C
C en les éléments linéaires construits à parir des sommets
C
C SEG2 TRI3 QUA4 CUB8 PRI6 TET4 PYR5
C  2    4    8    14   16   23   25
C************************************************************************
-INC SMELEME
      POINTEUR MLINE.MELEME
 
      SEGACT MELEME
      NBSOU1=LISOUS(/1)
      IF(NBSOU1.EQ.0)NBSOU1=1
 
C     write(6,*)'CQF2MC il y a a faire '
 
      NBSOUS=NBSOU1
      NBNN=0
      NBELEM=0
      NBREF=0
      SEGINI MLINE
      DO 200 L=1,NBSOU1
      IPT1=MELEME
      IF(NBSOU1.NE.1)IPT1=LISOUS(L)
      SEGACT IPT1
      ITYP=IPT1.ITYPEL
      NBNN0=IPT1.NUM(/1)
      NBELEM=IPT1.NUM(/2)
      MLINE.LISOUS(L)=IPT1
 
      IF(ITYP.EQ.3)THEN
C SEG3 -> SEG2
      NBNN=2
      NBSOUS=0
      NBREF=0
      SEGINI IPT2
      MLINE.LISOUS(L)=IPT2
      IPT2.ITYPEL=2
      DO 202 K=1,NBELEM
      IPT2.NUM(1,K)=IPT1.NUM(1,K)
      IPT2.NUM(2,K)=IPT1.NUM(3,K)
 202  CONTINUE
 
      ELSEIF(ITYP.EQ.7)THEN
C TRI7 -> TRI3
      NBNN=3
      NBSOUS=0
      NBREF=0
      SEGINI IPT2
      MLINE.LISOUS(L)=IPT2
      IPT2.ITYPEL=4
      DO 204 K=1,NBELEM
      I1=0
      DO 204 I=1,6,2
      I1=I1+1
      IPT2.NUM(I1,K)=IPT1.NUM(I,K)
 204  CONTINUE
 
      ELSEIF(ITYP.EQ.11)THEN
C QUA9 -> QUA4
      NBNN=4
      NBSOUS=0
      NBREF=0
      SEGINI IPT2
      MLINE.LISOUS(L)=IPT2
      IPT2.ITYPEL=8
      DO 208 K=1,NBELEM
      I1=0
      DO 208 I=1,8,2
      I1=I1+1
      IPT2.NUM(I1,K)=IPT1.NUM(I,K)
 208  CONTINUE
 
      ELSEIF(ITYP.EQ.33)THEN
C CU27 -> CUB8
      NBNN=8
      NBSOUS=0
      NBREF=0
      SEGINI IPT2
      MLINE.LISOUS(L)=IPT2
      IPT2.ITYPEL=14
      DO 214 K=1,NBELEM
      I1=0
      DO 214 I=1,8,2
      I1=I1+1
      IPT2.NUM(I1,K)=IPT1.NUM(I,K)
      IPT2.NUM(I1+4,K)=IPT1.NUM(I+12,K)
 214  CONTINUE
 
      ELSEIF(ITYP.EQ.34)THEN
C PR21 -> PRI6
      NBNN=6
      NBSOUS=0
      NBREF=0
      SEGINI IPT2
      MLINE.LISOUS(L)=IPT2
      IPT2.ITYPEL=16
      DO 216 K=1,NBELEM
      I1=0
      DO 216 I=1,6,2
      I1=I1+1
      IPT2.NUM(I1,K)=IPT1.NUM(I,K)
      IPT2.NUM(I1+3,K)=IPT1.NUM(I+9,K)
 216  CONTINUE
 
      ELSEIF(ITYP.EQ.35)THEN
C TE15 -> TET4
      NBNN=4
      NBSOUS=0
      NBREF=0
      SEGINI IPT2
      MLINE.LISOUS(L)=IPT2
      IPT2.ITYPEL=23
      DO 2230 K=1,NBELEM
      I1=0
      DO 223 I=1,6,2
      I1=I1+1
      IPT2.NUM(I1,K)=IPT1.NUM(I,K)
 223  CONTINUE
      IPT2.NUM(4,K)=IPT1.NUM(10,K)
 2230 CONTINUE
 
      ELSEIF(ITYP.EQ.36)THEN
C PY19 -> PYR5
      NBNN=5
      NBSOUS=0
      NBREF=0
      SEGINI IPT2
      MLINE.LISOUS(L)=IPT2
      IPT2.ITYPEL=25
      DO 2250 K=1,NBELEM
      I1=0
      DO 225 I=1,8,2
      I1=I1+1
      IPT2.NUM(I1,K)=IPT1.NUM(I,K)
 225  CONTINUE
      IPT2.NUM(5,K)=IPT1.NUM(13,K)
 2250 CONTINUE
 
 
      ENDIF
 
 200  CONTINUE
 
      IF(NBSOU1.EQ.1)THEN
      IPT3=MLINE
      MLINE=MLINE.LISOUS(1)
      SEGSUP IPT3
      ENDIF
 
      RETURN
 1001 FORMAT(20(1X,I5))
 1002 FORMAT(10(1X,1PE11.4))
      END