Esope source files

   1 : C CATMEL    SOURCE    CHAT      05/01/12    21:49:37     5004           
   2 :       SUBROUTINE CATMEL(IPT1,IPT2)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : C*****************************************************************************
   6 : C
   7 : C CE SOUS PROGRAMME CONCATENE L 'OBJET MAILLAGE IPT2 A L'OBJET MAILLAGE
   8 : C IPT1 SANS FUSIONNER SUR LES TYPES D ELEMENT
   9 : C SI IPT1=0 ON CREE L 'OBJET IPT1, ON NE RENVOIE PAS IPT1=IPT2
  10 : C
  11 : C*****************************************************************************
  12 : -INC SMELEME
  13 : 
  14 :       SEGACT IPT2
  15 :       NBS2=IPT2.LISOUS(/1)
  16 : 
  17 :       IF(IPT1.EQ.0)THEN
  18 : C CAS OU ON CREE IPT1
  19 : 
  20 :        IF(NBS2.EQ.0)THEN
  21 :         NBNN=IPT2.NUM(/1)
  22 :         NBELEM=IPT2.NUM(/2)
  23 :         NBREF=0
  24 :         NBSOUS=0
  25 :         SEGINI MELEME
  25 :         CALL RSETI(NUM,IPT2.NUM,NBNN*NBELEM)
  26 :         ITYPEL=IPT2.ITYPEL
  27 :         SEGDES MELEME
  28 :         IPT1=MELEME
  29 :         SEGDES IPT2
  30 :         RETURN
  31 :        ELSE
  32 :         NBNN=0
  33 :         NBELEM=0
  34 :         NBSOUS=NBS2
  35 :         NBREF=0
  36 :         SEGINI MELEME
  36 :         CALL RSETI(LISOUS,IPT2.LISOUS,NBSOUS)
  37 :         SEGDES MELEME
  38 :         IPT1=MELEME
  39 :         SEGDES IPT2
  40 :         RETURN
  41 :        ENDIF
  42 : 
  43 :       ELSE
  44 : C CAS OU IPT1 EXISTE
  45 : 
  46 :       SEGACT IPT1
  47 :       NBS1=IPT1.LISOUS(/1)
  48 :        IF(NBS1.EQ.0)THEN
  49 :        NBNN=0
  50 :        NBELEM=0
  51 :          IF(NBS2.EQ.0)THEN
  52 :           NBSOUS=2
  53 :          ELSE
  54 :           NBSOUS=1+NBS2
  55 :          ENDIF
  56 :        NBREF=0
  57 :        SEGINI MELEME
  58 :         LISOUS(1)=IPT1
  59 :          IF(NBS2.EQ.0)THEN
  60 :           LISOUS(2)=IPT2
  61 :          ELSE
  61 :           CALL RSETI(LISOUS(2),IPT2.LISOUS,NBS2)
  62 :          ENDIF
  63 :         SEGDES IPT1
  64 :         IPT1=MELEME
  65 :         SEGDES IPT1
  66 :         SEGDES IPT2
  67 :         RETURN
  68 : 
  69 :        ELSE
  70 :         NBNN=0
  71 :         NBELEM=0
  72 :         NBREF=0
  73 :          IF(NBS2.EQ.0)THEN
  74 :           NBSOUS=NBS1+1
  75 :           MELEME=IPT1
  76 :           SEGADJ MELEME
  77 :           NL=LISOUS(/1)
  78 :           LISOUS(NL)=IPT2
  79 :           SEGDES MELEME,IPT2
  80 :           IPT1=MELEME
  81 :           RETURN
  82 :          ELSE
  83 :           NBSOUS=NBS1+NBS2
  84 :           MELEME=IPT1
  85 :           SEGADJ MELEME
  85 :           CALL RSETI(LISOUS(NBS1+1),IPT2.LISOUS,NBS2)
  86 :           SEGDES MELEME,IPT2
  87 :           RETURN
  88 :          ENDIF
  89 :        ENDIF
  90 :       ENDIF
  91 : 
  92 :       END
  93 :