Esope source files

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