Esope source files

   1 : C CQF2LN    SOURCE    CHAT      05/01/12    22:27:26     5004           
   2 :       SUBROUTINE CQF2LN(MELEME,MLINE)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : C************************************************************************
   6 : C Ce sp transforme des éléments QUAF pris
   7 : C dans la liste ci-dessous
   8 : C SEG3 TRI7 QUA9 CU27 PR21 TE15 PY19
   9 : C  3    7    11   33   34   35   36
  10 : C
  11 : C en les éléments linéaires construits à parir des sommets
  12 : C
  13 : C SEG2 TRI3 QUA4 CUB8 PRI6 TET4 PYR5
  14 : C  2    4    8    14   16   23   25
  15 : C************************************************************************
  16 : -INC SMELEME
  17 :       POINTEUR MLINE.MELEME
  18 : 
  19 :       SEGACT MELEME
  20 :       NBSOU1=LISOUS(/1)
  21 :       IF(NBSOU1.EQ.0)NBSOU1=1
  22 : 
  23 : C     write(6,*)'CQF2MC il y a a faire '
  24 : 
  25 :       NBSOUS=NBSOU1
  26 :       NBNN=0
  27 :       NBELEM=0
  28 :       NBREF=0
  29 :       SEGINI MLINE
  30 :       DO 200 L=1,NBSOU1
  31 :       IPT1=MELEME
  32 :       IF(NBSOU1.NE.1)IPT1=LISOUS(L)
  33 :       SEGACT IPT1
  34 :       ITYP=IPT1.ITYPEL
  35 :       NBNN0=IPT1.NUM(/1)
  36 :       NBELEM=IPT1.NUM(/2)
  37 :       MLINE.LISOUS(L)=IPT1
  38 : 
  39 :       IF(ITYP.EQ.3)THEN
  40 : C SEG3 -> SEG2
  41 :       NBNN=2
  42 :       NBSOUS=0
  43 :       NBREF=0
  44 :       SEGINI IPT2
  45 :       MLINE.LISOUS(L)=IPT2
  46 :       IPT2.ITYPEL=2
  47 :       DO 202 K=1,NBELEM
  48 :       IPT2.NUM(1,K)=IPT1.NUM(1,K)
  49 :       IPT2.NUM(2,K)=IPT1.NUM(3,K)
  50 :  202  CONTINUE
  51 : 
  52 :       ELSEIF(ITYP.EQ.7)THEN
  53 : C TRI7 -> TRI3
  54 :       NBNN=3
  55 :       NBSOUS=0
  56 :       NBREF=0
  57 :       SEGINI IPT2
  58 :       MLINE.LISOUS(L)=IPT2
  59 :       IPT2.ITYPEL=4
  60 :       DO 204 K=1,NBELEM
  61 :       I1=0
  62 :       DO 204 I=1,6,2
  63 :       I1=I1+1
  64 :       IPT2.NUM(I1,K)=IPT1.NUM(I,K)
  65 :  204  CONTINUE
  66 : 
  67 :       ELSEIF(ITYP.EQ.11)THEN
  68 : C QUA9 -> QUA4
  69 :       NBNN=4
  70 :       NBSOUS=0
  71 :       NBREF=0
  72 :       SEGINI IPT2
  73 :       MLINE.LISOUS(L)=IPT2
  74 :       IPT2.ITYPEL=8
  75 :       DO 208 K=1,NBELEM
  76 :       I1=0
  77 :       DO 208 I=1,8,2
  78 :       I1=I1+1
  79 :       IPT2.NUM(I1,K)=IPT1.NUM(I,K)
  80 :  208  CONTINUE
  81 : 
  82 :       ELSEIF(ITYP.EQ.33)THEN
  83 : C CU27 -> CUB8
  84 :       NBNN=8
  85 :       NBSOUS=0
  86 :       NBREF=0
  87 :       SEGINI IPT2
  88 :       MLINE.LISOUS(L)=IPT2
  89 :       IPT2.ITYPEL=14
  90 :       DO 214 K=1,NBELEM
  91 :       I1=0
  92 :       DO 214 I=1,8,2
  93 :       I1=I1+1
  94 :       IPT2.NUM(I1,K)=IPT1.NUM(I,K)
  95 :       IPT2.NUM(I1+4,K)=IPT1.NUM(I+12,K)
  96 :  214  CONTINUE
  97 : 
  98 :       ELSEIF(ITYP.EQ.34)THEN
  99 : C PR21 -> PRI6
 100 :       NBNN=6
 101 :       NBSOUS=0
 102 :       NBREF=0
 103 :       SEGINI IPT2
 104 :       MLINE.LISOUS(L)=IPT2
 105 :       IPT2.ITYPEL=16
 106 :       DO 216 K=1,NBELEM
 107 :       I1=0
 108 :       DO 216 I=1,6,2
 109 :       I1=I1+1
 110 :       IPT2.NUM(I1,K)=IPT1.NUM(I,K)
 111 :       IPT2.NUM(I1+3,K)=IPT1.NUM(I+9,K)
 112 :  216  CONTINUE
 113 : 
 114 :       ELSEIF(ITYP.EQ.35)THEN
 115 : C TE15 -> TET4
 116 :       NBNN=4
 117 :       NBSOUS=0
 118 :       NBREF=0
 119 :       SEGINI IPT2
 120 :       MLINE.LISOUS(L)=IPT2
 121 :       IPT2.ITYPEL=23
 122 :       DO 2230 K=1,NBELEM
 123 :       I1=0
 124 :       DO 223 I=1,6,2
 125 :       I1=I1+1
 126 :       IPT2.NUM(I1,K)=IPT1.NUM(I,K)
 127 :  223  CONTINUE
 128 :       IPT2.NUM(4,K)=IPT1.NUM(10,K)
 129 :  2230 CONTINUE
 130 : 
 131 :       ELSEIF(ITYP.EQ.36)THEN
 132 : C PY19 -> PYR5
 133 :       NBNN=5
 134 :       NBSOUS=0
 135 :       NBREF=0
 136 :       SEGINI IPT2
 137 :       MLINE.LISOUS(L)=IPT2
 138 :       IPT2.ITYPEL=25
 139 :       DO 2250 K=1,NBELEM
 140 :       I1=0
 141 :       DO 225 I=1,8,2
 142 :       I1=I1+1
 143 :       IPT2.NUM(I1,K)=IPT1.NUM(I,K)
 144 :  225  CONTINUE
 145 :       IPT2.NUM(5,K)=IPT1.NUM(13,K)
 146 :  2250 CONTINUE
 147 : 
 148 : 
 149 :       ENDIF
 150 : 
 151 :  200  CONTINUE
 152 : 
 153 :       IF(NBSOU1.EQ.1)THEN
 154 :       IPT3=MLINE
 155 :       MLINE=MLINE.LISOUS(1)
 156 :       SEGSUP IPT3
 157 :       ENDIF
 158 : 
 159 :       RETURN
 160 :  1001 FORMAT(20(1X,I5))
 161 :  1002 FORMAT(10(1X,1PE11.4))
 162 :       END
 163 :  
 164 :  
 165 :  
 166 :