Télécharger krchp1.eso

Retour à la liste

Numérotation des lignes :

  1. C KRCHP1 SOURCE CHAT 05/01/13 01:05:51 5004
  2. SUBROUTINE KRCHP1(TYPE,IGEOM,MCHPOI,MLMOTS)
  3. C*************************************************************************
  4. C
  5. C Ce SP cree un champoint
  6. C
  7. C*************************************************************************
  8. IMPLICIT INTEGER(I-N)
  9. -INC CCOPTIO
  10. -INC SMCHPOI
  11. -INC SMELEME
  12. -INC SMLMOTS
  13. C
  14. INTEGER IGEOM,NC, NAT, NSOUPO,N,I,NBSOUS
  15. CHARACTER*8 TYPE
  16. C
  17. SEGACT MLMOTS
  18. NC = MLMOTS.MOTS(/2)
  19. IPT1 = IGEOM
  20. IF((IPT1 .LE. 0) .OR. (NC .EQ. 0))THEN
  21. C
  22. C******* Creation d'un CHPOINT vide
  23. C
  24. NAT=2
  25. NSOUPO=0
  26. SEGINI MCHPOI
  27. JATTRI(1)=2
  28. IFOPOI = IFOUR
  29. SEGDES MCHPOI
  30. ELSE
  31. C
  32. C******* Creation d'un CHPOINT
  33. C de type TYPE,
  34. C tytre blanc
  35. C defini sur le maillage des POI1 de IGEOM
  36. C de composantes MLMOTS
  37. C avec MPOVAL zero
  38. C
  39. C
  40. SEGACT IPT1
  41. NBSOUS = IPT1.LISOUS(/1)
  42. IF ( (NBSOUS .NE. 0) .OR. (IPT1.ITYPEL .NE. 1)) THEN
  43. CALL CHANGE(IPT1,1)
  44. IF (IERR.NE.0) GOTO 9999
  45. ENDIF
  46. N=IPT1.NUM(/2)
  47. SEGDES IPT1
  48. NSOUPO=1
  49. NAT=2
  50. SEGINI MCHPOI,MSOUPO,MPOVAL
  51. MCHPOI.JATTRI(1)=2
  52. * Nature discret
  53. MCHPOI.IFOPOI=IFOMOD
  54. MCHPOI.MTYPOI=TYPE
  55. MCHPOI.MOCHDE=
  56. $' '
  57. MCHPOI.IPCHP(1)=MSOUPO
  58. MSOUPO.IGEOC=IPT1
  59. MSOUPO.IPOVAL=MPOVAL
  60. DO 1 I=1,NC,1
  61. MSOUPO.NOCOMP(I)= MLMOTS.MOTS(I)
  62. 1 CONTINUE
  63. SEGDES MCHPOI,MSOUPO,MPOVAL
  64. ENDIF
  65. SEGDES MLMOTS
  66. 9999 RETURN
  67. END
  68.  
  69.  
  70.  
  71.  
  72.  
  73.  
  74.  

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