Télécharger krchp1.eso

Retour à la liste

Numérotation des lignes :

krchp1
  1. C KRCHP1 SOURCE CB215821 20/11/25 13:32:55 10792
  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.  
  10. -INC PPARAM
  11. -INC CCOPTIO
  12. -INC SMCHPOI
  13. -INC SMELEME
  14. -INC SMLMOTS
  15. C
  16. INTEGER IGEOM,NC, NAT, NSOUPO,N,I,NBSOUS
  17. CHARACTER*8 TYPE
  18. C
  19. SEGACT MLMOTS
  20. NC = MLMOTS.MOTS(/2)
  21. IPT1 = IGEOM
  22. IF((IPT1 .LE. 0) .OR. (NC .EQ. 0))THEN
  23. C
  24. C******* Creation d'un CHPOINT vide
  25. C
  26. NAT=2
  27. NSOUPO=0
  28. SEGINI MCHPOI
  29. JATTRI(1)=2
  30. IFOPOI = IFOUR
  31. ELSE
  32. C
  33. C******* Creation d'un CHPOINT
  34. C de type TYPE,
  35. C tytre blanc
  36. C defini sur le maillage des POI1 de IGEOM
  37. C de composantes MLMOTS
  38. C avec MPOVAL zero
  39. C
  40. C
  41. SEGACT IPT1
  42. NBSOUS = IPT1.LISOUS(/1)
  43. IF ( (NBSOUS .NE. 0) .OR. (IPT1.ITYPEL .NE. 1)) THEN
  44. CALL CHANGE(IPT1,1)
  45. IF (IERR.NE.0) RETURN
  46. ENDIF
  47. N=IPT1.NUM(/2)
  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. ENDIF
  64. END
  65.  
  66.  
  67.  
  68.  

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