Télécharger crchpt.eso

Retour à la liste

Numérotation des lignes :

  1. C CRCHPT SOURCE PV 13/04/16 21:15:13 7765
  2. SUBROUTINE CRCHPT(TYPI,IGEOM,NC,MCHPOI)
  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. DATA MOT/'UX ','UY ','UZ '/
  18.  
  19. TYPE=' '
  20. TYPE=TYPI
  21. MCHPOI=0
  22. IF(IGEOM .LE. 0)THEN
  23. NAT=1
  24. NSOUPO=0
  25. SEGINI MCHPOI
  26. IFOPOI = IFOUR
  27. JATTRI(1)=2
  28. SEGDES MCHPOI
  29. RETURN
  30. ENDIF
  31. SEGACT IGEOM
  32. IF(IGEOM.ITYPEL.NE.1)THEN
  33. WRITE(6,*)' Support geometrique incorrect '
  34. RETURN
  35. ENDIF
  36. call crech1(igeom,0)
  37. N=IGEOM.NUM(/2)
  38. SEGDES IGEOM
  39. NSOUPO=1
  40. NAT=1
  41. SEGINI MCHPOI,MSOUPO,MPOVAL
  42. JATTRI(1)=2
  43. IFOPOI=IFOMOD
  44. MTYPOI=TYPE
  45. MOCHDE=' '
  46. IPCHP(1)=MSOUPO
  47. IGEOC=IGEOM
  48. IPOVAL=MPOVAL
  49. IF(NC.EQ.1)THEN
  50. NOCOMP(1)='SCAL'
  51. ELSEIF(NC.GT.3)THEN
  52. DO 1 I=1,NC
  53. WRITE(NOM4,FMT='(A2,I2)')'CP',I
  54. NOCOMP(I)=NOM4
  55. 1 CONTINUE
  56. ELSE
  57. DO 2 I=1,NC
  58. NOCOMP(I)=MOT(I)
  59. 2 CONTINUE
  60. ENDIF
  61. SEGDES MCHPOI,MSOUPO,MPOVAL
  62. RETURN
  63. END
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  
  70.  

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