Download kamlpt.eso

Back to the list

   1 : C KAMLPT    SOURCE    CHAT      05/01/13    00:51:11     5004           
   2 :       SUBROUTINE KAMLPT(MELEM1,MELEMI,MELEMO)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : C*****************************************************************************
   6 : C
   7 : C Dans les references les objets maillages originaux apparaissent
   8 : C dans la numerotation locale
   9 : C
  10 : C*****************************************************************************
  11 : 
  12 : -INC SMELEME
  13 :       POINTEUR MELEM1.MELEME,MELEMI.MELEME,MELEMO.MELEME
  14 :       POINTEUR MELEMG.MELEME
  15 : 
  16 : 
  17 :       SEGACT MELEM1
  18 :       NPT=MELEM1.NUM(/2)
  19 : C     n1=MELEM1.NUM(/1)
  20 : C     write(6,*)' DAns kamlpt DEBUT :npt=',npt,' n1=',n1
  21 : C    & ,'MELEM1=',melem1
  22 : C     write(6,1001)(melem1.num(1,ii),ii=1,npt)
  23 : 
  23 :       CALL CREMLG(NPT,MELEMG)
  24 : 
  25 :       MELEME=MELEMI
  26 :       SEGACT MELEME
  27 :       NBSOUS=LISOUS(/1)
  28 :       IF(NBSOUS.EQ.0)NBSOUS=1
  29 : 
  30 :       NBSI=NBSOUS
  31 : 
  32 :       NBNN=1
  33 :       NBELEM=NPT
  34 :       NBSOUS=0
  35 :       NBREF=NBSI+1
  36 :       SEGINI MELEME
  37 :       ITYPEL=1
  38 :       MELEMO=MELEME
  39 : 
  40 :       DO 3 K=1,NBELEM
  41 :       NUM(1,K)=MELEM1.NUM(1,K)
  42 :  3    CONTINUE
  43 : 
  44 : C     write(6,*)' DAns kamlpt NUM = NPT=',npt,nbelem
  45 : C    & ,'MELEMO=',melemo
  46 : C     write(6,1001)(num(1,ii),ii=1,npt)
  47 : 
  48 :       SEGACT MELEMI
  49 :       DO 4 KS=1,NBSI
  50 :       IPT1=MELEMI
  51 :       IF(NBSI.NE.1)IPT1=MELEMI.LISOUS(KS)
  52 :       MELEMO.LISREF(KS)=IPT1
  53 :       SEGDES IPT1
  54 :  4    CONTINUE
  55 :       MELEMO.LISREF(NBREF)=MELEMG
  56 :       SEGDES MELEMI,MELEMO,MELEM1
  57 : 
  58 :       RETURN
  59 :  1001 FORMAT(20(1x,I5))
  60 :       END
  61 :  

© Cast3M 2003 - All rights reserved.
Disclaimer