Télécharger exisco.eso

Retour à la liste

Numérotation des lignes :

  1. C EXISCO SOURCE PV 09/03/12 21:21:58 6325
  2. SUBROUTINE EXISCO(MOTYP,IVAL,MACOMP,IRET)
  3. C----------------------------------------------------------------------
  4. C EXISTENCE D'UNE COMPOSANTE DANS UN CHPOINT OU UN MCHAML
  5. C----------------------------------------------------------------------
  6. IMPLICIT INTEGER(I-N)
  7. -INC CCOPTIO
  8. -INC SMCHPOI
  9. -INC SMCHAML
  10. CHARACTER*8 MOTYP
  11. CHARACTER*4 MACOMP
  12. LOGICAL IRET
  13. IF(MOTYP.EQ.'MCHAML ') THEN
  14. ICHAM=1
  15. GO TO 1
  16. ELSE IF(MOTYP.EQ.'CHPOINT ') THEN
  17. ICHAM=2
  18. GO TO 1
  19. ENDIF
  20. CALL ERREUR(21)
  21. RETURN
  22. 1 CONTINUE
  23. C
  24. GO TO (600,700),ICHAM
  25. C----------------------------
  26. C CAS DU MCHAML
  27. C----------------------------
  28. 600 CONTINUE
  29. MCHELM=IVAL
  30. SEGACT MCHELM
  31. NSOUS=IMACHE(/1)
  32. C
  33. C BOUCLE SUR LES SOUS PAQUETS DE MCHELM
  34. C
  35. DO 100 IA=1,NSOUS
  36. MCHAML=ICHAML(IA)
  37. SEGACT MCHAML
  38. NCP=NOMCHE(/2)
  39. DO 110 IB=1,NCP
  40. IF(MACOMP.NE.NOMCHE(IB))GOTO 110
  41. SEGDES MCHAML
  42. IRET=.TRUE.
  43. GO TO 120
  44. 110 CONTINUE
  45. SEGDES MCHAML
  46. 100 CONTINUE
  47. IRET=.FALSE.
  48. C
  49. 120 CONTINUE
  50. SEGDES MCHELM
  51. GO TO 800
  52. C-------------------------
  53. C CAS DU CHPOINT
  54. C-------------------------
  55. 700 CONTINUE
  56. MCHPOI=IVAL
  57. SEGACT MCHPOI
  58. NBSOUS=IPCHP(/1)
  59. C
  60. C BOUCLE SUR LES SOUS-ZONES DU CHPOINT
  61. C
  62. DO 11 I=1,NBSOUS
  63. MSOUPO=IPCHP(I)
  64. SEGACT MSOUPO
  65. DO 12 IC=1,NOCOMP(/2)
  66. IF(NOCOMP(IC).NE.MACOMP) GO TO 12
  67. SEGDES MSOUPO
  68. IRET=.TRUE.
  69. GO TO 15
  70. 12 CONTINUE
  71. SEGDES MSOUPO
  72. 11 CONTINUE
  73. IRET=.FALSE.
  74. 15 CONTINUE
  75. SEGDES MCHPOI
  76. C
  77. 800 RETURN
  78. END
  79.  
  80.  
  81.  
  82.  

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