Télécharger cremlg.eso

Retour à la liste

Numérotation des lignes :

  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.  
  60.  

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