Télécharger crchpt.eso

Retour à la liste

Numérotation des lignes :

  1. C CRCHPT SOURCE CB215821 19/08/20 21:16:25 10287
  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.  
  11. -INC PPARAM
  12. -INC CCOPTIO
  13. -INC SMCHPOI
  14. -INC SMELEME
  15. POINTEUR IGEOM.MELEME
  16. CHARACTER*(*) TYPI
  17. CHARACTER*8 TYPE
  18. CHARACTER*4 MOT(3),NOM4
  19. DATA MOT/'UX ','UY ','UZ '/
  20.  
  21. TYPE=' '
  22. TYPE=TYPI
  23. MCHPOI=0
  24. IF(IGEOM .LE. 0)THEN
  25. NAT=1
  26. NSOUPO=0
  27. SEGINI MCHPOI
  28. IFOPOI = IFOUR
  29. JATTRI(1)=2
  30. RETURN
  31. ENDIF
  32. SEGACT IGEOM
  33. IF(IGEOM.ITYPEL.NE.1)THEN
  34. WRITE(6,*)' Support geometrique incorrect '
  35. RETURN
  36. ENDIF
  37. ** il ne faut pas appeler crech1 car le maillage n'est pas nouveau
  38. ** call crech1(igeom,0)
  39. N=IGEOM.NUM(/2)
  40. NSOUPO=1
  41. NAT=1
  42. SEGINI MCHPOI,MSOUPO,MPOVAL
  43. JATTRI(1)=2
  44. IFOPOI=IFOMOD
  45. MTYPOI=TYPE
  46. MOCHDE=' '
  47. IPCHP(1)=MSOUPO
  48. IGEOC=IGEOM
  49. IPOVAL=MPOVAL
  50. IF(NC.EQ.1)THEN
  51. NOCOMP(1)='SCAL'
  52. ELSEIF(NC.GT.3)THEN
  53. DO 1 I=1,NC
  54. WRITE(NOM4,FMT='(A2,I2)')'CP',I
  55. NOCOMP(I)=NOM4
  56. 1 CONTINUE
  57. ELSE
  58. DO 2 I=1,NC
  59. NOCOMP(I)=MOT(I)
  60. 2 CONTINUE
  61. ENDIF
  62. END
  63.  
  64.  
  65.  

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