Télécharger la plaquette Cast3M


fr en

Télécharger catmel.eso

Retour à la liste

Numérotation des lignes : 

catmel

  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
  26.         CALL RSETI(NUM,IPT2.NUM,NBNN*NBELEM)
  27.         ITYPEL=IPT2.ITYPEL
  28.         SEGDES MELEME
  29.         IPT1=MELEME
  30.         SEGDES IPT2
  31.         RETURN
  32.        ELSE
  33.         NBNN=0
  34.         NBELEM=0
  35.         NBSOUS=NBS2
  36.         NBREF=0
  37.         SEGINI MELEME
  38.         CALL RSETI(LISOUS,IPT2.LISOUS,NBSOUS)
  39.         SEGDES MELEME
  40.         IPT1=MELEME
  41.         SEGDES IPT2
  42.         RETURN
  43.        ENDIF
  44.  
  45.       ELSE
  46. C CAS OU IPT1 EXISTE
  47.  
  48.       SEGACT IPT1
  49.       NBS1=IPT1.LISOUS(/1)
  50.        IF(NBS1.EQ.0)THEN
  51.        NBNN=0
  52.        NBELEM=0
  53.          IF(NBS2.EQ.0)THEN
  54.           NBSOUS=2
  55.          ELSE
  56.           NBSOUS=1+NBS2
  57.          ENDIF
  58.        NBREF=0
  59.        SEGINI MELEME
  60.         LISOUS(1)=IPT1
  61.          IF(NBS2.EQ.0)THEN
  62.           LISOUS(2)=IPT2
  63.          ELSE
  64.           CALL RSETI(LISOUS(2),IPT2.LISOUS,NBS2)
  65.          ENDIF
  66.         SEGDES IPT1
  67.         IPT1=MELEME
  68.         SEGDES IPT1
  69.         SEGDES IPT2
  70.         RETURN
  71.  
  72.        ELSE
  73.         NBNN=0
  74.         NBELEM=0
  75.         NBREF=0
  76.          IF(NBS2.EQ.0)THEN
  77.           NBSOUS=NBS1+1
  78.           MELEME=IPT1
  79.           SEGADJ MELEME
  80.           NL=LISOUS(/1)
  81.           LISOUS(NL)=IPT2
  82.           SEGDES MELEME,IPT2
  83.           IPT1=MELEME
  84.           RETURN
  85.          ELSE
  86.           NBSOUS=NBS1+NBS2
  87.           MELEME=IPT1
  88.           SEGADJ MELEME
  89.           CALL RSETI(LISOUS(NBS1+1),IPT2.LISOUS,NBS2)
  90.           SEGDES MELEME,IPT2
  91.           RETURN
  92.          ENDIF
  93.        ENDIF
  94.       ENDIF
  95.  
  96.       END
  97.  
  98.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales