1 : C EXANTK SOURCE FANDEUR 10/12/14 21:16:17 6812 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 : -INC SMMATRIK 24 : POINTEUR IVA.MELEME 25 : -INC CCOPTIO 26 : -INC TMCOLAC 27 : ICO1=KCOLA(1) 28 : ICO2=KCOLA(2) 29 : ILISSE=ILISSG 30 : SEGACT ILISSE*MOD 31 : C 43 Objet MATRIK (déterminé dans MENAG6) 32 : ICO43=KCOLA(43) 33 : DO 604 IEL=M1,M2 34 : MATRIK=ITLAC(IEL) 35 : IF (MATRIK.EQ.0) GO TO 604 36 : SEGACT MATRIK*MOD 37 : NMATRI=IRIGEL(/2) 38 : DO 1 I=1,NMATRI 39 : IVA=IRIGEL(1,I) 40 : IF(IVA.GT.0)THEN 41 : 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 46 : CALL AJOUN(ICO1,IVA,ILISSE,1) 47 : IF(IIICHA.EQ.1) IRIGEL(2,I) =-IVA 48 : ENDIF 49 : IMATRI=IRIGEL(4,I) 50 : IF (IMATRI.NE.0) THEN 51 : SEGACT IMATRI*MOD 52 : IVA=KSPGP 53 : IF(IVA.GT.0)THEN 54 : SEGDES IVA 54 : CALL AJOUN(ICO1,IVA,ILISSE,1) 55 : IF(IIICHA.EQ.1) KSPGP =-IVA 56 : ENDIF 57 : IVA=KSPGD 58 : IF(IVA.GT.0)THEN 59 : SEGDES IVA 59 : CALL AJOUN(ICO1,IVA,ILISSE,1) 60 : IF(IIICHA.EQ.1) KSPGD =-IVA 61 : ENDIF 62 : SEGDES IMATRI 63 : ENDIF 64 : 1 CONTINUE 65 : IVA=KIZM 66 : IF(IVA.GT.0)THEN 67 : SEGDES IVA 67 : CALL AJOUN(ICO1,IVA,ILISSE,1) 68 : IF(IIICHA.EQ.1) KIZM =-IVA 69 : ENDIF 70 : IVA=KISPGT 71 : IF(IVA.GT.0)THEN 72 : SEGDES IVA 72 : CALL AJOUN(ICO1,IVA,ILISSE,1) 73 : IF(IIICHA.EQ.1) KISPGT =-IVA 74 : ENDIF 75 : IVA=KISPGP 76 : IF(IVA.GT.0)THEN 77 : SEGDES IVA 77 : CALL AJOUN(ICO1,IVA,ILISSE,1) 78 : IF(IIICHA.EQ.1) KISPGP =-IVA 79 : ENDIF 80 : IVA=KISPGD 81 : IF(IVA.GT.0)THEN 82 : SEGDES IVA 82 : CALL AJOUN(ICO1,IVA,ILISSE,1) 83 : IF(IIICHA.EQ.1) KISPGD =-IVA 84 : ENDIF 85 : IVA=KIDMAT(8) 86 : IF(IVA.GT.0)THEN 87 : SEGDES IVA 87 : CALL AJOUN(ICO2,IVA,ILISSE,1) 88 : IF(IIICHA.EQ.1) KIDMAT(8) =-IVA 89 : ENDIF 90 : IVA=KKMMT(2) 91 : IF(IVA.GT.0)THEN 92 : SEGDES IVA 92 : CALL AJOUN(ICO43,IVA,ILISSE,1) 93 : IF(IIICHA.EQ.1) KKMMT(2) =-IVA 94 : ENDIF 95 : IVA=KKMMT(3) 96 : IF(IVA.GT.0)THEN 97 : SEGDES IVA 97 : CALL AJOUN(ICO43,IVA,ILISSE,1) 98 : IF(IIICHA.EQ.1) KKMMT(3) =-IVA 99 : ENDIF 100 : SEGDES MATRIK 101 : 604 CONTINUE 102 : * SEGDES ILISSE 103 : C ************ 104 : RETURN 105 : END 106 : 107 :
© Cast3M 2003 - All rights reserved.
Disclaimer