Télécharger la plaquette Cast3M


fr en

Télécharger rngcha.eso

Retour à la liste

Numérotation des lignes : 

rngcha

  1. C RNGCHA    SOURCE    CB215821  18/09/21    21:16:50     9930           
  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.  
  34. -INC PPARAM
  35. -INC CCOPTIO
  36. -INC SMCHAML
  37. *
  38.       CHARACTER*(*) TCHA1,TCHA2
  39.       CHARACTER*72  TITCH1,TITCH2,TCHAM1,TCHAM2
  40. *
  41.       IPCHE1=0
  42.       IPCHE2=0
  43.       TITCH1 = ' '
  44.       TITCH2 = ' '
  45.       TCHAM1 = TCHA1
  46.       TCHAM2 = TCHA2
  47. *
  48.       IF (IPCHA1.NE.0) THEN
  49.         MCHELM=IPCHA1
  50.         SEGACT MCHELM
  51.         TITCH1=TITCHE
  52.         IF (TITCH1.EQ.TCHAM1) THEN
  53.           IPCHE1=IPCHA1
  54.          ELSE IF (TITCH1.EQ.TCHAM2) THEN
  55.           IPCHE2=IPCHA1
  56.         ENDIF
  57. C        SEGDES MCHELM
  58.       ENDIF
  59. *
  60.       IF (IPCHA2.NE.0) THEN
  61.         MCHELM=IPCHA2
  62.         SEGACT MCHELM
  63.         TITCH2=TITCHE
  64.         IF (TITCH2.EQ.TCHAM1) THEN
  65.           IPCHE1=IPCHA2
  66.         ELSE IF (TITCH2.EQ.TCHAM2) THEN
  67.           IPCHE2=IPCHA2
  68.         ENDIF
  69. C        SEGDES MCHELM
  70.       ENDIF
  71. *
  72. *   LES 2 MCHAMLS SONT DE MEME TYPE
  73. *
  74.       IF (TITCH1.EQ.TITCH2) THEN
  75.         MOTERR(1:8)='MCHAML  '
  76.         MOTERR(9:16)=TITCH1
  77.         CALL ERREUR(130)
  78. *
  79. *   PAS DE MCHAML TROUVE
  80. *
  81.       ELSE IF (IPCHE1.EQ.0.AND.IPCHE2.EQ.0) THEN
  82.         MOTERR(1:8)='MCHAML  '
  83.         MOTERR(9:16)=TITCH1
  84.         CALL ERREUR(131)
  85.       ENDIF
  86. *
  87.       RETURN
  88.       END
  89.  
  90.  
  91.  
  92.  

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