Télécharger la plaquette Cast3M


fr en

Télécharger cremlg.eso

Retour à la liste

Numérotation des lignes : 

cremlg

  1. C CREMLG    SOURCE    PV        20/03/24    21:16:37     10554          
  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.  
  16. -INC PPARAM
  17. -INC CCOPTIO
  18. *      SAVE NPTS
  19. *      DATA NPTS/0/
  20. C***
  21.  
  22.       segact mcoord*mod
  23.       NBPTI=nbpts
  24.       npts=nbpti
  25.       NBPTS=NBPTI+NMLG
  26.       SEGADJ MCOORD
  27.  
  28.       NBSOUS=0
  29.       NBREF=0
  30.       NBNN=1
  31.       NBELEM=NMLG
  32.       SEGINI MELEME
  33.       ITYPEL=1
  34.  
  35.       IF(IDIM.EQ.2)THEN
  36.       DO 2 K=1,NMLG
  37.       NU=NBPTI+K
  38.       NPTS=NPTS+1
  39.       XC=1.E10+FLOAT(NPTS)*1.E2
  40.       NUM(1,K)=NU
  41.       XCOOR((NU-1)*(IDIM+1)+1)=XC
  42.       XCOOR((NU-1)*(IDIM+1)+2)=XC
  43.  2    CONTINUE
  44.  
  45.       ELSEIF(IDIM.EQ.3)THEN
  46.  
  47.       DO 3 K=1,NMLG
  48.       NU=NBPTI+K
  49.       NPTS=NPTS+1
  50.       XC=1.E10+FLOAT(NPTS)*1.E2
  51.       NUM(1,K)=NU
  52.       XCOOR((NU-1)*(IDIM+1)+1)=XC
  53.       XCOOR((NU-1)*(IDIM+1)+2)=XC
  54.       XCOOR((NU-1)*(IDIM+1)+3)=XC
  55.  3    CONTINUE
  56.       ENDIF
  57.  
  58.       SEGDES MELEME
  59.       RETURN
  60.       END
  61.  
  62.  
  63.  
  64.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales