Télécharger mecham.eso

Retour à la liste

Numérotation des lignes :

mecham
  1. C MECHAM SOURCE OF166741 24/10/03 21:15:25 12022
  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 ( suppose actif ) *
  11. * es IPOLAC pointeur sur le segment ICOLAC ( suppose actif ) *
  12. * *
  13. *--------------------------------------------------------------------*
  14. IMPLICIT INTEGER(I-N)
  15.  
  16. -INC PPARAM
  17. -INC CCOPTIO
  18. -INC SMCHAML
  19. -INC TMCOLAC
  20. SEGMENT ISLIS(NP)
  21. SEGMENT ISEG(0)
  22.  
  23. ISLIS = IPLIS
  24. ICOLAC = IPOLAC
  25. *
  26. * Cas du nouveau CHAMELEM : MCHAML
  27. *
  28. ITLACC = KCOLA(39)
  29. DO 10 I=1,ITLAC(/1)
  30. MCHELM = ITLAC(I)
  31. IF (MCHELM.NE.0) THEN
  32. ISLIS(( MCHELM-1)/npgcd)=1
  33. SEGACT,MCHELM
  34. N3=INFCHE(/2)
  35. DO 20 J=1,ICHAML(/1)
  36. MCHAML = ICHAML(J)
  37. IF (MCHAML.NE.0) THEN
  38. ISLIS((MCHAML-1)/npgcd)=1
  39. SEGACT,MCHAML
  40. ISEG=INFCHE(J,4)
  41. IF(ISEG.NE.0) THEN
  42. ISLIS((ISEG-1)/npgcd)=1
  43. SEGDES ISEG
  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.  

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