1 : C CREMLG SOURCE CHAT 06/06/01 21:15:56 5450 2 : SUBROUTINE CREMLG (NMLG,MELEME) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C************************************************************************* 6 : C 7 : C OBJET : Cree des points pour les multiplicateurs de Lagrange 8 : C 9 : C NMLG : (en entree) nb de multiplicateurs de Lagrange 10 : C MELEME : (en sortie) objet 'MAILLAGE' constitué d'éléments POI1 11 : C 12 : C************************************************************************* 13 : -INC SMELEME 14 : -INC SMCOORD 15 : -INC CCOPTIO 16 : * SAVE NPTS 17 : * DATA NPTS/0/ 18 : C*** 19 : 20 : NBPTI=XCOOR(/1)/(IDIM+1) 21 : npts=nbpti 22 : NBPTS=NBPTI+NMLG 23 : SEGADJ MCOORD 24 : 25 : NBSOUS=0 26 : NBREF=0 27 : NBNN=1 28 : NBELEM=NMLG 29 : SEGINI MELEME 30 : ITYPEL=1 31 : 32 : IF(IDIM.EQ.2)THEN 33 : DO 2 K=1,NMLG 34 : NU=NBPTI+K 35 : NPTS=NPTS+1 36 : XC=1.E10+FLOAT(NPTS)*1.E2 37 : NUM(1,K)=NU 38 : XCOOR((NU-1)*(IDIM+1)+1)=XC 39 : XCOOR((NU-1)*(IDIM+1)+2)=XC 40 : 2 CONTINUE 41 : 42 : ELSEIF(IDIM.EQ.3)THEN 43 : 44 : DO 3 K=1,NMLG 45 : NU=NBPTI+K 46 : NPTS=NPTS+1 47 : XC=1.E10+FLOAT(NPTS)*1.E2 48 : NUM(1,K)=NU 49 : XCOOR((NU-1)*(IDIM+1)+1)=XC 50 : XCOOR((NU-1)*(IDIM+1)+2)=XC 51 : XCOOR((NU-1)*(IDIM+1)+3)=XC 52 : 3 CONTINUE 53 : ENDIF 54 : 55 : SEGDES MELEME 56 : RETURN 57 : END 58 : 59 :
© Cast3M 2003 - All rights reserved.
Disclaimer