Télécharger exachp.eso

Retour à la liste

Numérotation des lignes :

  1. C EXACHP SOURCE PV 16/11/26 21:15:44 9205
  2. SUBROUTINE EXACHP (ICOLAC,ITLACC,M1,M2,IIICHA)
  3. C----------------------------------------------------------------------
  4. C
  5. C BUT: REMPLIT LES PILES A PARTIR DE L EXAMEN DES CHPOINTS
  6. C SI IIICHA =1 ON CHANGE LES POINTEURS----
  7. C
  8. C ENTREE ITLACC POINTEUR DE LA PILE EXAMINEE
  9. C ICOLAC POINTEUR SUR LE CHAPEAU DES PILES
  10. C M1 @REMIER INDICE D EXAMEN DANS LA PILE
  11. C M2 DERNIER INDICE
  12. C IIICHA =1 ON CHANGE LES POINTEURS
  13. C----------------------------------------------------------------
  14. C APPELE PAR EXPIL
  15. C APPELLE AJOUN
  16. C
  17. C=======================================================================
  18. C TABLEAU KCOLA :
  19. C 1 MELEME 2 CHPOIN 3 MRIGID 4 MCHAFF 5 MCHELM 6
  20. C 7 8 MSOLUT 9 MSTRUC 10 11 MAFFEC 12 MSOSTU
  21. C 13 IMATRI 14 MJONCT 15 MATTAC 16 MMATRI 17 MDEFOR 18 MLREEL
  22. C 19 MLENTI 20 MCHARG 21 MODELE 22 MEVOLL 23 MSUPER
  23. C=======================================================================
  24. C
  25. IMPLICIT INTEGER(I-N)
  26. IMPLICIT REAL*8(A-H,O-Z)
  27. logical ooovp1
  28. -INC SMCHPOI
  29. -INC CCOPTIO
  30. -INC TMCOLAC
  31. ICO1=KCOLA(1)
  32. ILISSE=ILISSG
  33. SEGACT ILISSE*MOD
  34. DO 604 IEL=M1,m2
  35. MCHPOI=ITLAC(IEL)
  36. IF (MCHPOI.EQ.0) GO TO 604
  37. if (.NOT.ooovp1(mchpoi)) goto 610
  38. SEGACT MCHPOI
  39. IJK=IPCHP(/1)
  40. IF (IJK.EQ.0) GO TO 606
  41. if (ijk.gt.1000) GOTO 610
  42. DO 605 I=1,IJK
  43. MSOUPO=IPCHP(I)
  44. IF (MSOUPO.EQ.0) GO TO 610
  45. if (.NOT.ooovp1(msoupo)) goto 610
  46. SEGACT MSOUPO*MOD
  47. IVA=IGEOC
  48. * compression des meleme si possible
  49. if (iva.gt.0) then
  50. call chleha(0,iva,ivas,ico1)
  51. if (ivas.ne.0) then
  52. iva=ivas
  53. igeoc = iva
  54. ** call ecchpo(mchpoi,1)
  55. segact mchpoi
  56. SEGACT MSOUPO*MOD
  57. endif
  58. endif
  59. IF (IVA.GT.0) THEN
  60. CALL AJOUN(ICO1,IVA,ILISSE,1)
  61. IF(IIICHA.EQ.1) IGEOC =-IVA
  62. ENDIF
  63. SEGDES MSOUPO
  64. 605 CONTINUE
  65. 606 SEGDES MCHPOI
  66. goto 604
  67. 610 continue
  68. * chpoint invalide. On le supprime de la pile
  69. moterr(1:8)='CHPOINT'
  70. interr(1)=itlac(iel)
  71. call erreur(861)
  72. itlac(iel)=0
  73. 604 CONTINUE
  74. RETURN
  75. C ************
  76. END
  77.  
  78.  
  79.  
  80.  
  81.  
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  
  88.  
  89.  

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