Télécharger chptco.eso

Retour à la liste

Numérotation des lignes :

  1. C CHPTCO SOURCE CB215821 17/10/19 21:15:01 9593
  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.  
  10. MCHPOI=IPOIN
  11. SEGACT MCHPOI
  12. NSOUPO=IPCHP(/1)
  13. C
  14. C CAS DU CHPOINT VIDE
  15. C
  16. IF(NSOUPO.EQ.0) THEN
  17. SEGDES,MCHPOI
  18. NAT=1
  19. SEGINI,MCHPO1
  20. MCHPO1.IFOPOI=IFOUR
  21. MCHPO1.JATTRI(1)=1
  22. SEGDES,MCHPO1
  23. CALL ECROBJ('CHPOINT',MCHPO1)
  24.  
  25. IF (IVAL.EQ.0) THEN
  26. IF (IDIM.EQ.2) THEN
  27. SEGINI,MCHPO2=MCHPO1
  28. SEGDES,MCHPO2
  29. CALL ECROBJ('CHPOINT',MCHPO2)
  30.  
  31. ELSEIF (IDIM.EQ.3) THEN
  32. SEGINI,MCHPO2=MCHPO1
  33. SEGDES,MCHPO2
  34. CALL ECROBJ('CHPOINT',MCHPO2)
  35. SEGINI,MCHPO3=MCHPO1
  36. SEGDES,MCHPO3
  37. CALL ECROBJ('CHPOINT',MCHPO3)
  38.  
  39. ELSE
  40. CALL ERREUR(832)
  41. RETURN
  42. ENDIF
  43. ENDIF
  44.  
  45. RETURN
  46. ENDIF
  47. C
  48. C CAS DU CHPOINT NON VIDE
  49. C
  50. DO 1 I=1,NSOUPO
  51. MSOUPO=IPCHP(I)
  52. SEGACT MSOUPO
  53. IF(I.EQ.1) THEN
  54. IPGEO=IGEOC
  55. ELSE
  56. IPGE1=IPGEO
  57. IPGE2=IGEOC
  58. ltelq=.false.
  59. CALL FUSE(IPGE1,IPGE2,IPGEO,ltelq)
  60. MELEME=IPGE1
  61. IF (MELEME .NE. IPGEO) SEGDES,MELEME
  62. MELEME=IPGE2
  63. IF (MELEME .NE. IPGEO) SEGDES,MELEME
  64. ENDIF
  65. SEGDES,MSOUPO
  66. 1 CONTINUE
  67. SEGDES,MCHPOI
  68. CALL CHPCOO(IVAL,IPGEO)
  69. C
  70. RETURN
  71. END
  72.  
  73.  
  74.  

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