Télécharger exantk.eso

Retour à la liste

Numérotation des lignes :

  1. C EXANTK SOURCE PV 16/11/26 21:15:46 9205
  2. SUBROUTINE EXANTK (ICOLAC,ITLACC,M1,M2,IIICHA)
  3. C----------------------------------------------------------------------
  4. C
  5. C BUT: REMPLIT LES PILES A PARTIR DE L EXAMEN DES MATRIK
  6. C SI IIICHA =1 ON CHANGE LES POINTEURS----
  7. C completement pompe sur exachp
  8. C
  9. C ENTREE ITLACC POINTEUR DE LA PILE EXAMINEE
  10. C ICOLAC POINTEUR SUR LE CHAPEAU DES PILES
  11. C M1 @REMIER INDICE D EXAMEN DANS LA PILE
  12. C M2 DERNIER INDICE
  13. C IIICHA =1 ON CHANGE LES POINTEURS
  14. C----------------------------------------------------------------
  15. C APPELE PAR EXPIL
  16. C APPELLE AJOUN
  17. C=======================================================================
  18. C TABLEAU KCOLA: VOIR SIGNIFICATION DANS SOUS-PROGRAMME TYPFIL
  19. C=======================================================================
  20. C
  21. IMPLICIT INTEGER(I-N)
  22. IMPLICIT REAL*8(A-H,O-Z)
  23. POINTEUR IVA.MELEME
  24. -INC CCOPTIO
  25. -INC TMCOLAC
  26. ICO1=KCOLA(1)
  27. ICO2=KCOLA(2)
  28. ILISSE=ILISSG
  29. SEGACT ILISSE*MOD
  30. C 43 Objet MATRIK (déterminé dans MENAG6)
  31. ICO43=KCOLA(43)
  32. DO 604 IEL=M1,M2
  33. MATRIK=ITLAC(IEL)
  34. IF (MATRIK.EQ.0) GO TO 604
  35. SEGACT MATRIK*MOD
  36. NMATRI=IRIGEL(/2)
  37. DO 1 I=1,NMATRI
  38. IVA=IRIGEL(1,I)
  39. IF(IVA.GT.0)THEN
  40. SEGDES IVA
  41. CALL AJOUN(ICO1,IVA,ILISSE,1)
  42. IF(IIICHA.EQ.1) IRIGEL(1,I) =-IVA
  43. ENDIF
  44. IVA=IRIGEL(2,I)
  45. IF(IVA.GT.0)THEN
  46. SEGDES IVA
  47. CALL AJOUN(ICO1,IVA,ILISSE,1)
  48. IF(IIICHA.EQ.1) IRIGEL(2,I) =-IVA
  49. ENDIF
  50. IMATRI=IRIGEL(4,I)
  51. IF (IMATRI.NE.0) THEN
  52. SEGACT IMATRI*MOD
  53. IVA=KSPGP
  54. IF(IVA.GT.0)THEN
  55. SEGDES IVA
  56. CALL AJOUN(ICO1,IVA,ILISSE,1)
  57. IF(IIICHA.EQ.1) KSPGP =-IVA
  58. ENDIF
  59. IVA=KSPGD
  60. IF(IVA.GT.0)THEN
  61. SEGDES IVA
  62. CALL AJOUN(ICO1,IVA,ILISSE,1)
  63. IF(IIICHA.EQ.1) KSPGD =-IVA
  64. ENDIF
  65. SEGDES IMATRI
  66. ENDIF
  67. 1 CONTINUE
  68. IVA=KIZM
  69. IF(IVA.GT.0)THEN
  70. SEGDES IVA
  71. CALL AJOUN(ICO1,IVA,ILISSE,1)
  72. IF(IIICHA.EQ.1) KIZM =-IVA
  73. ENDIF
  74. IVA=KISPGT
  75. IF(IVA.GT.0)THEN
  76. SEGDES IVA
  77. CALL AJOUN(ICO1,IVA,ILISSE,1)
  78. IF(IIICHA.EQ.1) KISPGT =-IVA
  79. ENDIF
  80. IVA=KISPGP
  81. IF(IVA.GT.0)THEN
  82. SEGDES IVA
  83. CALL AJOUN(ICO1,IVA,ILISSE,1)
  84. IF(IIICHA.EQ.1) KISPGP =-IVA
  85. ENDIF
  86. IVA=KISPGD
  87. IF(IVA.GT.0)THEN
  88. SEGDES IVA
  89. CALL AJOUN(ICO1,IVA,ILISSE,1)
  90. IF(IIICHA.EQ.1) KISPGD =-IVA
  91. ENDIF
  92. IVA=KIDMAT(8)
  93. IF(IVA.GT.0)THEN
  94. SEGDES IVA
  95. CALL AJOUN(ICO2,IVA,ILISSE,1)
  96. IF(IIICHA.EQ.1) KIDMAT(8) =-IVA
  97. ENDIF
  98. IVA=KKMMT(2)
  99. IF(IVA.GT.0)THEN
  100. SEGDES IVA
  101. CALL AJOUN(ICO43,IVA,ILISSE,1)
  102. IF(IIICHA.EQ.1) KKMMT(2) =-IVA
  103. ENDIF
  104. IVA=KKMMT(3)
  105. IF(IVA.GT.0)THEN
  106. SEGDES IVA
  107. CALL AJOUN(ICO43,IVA,ILISSE,1)
  108. IF(IIICHA.EQ.1) KKMMT(3) =-IVA
  109. ENDIF
  110. SEGDES MATRIK
  111. 604 CONTINUE
  112. * SEGDES ILISSE
  113. C ************
  114. RETURN
  115. END
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  

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