Télécharger crchpk.eso

Retour à la liste

Numérotation des lignes :

  1. C CRCHPK SOURCE MAGN 14/07/15 21:15:01 8096
  2. SUBROUTINE CRCHPK(TYPI,IGEOM,NC,MCHPOI,MOT)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C*************************************************************************
  6. C
  7. C Ce SP cree un champoint type TRIO-EF
  8. C
  9. C*************************************************************************
  10. -INC CCOPTIO
  11. -INC SMCHPOI
  12. -INC SMELEME
  13. POINTEUR IGEOM.MELEME
  14. CHARACTER*(*) TYPI
  15. CHARACTER*8 TYPE
  16. CHARACTER*4 MOT(3),NOM4
  17.  
  18. TYPE=' '
  19. TYPE=TYPI
  20. MCHPOI=0
  21. IF(IGEOM .LE. 0)THEN
  22. NAT=1
  23. NSOUPO=0
  24. SEGINI MCHPOI
  25. IFOPOI = IFOUR
  26. JATTRI(1)=2
  27. SEGDES MCHPOI
  28. RETURN
  29. ENDIF
  30. SEGACT IGEOM
  31. IF(IGEOM.ITYPEL.NE.1)THEN
  32. WRITE(6,*)' Support geometrique incorrect '
  33. RETURN
  34. ENDIF
  35. N=IGEOM.NUM(/2)
  36. SEGDES IGEOM
  37. NSOUPO=1
  38. NAT=1
  39. SEGINI MCHPOI,MSOUPO,MPOVAL
  40. JATTRI(1)=2
  41. IFOPOI=IFOMOD
  42. MTYPOI=TYPE
  43. MOCHDE=' '
  44. IPCHP(1)=MSOUPO
  45. IGEOC=IGEOM
  46. IPOVAL=MPOVAL
  47. DO 2 I=1,NC
  48. NOCOMP(I)=MOT(I)
  49. 2 CONTINUE
  50. SEGDES MCHPOI,MSOUPO,MPOVAL
  51. RETURN
  52. END
  53.  
  54.  
  55.  
  56.  
  57.  
  58.  

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