Esope source files

   1 : C ELKONV    SOURCE    CHAT      05/01/12    23:33:25     5004           
   2 :       SUBROUTINE ELKONV(ELTFA,FACEL,MELEMF,MELEMC,MELEME)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : 
   6 : -INC SMLENTI
   7 : -INC SMELEME
   8 :       POINTEUR ELTFA.MELEME,FACEL.MELEME,MELEMC.MELEME
   9 :       DIMENSION NTYP(7)
  10 : C               SEG2,TRI3,QUA4,TET4,PYR5,PRI6,CUB8
  11 :       DATA NTYP/3   ,8   ,9   ,25  ,16  ,7   ,11  /
  12 : C               SEG3,QUA4,QUA5,PYR5,PRI6,TRI7,QUA9
  13 : 
  14 : 
  15 : 
  15 :       CALL KRIPAD(MELEMF,MLENTI)
  16 :       SEGACT ELTFA,FACEL,MELEMC
  17 :       NBSOUS=ELTFA.LISOUS(/1)
  18 : 
  19 :       IF(NBSOUS.EQ.0)THEN
  20 :       NBNN=ELTFA.NUM(/1)+1
  21 :       NBELEM=ELTFA.NUM(/2)
  22 :       NBREF=0
  23 :       SEGINI MELEME
  24 :       ITYPEL=NTYP(NBNN)
  25 : 
  26 :       K0=0
  27 :       DO 1 K=1,NBELEM
  28 :       K0=K0+1
  29 :       I0=MELEMC.NUM(1,K0)
  30 :       NUM(NBNN,K)=I0
  31 :       DO 1 I=1,NBNN-1
  32 :       I1=ELTFA.NUM(I,K)
  33 :       I2=LECT(I1)
  34 :       I3=FACEL.NUM(1,I2)
  35 :       NUM(I,K)=I3
  36 :       IF(I3.EQ.I0)NUM(I,K)=FACEL.NUM(3,I2)
  37 : C     write(6,*)K,I0,I1,I2,FACEL.NUM(1,I2),FACEL.NUM(3,I2)
  38 :  1    CONTINUE
  39 :       SEGDES MELEME,MELEMC,ELTFA,FACEL
  40 :       SEGSUP MLENTI
  40 : C     call ecrobj('MAILLAGE',meleme)
  40 : C     call prlist
  41 : 
  42 : 
  43 :       ELSEIF(NBSOUS.NE.0)THEN
  44 :       NBREF=0
  45 :       NBNN=0
  46 :       NBELEM=0
  47 :       SEGINI MELEME
  48 :       NBS=NBSOUS
  49 :       K0=0
  50 :       DO 2 L=1,NBS
  51 :       NBSOUS=0
  52 :       IPT2=ELTFA.LISOUS(L)
  53 :       SEGACT IPT2
  54 :       NBELEM=IPT2.NUM(/2)
  55 :       NBREF=0
  56 :       NBNN=IPT2.NUM(/1)+1
  57 :       SEGINI IPT1
  58 :       IPT1.ITYPEL=NTYP(NBNN)
  59 :       LISOUS(L)=IPT1
  60 :       DO 3 K=1,NBELEM
  61 :       K0=K0+1
  62 :       I0=MELEMC.NUM(1,K0)
  63 :       IPT1.NUM(NBNN,K)=I0
  64 :       DO 3 I=1,NBNN-1
  65 :       I1=IPT2.NUM(I,K)
  66 :       I2=LECT(I1)
  67 :       I3=FACEL.NUM(1,I2)
  68 :       IPT1.NUM(I,K)=I3
  69 :       IF(I3.EQ.I0)IPT1.NUM(I,K)=FACEL.NUM(3,I2)
  70 : C     write(6,*)K,I0,I1,I2,FACEL.NUM(1,I2),FACEL.NUM(3,I2)
  71 :  3    CONTINUE
  72 :       SEGDES IPT1,IPT2
  73 :  2    CONTINUE
  74 : 
  74 : C     call ecrobj('MAILLAGE',meleme)
  74 : C     call prlist
  75 : 
  76 : 
  77 :       SEGDES MELEME,MELEMC,ELTFA,FACEL
  78 :       SEGSUP MLENTI
  79 :       ENDIF
  80 :       RETURN
  81 :       END
  82 :