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