Télécharger mecham.eso

Retour à la liste

Numérotation des lignes :

  1. C MECHAM SOURCE PV 16/11/26 21:16:09 9205
  2. SUBROUTINE MECHAM(ILISSE,IPLIS,IPOLAC)
  3. *--------------------------------------------------------------------*
  4. * *
  5. * Sous-programme de la directive MENAGE: nouveau CHAMELEM *
  6. * _______________________________________________________ *
  7. * *
  8. * Param}tres: *
  9. * *
  10. * es IPLIS pointeur sur le segment ISLIS ( suppos{ actif ) *
  11. * es IPOLAC pointeur sur le segment ICOLAC ( suppos{ actif ) *
  12. * *
  13. *--------------------------------------------------------------------*
  14. IMPLICIT INTEGER(I-N)
  15. -INC CCOPTIO
  16. -INC SMCHAML
  17. -INC TMCOLAC
  18. SEGMENT ISLIS(NP)
  19. SEGMENT ISEG(0)
  20. *
  21. ISLIS = IPLIS
  22. ICOLAC = IPOLAC
  23. *
  24. * Cas du nouveau CHAMELEM : MCHAML
  25. *
  26. ITLACC = KCOLA(39)
  27. DO 10 I=1,ITLAC(/1)
  28. MCHELM = ITLAC(I)
  29. IF (MCHELM.NE.0) THEN
  30. ISLIS(( MCHELM-1)/npgcd)=1
  31. SEGACT,MCHELM
  32. N3=INFCHE(/2)
  33. DO 20 J=1,ICHAML(/1)
  34. MCHAML = ICHAML(J)
  35. IF (MCHAML.NE.0) THEN
  36. ISLIS((MCHAML-1)/npgcd)=1
  37. SEGACT,MCHAML
  38. IF(N3.GE.4) THEN
  39. ISEG=INFCHE(J,4)
  40. IF(ISEG.NE.0) THEN
  41. ISLIS((ISEG-1)/npgcd)=1
  42. SEGDES ISEG
  43. ENDIF
  44. ENDIF
  45. DO 30 K=1,IELVAL(/1)
  46. MELVAL = IELVAL(K)
  47. IF (MELVAL.NE.0) THEN
  48. ISLIS((MELVAL-1)/npgcd)=1
  49. IF(TYPCHE(K)(1:8).EQ.'POINTEUR' .AND.
  50. * TYPCHE(K)(9:13).NE.'POINT' .AND.
  51. * TYPCHE(K)(9:15).NE.'LOGIQUE' .AND.
  52. * TYPCHE(K)(9:11).NE.'MOT' ) THEN
  53. SEGACT MELVAL
  54. NAL1=IELCHE(/1)
  55. NAL2=IELCHE(/2)
  56. DO 40 I2=1,NAL2
  57. DO 50 I1=1,NAL1
  58. ISEG=IELCHE(I1,I2)
  59. IF(ISEG.NE.0) THEN
  60. ISLIS((ISEG-1)/npgcd)=1
  61. SEGDES ISEG
  62. ENDIF
  63. 50 CONTINUE
  64. *
  65. 40 CONTINUE
  66. *
  67. ENDIF
  68. SEGDES,MELVAL
  69. ENDIF
  70. 30 CONTINUE
  71. * END DO
  72. SEGDES,MCHAML
  73. ENDIF
  74. 20 CONTINUE
  75. * END DO
  76. SEGDES,MCHELM
  77. ENDIF
  78. 10 CONTINUE
  79. * END DO
  80. *
  81. RETURN
  82. END
  83.  
  84.  
  85.  
  86.  
  87.  
  88.  
  89.  
  90.  
  91.  
  92.  
  93.  

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