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

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