Download cremlg.eso

Back to the list

   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