Télécharger rngcha.eso

Retour à la liste

Numérotation des lignes :

  1. C RNGCHA SOURCE FANDEUR 10/12/14 21:19:23 6812
  2.  
  3. SUBROUTINE RNGCHA(IPCHA1,IPCHA2,TCHA1,TCHA2,IPCHE1,IPCHE2)
  4.  
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8(A-H,O-Z)
  7.  
  8. *--------------------------------------------------------------------*
  9. * *
  10. * A partir de 2 pointeurs MCHAML dans un ordre quelconque, *
  11. * RNGCHA retourne 2 pointeurs connus sur 2 types de MCHAML *
  12. * specifies s'ils sont presents. *
  13. * *
  14. *--------------------------------------------------------------------*
  15. * *
  16. * Entr{es: *
  17. * *
  18. * IPCHA1 pointeur sur un MCHAML inconnu *
  19. * IPCHA2 pointeur sur un MCHAML inconnu *
  20. * TCHA1 TITRE (TITCHE ) DU MCHAML a mettre en premiere *
  21. * position s'il est present. *
  22. * TCHA2 TITRE (TITCHE ) DU MCHAML a mettre en seconde *
  23. * position s'il est present. *
  24. * *
  25. * Sorties: *
  26. * *
  27. * IPCHE1 pointeur sur le MCHAML du premier type specifie *
  28. * s'il est pr{sent. *
  29. * IPCHE2 pointeur sur le MCHAML du second type specifie *
  30. * s'il est pr{sent. *
  31. *--------------------------------------------------------------------*
  32. *
  33. -INC CCOPTIO
  34. -INC SMCHAML
  35. *
  36. CHARACTER*(*) TCHA1,TCHA2
  37. CHARACTER*72 TITCH1,TITCH2,TCHAM1,TCHAM2
  38. *
  39. IPCHE1=0
  40. IPCHE2=0
  41. TITCH1 = ' '
  42. TITCH2 = ' '
  43. TCHAM1 = TCHA1
  44. TCHAM2 = TCHA2
  45. *
  46. IF (IPCHA1.NE.0) THEN
  47. MCHELM=IPCHA1
  48. SEGACT MCHELM
  49. TITCH1=TITCHE
  50. IF (TITCH1.EQ.TCHAM1) THEN
  51. IPCHE1=IPCHA1
  52. ELSE IF (TITCH1.EQ.TCHAM2) THEN
  53. IPCHE2=IPCHA1
  54. ENDIF
  55. SEGDES MCHELM
  56. ENDIF
  57. *
  58. IF (IPCHA2.NE.0) THEN
  59. MCHELM=IPCHA2
  60. SEGACT MCHELM
  61. TITCH2=TITCHE
  62. IF (TITCH2.EQ.TCHAM1) THEN
  63. IPCHE1=IPCHA2
  64. ELSE IF (TITCH2.EQ.TCHAM2) THEN
  65. IPCHE2=IPCHA2
  66. ENDIF
  67. SEGDES MCHELM
  68. ENDIF
  69. *
  70. * LES 2 MCHAMLS SONT DE MEME TYPE
  71. *
  72. IF (TITCH1.EQ.TITCH2) THEN
  73. MOTERR(1:8)='MCHAML '
  74. MOTERR(9:16)=TITCH1
  75. CALL ERREUR(130)
  76. *
  77. * PAS DE MCHAML TROUVE
  78. *
  79. ELSE IF (IPCHE1.EQ.0.AND.IPCHE2.EQ.0) THEN
  80. MOTERR(1:8)='MCHAML '
  81. MOTERR(9:16)=TITCH1
  82. CALL ERREUR(131)
  83. ENDIF
  84. *
  85. RETURN
  86. END
  87.  
  88.  
  89.  

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