Esope source files

   1 : C MSOMET    SOURCE    CHAT      07/10/29    21:24:53     5940           
   2 :       SUBROUTINE MSOMET(MELEME,MELEMM,MELEMS,TYPE)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : 
   6 :       CHARACTER*8 TYPE
   7 :       PARAMETER (NBTYP=7)
   8 :       DIMENSION LISTN(4,NBTYP),ITAB(8,7)
   9 : -INC CCOPTIO
  10 : -INC CCGEOME
  11 : -INC SMELEME
  12 :       POINTEUR MELEMM.MELEME
  13 :       DATA LISTN/
  14 : C     seg3      qua9       tri7    
  15 :      &3,2,3,2,  11,8,8,4,  7,4,6,3,
  16 : C     seg2      qua4       tri3    
  17 : C     cu27        pr21        te15        py19
  18 :      &33,14,20,8, 34,16,18,6, 35,23,10,4, 36,25,13,5/
  19 : C     cub8        pri6        tet4        pyr5
  20 :       DATA ITAB/
  21 :      & 1,3,6*0,  1,3,5,7,4*0,  1,3,5,5*0,
  22 :      & 1,3,5,7,13,15,17,19,  1,3,5,10,12,14,2*0,
  23 :      & 1,3,5,10,4*0,  1,3,5,7,13,3*0 /
  24 : 
  25 :       TYPE=' '
  26 :       SEGACT MELEME
  27 :       NBSOUS=MAX(1,LISOUS(/1))
  28 :       NBREF=0
  29 :       NBELEM=0
  30 :       NBNN=0
  31 :       SEGINI MELEMM
  32 : 
  33 :       DO 1 L=1,MAX(1,LISOUS(/1))
  34 :       IPT1=MELEME
  35 :       IF(LISOUS(/1).NE.0)IPT1=LISOUS(L)
  36 :       SEGACT IPT1
  37 :       DO 2 M=1,NBTYP
  38 : C     write(6,*)' MSOMET : IPT1.ITYPEL=',IPT1.ITYPEL
  39 :       IF(IPT1.ITYPEL.EQ.LISTN(1,M))GO TO 21
  40 :  2    CONTINUE
  41 : C     write(6,*)' MSOMET :echec 1 '
  42 :       RETURN
  43 :  21   CONTINUE
  44 :       NBSOUS=0
  45 :       NBELEM=IPT1.NUM(/2)
  46 :       NBNN=LISTN(4,M)
  47 :       SEGINI IPT2
  48 :       IPT2.ITYPEL=LISTN(2,M)
  49 :       MELEMM.LISOUS(L)=IPT2
  50 :       NP=LISTN(3,M)
  51 : C     write(6,*)'NBNN NBELEM=',NBNN,NBELEM,' M=',M
  52 : 
  53 : 
  54 : 
  55 :       IF(M.LE.7)THEN
  56 :       DO 101 K=1,NBELEM
  57 :       DO 101 I=1,NBNN
  58 :       I1=ITAB(I,M)
  59 :       IPT2.NUM(I,K)=IPT1.NUM(I1,K)
  60 :  101  CONTINUE
  61 : 
  62 :       ELSE
  63 :       RETURN
  64 :       ENDIF
  65 :  1    CONTINUE
  66 :       IPT3=MELEMM
  67 :       IF(MELEMM.LISOUS(/1).EQ.1)THEN
  68 :       MELEMM=MELEMM.LISOUS(1)
  69 :       SEGSUP IPT3
  70 :       ENDIF
  71 :       MELEMS=MELEMM
  72 :       ITY=1
  72 :       CALL CHANGE(MELEMS,ITY)
  73 :       IF (IERR.NE.0) RETURN
  74 :       TYPE='MAILLAGE'
  75 : 
  76 :       RETURN
  77 :       END
  78 :  
  79 :  
  80 :  
  81 :  
  82 :  
  83 :  
  84 :  
  85 :  
  86 :  
  87 :