Télécharger chptco.eso

Retour à la liste

Numérotation des lignes :

  1. C CHPTCO SOURCE PASCAL 12/12/12 21:15:05 7605
  2. SUBROUTINE CHPTCO(IVAL,IPOIN)
  3. IMPLICIT INTEGER(I-N)
  4. CHARACTER*12 CTEXT
  5. -INC CCOPTIO
  6. -INC SMCHPOI
  7. -INC SMELEME
  8. logical ltelq
  9. MCHPOI=IPOIN
  10. SEGACT MCHPOI
  11. NSOUPO=IPCHP(/1)
  12. C
  13. C CAS DU CHPOINT VIDE
  14. C
  15. IF(NSOUPO.EQ.0) THEN
  16. SEGDES,MCHPOI
  17. NAT=1
  18. SEGINI,MCHPO1
  19. MCHPO1.IFOPOI=IFOUR
  20. MCHPO1.JATTRI(1)=1
  21. SEGDES,MCHPO1
  22. CALL ECROBJ('CHPOINT',MCHPO1)
  23. IF (IVAL.EQ.0) THEN
  24. IF (IDIM.EQ.2) THEN
  25. SEGINI,MCHPO2
  26. MCHPO2.IFOPOI=IFOUR
  27. MCHPO2.JATTRI(1)=1
  28. SEGDES,MCHPO2
  29. CALL ECROBJ('CHPOINT',MCHPO2)
  30. ELSEIF (IDIM.EQ.3) THEN
  31. SEGINI,MCHPO2
  32. MCHPO2.IFOPOI=IFOUR
  33. MCHPO2.JATTRI(1)=1
  34. SEGDES,MCHPO2
  35. CALL ECROBJ('CHPOINT',MCHPO2)
  36. SEGINI,MCHPO3
  37. MCHPO3.IFOPOI=IFOUR
  38. MCHPO3.JATTRI(1)=1
  39. SEGDES,MCHPO3
  40. CALL ECROBJ('CHPOINT',MCHPO3)
  41. ENDIF
  42. ENDIF
  43. RETURN
  44. ENDIF
  45. C
  46. C CAS DU CHPOINT NON VIDE
  47. C
  48. DO 1 I=1,NSOUPO
  49. MSOUPO=IPCHP(I)
  50. SEGACT MSOUPO
  51. IF(I.EQ.1) THEN
  52. IPT1=IGEOC
  53. SEGINI,MELEME=IPT1
  54. SEGDES MELEME
  55. IPGEO=MELEME
  56. ELSE
  57. IPGE1=IPGEO
  58. IPGE2=IGEOC
  59. ltelq=.false.
  60. CALL FUSE(IPGE1,IPGE2,IPGEO,ltelq)
  61. MELEME=IPGE1
  62. SEGSUP MELEME
  63. ENDIF
  64. SEGDES MSOUPO
  65. 1 CONTINUE
  66. SEGDES MCHPOI
  67. CALL CHPCOO(IVAL,IPGEO)
  68. C
  69. RETURN
  70. END
  71.  
  72.  
  73.  
  74.  

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