Télécharger exisco.eso

Retour à la liste

Numérotation des lignes :

  1. C EXISCO SOURCE CB215821 19/08/20 21:17:28 10287
  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. IRET=.TRUE.
  42. GO TO 120
  43. 110 CONTINUE
  44. 100 CONTINUE
  45. IRET=.FALSE.
  46. C
  47. 120 CONTINUE
  48. GO TO 800
  49. C-------------------------
  50. C CAS DU CHPOINT
  51. C-------------------------
  52. 700 CONTINUE
  53. MCHPOI=IVAL
  54. SEGACT MCHPOI
  55. NBSOUS=IPCHP(/1)
  56. C
  57. C BOUCLE SUR LES SOUS-ZONES DU CHPOINT
  58. C
  59. DO 11 I=1,NBSOUS
  60. MSOUPO=IPCHP(I)
  61. SEGACT MSOUPO
  62. DO 12 IC=1,NOCOMP(/2)
  63. IF(NOCOMP(IC).NE.MACOMP) GO TO 12
  64. IRET=.TRUE.
  65. GO TO 15
  66. 12 CONTINUE
  67. 11 CONTINUE
  68. IRET=.FALSE.
  69. 15 CONTINUE
  70. C
  71. 800 RETURN
  72. END
  73.  
  74.  
  75.  

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