Télécharger excoc1.eso

Retour à la liste

Numérotation des lignes :

  1. C EXCOC1 SOURCE CB215821 19/08/20 21:17:20 10287
  2. SUBROUTINE EXCOC1(IPCH1,MOT,IPCH2,MOT2,IVID)
  3. *-----------------------------------------------------------------------
  4. * EXTRACTION D UNE COMPOSANTE D UN NOUVEAU CHAMELEM
  5. * ROUTINE APPELLEE PAR L OPERATEUR EXCOMP
  6. * ENTREE
  7. * IPCH1= POINTEUR SUR UN CHAMELEM
  8. * MOT = NOM DE LA COMPOSANTE A EXTRAIRE
  9. * MOT2 = NOM DE LA COMPOSANTE
  10. * IVID = 1 SI ON A LU LE MOT 'NOID', 0 SINON
  11. * SORTIE
  12. * IPCH2= POINTEUR SUR LE CHPOINT CONTENANT UNIQUEMENT LA
  13. * COMPOSANTE MOT2
  14. *-----------------------------------------------------------------------
  15. IMPLICIT INTEGER(I-N)
  16. IMPLICIT REAL*8(A-H,O-Z)
  17. CHARACTER*4 MOT,MOT2
  18. CHARACTER*8 LEMOT
  19. -INC SMCHAML
  20. -INC CCOPTIO
  21. *
  22. SEGMENT MTRI
  23. INTEGER IPOI(n1l)
  24. ENDSEGMENT
  25. SEGMENT MTRA
  26. INTEGER LRAN(n1l)
  27. ENDSEGMENT
  28. SEGMENT MTRB
  29. CHARACTER*16 TYPT(n1l)
  30. ENDSEGMENT
  31. *
  32. MCHEL1=IPCH1
  33. SEGACT MCHEL1
  34. NZON1=MCHEL1.ICHAML(/1)
  35. *
  36. * INITIALISATION DES SEGMENTS DE TRAVAIL
  37. *
  38. n1=0
  39. n1l=500
  40. SEGINI MTRI,MTRA,MTRB
  41. *
  42. * BOUCLE SUR LES ZONES
  43. *
  44. DO 100 IA=1,NZON1
  45. MCHAM1=MCHEL1.ICHAML(IA)
  46. SEGACT MCHAM1
  47. NCP=MCHAM1.NOMCHE(/2)
  48. DO 110 IB=1,NCP
  49. LEMOT=MCHAM1.NOMCHE(IB)
  50. IF (MOT.EQ.LEMOT(1:4)) THEN
  51. IBCOM=IB
  52. GOTO 120
  53. ENDIF
  54. 110 CONTINUE
  55. GOTO 100
  56. *
  57. 120 CONTINUE
  58. MELVA1=MCHAM1.IELVAL(IBCOM)
  59. SEGACT MELVA1
  60. SEGINI,MELVAL=MELVA1
  61. n1=n1+1
  62. if (n1.gt.n1l) then
  63. n1l=n1l+500
  64. segadj mtri,mtra,mtrb
  65. endif
  66. IPOI(n1)=MELVAL
  67. LRAN(n1)=IA
  68. TYPT(n1)=MCHAM1.TYPCHE(IBCOM)
  69. 100 CONTINUE
  70. *
  71. * ON REMPLIT LE CHAMELEM
  72. *
  73. L1=mchel1.titche(/1)
  74. *** N1=IPOI(/1)
  75. N3=MCHEL1.INFCHE(/2)
  76. N2=1
  77. *
  78. IF (N1.EQ.0) THEN
  79. IF (IVID.EQ.1) THEN
  80. SEGINI MCHELM
  81. IPCH2 = MCHELM
  82. TITCHE= mchel1.titche
  83. IFOCHE=MCHEL1.IFOCHE
  84. ELSE
  85. MOTERR(1:4)=MOT
  86. CALL ERREUR(236)
  87. ENDIF
  88. GOTO 666
  89. ENDIF
  90. *
  91. * CREATION DU CHAPEAU DU CHAMELEM
  92. *
  93. SEGINI MCHELM
  94. IPCH2=MCHELM
  95. TITCHE=mchel1.titche
  96. IFOCHE=MCHEL1.IFOCHE
  97. *
  98. * BOUCLE SUR LES ZONES
  99. *
  100. DO 400 IA=1,N1
  101. IACON=LRAN(IA)
  102. DO 401 IAA=1,N3
  103. INFCHE(IA,IAA)=MCHEL1.INFCHE(IACON,IAA)
  104. 401 CONTINUE
  105. IMACHE(IA)=MCHEL1.IMACHE(IACON)
  106. CONCHE(IA)=MCHEL1.CONCHE(IACON)
  107. SEGINI,MCHAML
  108. ICHAML(IA)=MCHAML
  109. LEMOT(1:4)=MOT2
  110. NOMCHE(1)=LEMOT
  111. TYPCHE(1)=TYPT(IA)
  112. IELVAL(1) = IPOI(IA)
  113. 400 CONTINUE
  114. *
  115. 666 CONTINUE
  116. *
  117. * SUPPRESSION DES SEGMENTS DE TRAVAIL
  118. *
  119. SEGSUP MTRI,MTRA,MTRB
  120. END
  121.  
  122.  
  123.  

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