Télécharger mecham.eso

Retour à la liste

Numérotation des lignes :

mecham
  1. C MECHAM SOURCE PV 17/12/05 21:16:44 9646
  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.  
  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. IF(N3.GE.4) THEN
  41. ISEG=INFCHE(J,4)
  42. IF(ISEG.NE.0) THEN
  43. ISLIS((ISEG-1)/npgcd)=1
  44. SEGDES ISEG
  45. ENDIF
  46. ENDIF
  47. DO 30 K=1,IELVAL(/1)
  48. MELVAL = IELVAL(K)
  49. IF (MELVAL.NE.0) THEN
  50. ISLIS((MELVAL-1)/npgcd)=1
  51. IF(TYPCHE(K)(1:8).EQ.'POINTEUR' .AND.
  52. * TYPCHE(K)(9:13).NE.'POINT' .AND.
  53. * TYPCHE(K)(9:15).NE.'LOGIQUE' .AND.
  54. * TYPCHE(K)(9:11).NE.'MOT' ) THEN
  55. SEGACT MELVAL
  56. NAL1=IELCHE(/1)
  57. NAL2=IELCHE(/2)
  58. DO 40 I2=1,NAL2
  59. DO 50 I1=1,NAL1
  60. ISEG=IELCHE(I1,I2)
  61. IF(ISEG.NE.0) THEN
  62. ISLIS((ISEG-1)/npgcd)=1
  63. SEGDES ISEG
  64. ENDIF
  65. 50 CONTINUE
  66. *
  67. 40 CONTINUE
  68. *
  69. ENDIF
  70. SEGDES,MELVAL
  71. ENDIF
  72. 30 CONTINUE
  73. * END DO
  74. SEGDES,MCHAML
  75. ENDIF
  76. 20 CONTINUE
  77. * END DO
  78. SEGDES,MCHELM
  79. ENDIF
  80. 10 CONTINUE
  81. * END DO
  82. *
  83. RETURN
  84. END
  85.  
  86.  
  87.  
  88.  
  89.  
  90.  
  91.  
  92.  
  93.  
  94.  
  95.  
  96.  

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