Télécharger chptco.eso

Retour à la liste

Numérotation des lignes :

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

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