Esope source files

   1 : C KMACRO    SOURCE    CHAT      07/10/29    21:22:03     5940           
   2 :       SUBROUTINE KMACRO(MELEME,MELEMM,MTABZ)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : 
   6 :       CHARACTER*8 TYPE,TYP2
   7 : -INC CCGEOME
   8 : -INC SMELEME
   9 :       POINTEUR MELEMM.MELEME
  10 : 
  11 :       TYPE=' '
  11 :       CALL ACMO(MTABZ,'MACRO1',TYPE,MELEMM)
  12 :       IF(MELEMM.NE.0)RETURN
  13 : 
  13 :       CALL ACMF(MTABZ,'TOLER',TOLER)
  14 :       TYP2='MAILLAGE'
  14 :       CALL ACMO(MTABZ,'SOMMET',TYP2,MELEMS)
  15 : 
  16 :       ICHAN=0
  17 :       SEGACT MELEME
  18 :       NBSOUS=LISOUS(/1)
  19 :       NBREF =0
  20 : 
  21 :       IF(NBSOUS.EQ.0)THEN
  22 :       NBSOUL=1
  23 :       ELSE
  24 :       NBSOUL=NBSOUS
  25 :       ENDIF
  26 : 
  27 :       NBREF=0
  28 :       NBNN=0
  29 :       NBELEM=0
  30 :       SEGINI MELEMM
  31 : 
  32 :       DO 1 L=1,NBSOUL
  33 :       IPT1=MELEME
  34 :       IF(NBSOUL.NE.1)IPT1=LISOUS(L)
  35 :       SEGACT IPT1
  36 :       IPT2=IPT1
  37 : 
  38 :       IF(NOMS(IPT1.ITYPEL).EQ.'QUA8')THEN
  39 :       ICHAN=1
  39 :       CALL ECRCHA('QUA9')
  39 :       CALL ECROBJ('MAILLAGE',IPT1)
  39 :       CALL PRCHAN
  39 :       CALL LIROBJ('MAILLAGE',IPT2,1,IRET)
  40 :       IF(IRET.NE.1)RETURN
  41 : 
  41 :       CALL ECROBJ('MAILLAGE',IPT2)
  41 :       CALL ECROBJ('MAILLAGE',MELEMS)
  41 :       CALL PRFUSE
  41 :       CALL ECRREE(TOLER)
  41 :       CALL PRELIM(0)
  41 :       CALL LIROBJ('MAILLAGE',IPT0,1,IRET)
  42 :       IF(IRET.NE.1)RETURN
  43 : 
  44 :       ENDIF
  45 : 
  46 :       IF(NBSOUL.NE.1)THEN
  47 :       MELEMM.LISOUS(L)=IPT2
  48 :       ELSE
  49 :       MELEMM=IPT2
  50 :       ENDIF
  51 : 
  52 :  1    CONTINUE
  53 : 
  53 :       CALL ECMO(MTABZ,'MACRO1','MAILLAGE',MELEMM)
  54 :       RETURN
  55 :       END
  56 :  
  57 :  
  58 :  
  59 :  
  60 :  
  61 :