Sources Esope | Cast3M

kamlpt
C KAMLPT    SOURCE    CHAT      05/01/13    00:51:11     5004
      SUBROUTINE KAMLPT(MELEM1,MELEMI,MELEMO)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C*****************************************************************************
C
C Dans les references les objets maillages originaux apparaissent
C dans la numerotation locale
C
C*****************************************************************************
 
-INC SMELEME
      POINTEUR MELEM1.MELEME,MELEMI.MELEME,MELEMO.MELEME
      POINTEUR MELEMG.MELEME
 
 
      SEGACT MELEM1
      NPT=MELEM1.NUM(/2)
C     n1=MELEM1.NUM(/1)
C     write(6,*)' DAns kamlpt DEBUT :npt=',npt,' n1=',n1
C    & ,'MELEM1=',melem1
C     write(6,1001)(melem1.num(1,ii),ii=1,npt)
 
      CALL CREMLG(NPT,MELEMG)
 
      MELEME=MELEMI
      SEGACT MELEME
      NBSOUS=LISOUS(/1)
      IF(NBSOUS.EQ.0)NBSOUS=1
 
      NBSI=NBSOUS
 
      NBNN=1
      NBELEM=NPT
      NBSOUS=0
      NBREF=NBSI+1
      SEGINI MELEME
      ITYPEL=1
      MELEMO=MELEME
 
      DO 3 K=1,NBELEM
      NUM(1,K)=MELEM1.NUM(1,K)
 3    CONTINUE
 
C     write(6,*)' DAns kamlpt NUM = NPT=',npt,nbelem
C    & ,'MELEMO=',melemo
C     write(6,1001)(num(1,ii),ii=1,npt)
 
      SEGACT MELEMI
      DO 4 KS=1,NBSI
      IPT1=MELEMI
      IF(NBSI.NE.1)IPT1=MELEMI.LISOUS(KS)
      MELEMO.LISREF(KS)=IPT1
      SEGDES IPT1
 4    CONTINUE
      MELEMO.LISREF(NBREF)=MELEMG
      SEGDES MELEMI,MELEMO,MELEM1
 
      RETURN
 1001 FORMAT(20(1x,I5))
      END