1 : C EXAMTK SOURCE CHAT 05/01/12 23:47:59 5004 2 : SUBROUTINE EXAMTK (ICOLAC,ITLACC,M1,M2,IIICHA) 3 : C---------------------------------------------------------------------- 4 : C 5 : C BUT: REMPLIT LES PILES A PARTIR DE L EXAMEN DES MATRAK 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======================================================================= 19 : C TABLEAU KCOLA : 20 : C 1 MELEME 2 CHPOIN 3 MRIGID 4 MCHAFF 5 MCHELM 6 21 : C 7 8 MSOLUT 9 MSTRUC 10 11 MAFFEC 12 MSOSTU 22 : C 13 IMATRI 14 MJONCT 15 MATTAC 16 MMATRI 17 MDEFOR 18 MLREEL 23 : C 19 MLENTI 20 MCHARG 21 MODELE 22 MEVOLL 23 MSUPER 24 : C======================================================================= 25 : C 26 : IMPLICIT INTEGER(I-N) 27 : IMPLICIT REAL*8(A-H,O-Z) 28 : C-INC SMMATRAKANC 29 : C************************************************************************* 30 : C 31 : C REPERAGE ET STOKAGE DES MATRICES ELEMENTAIRES puis assemblees 32 : C 33 : 34 : * LGEOC SPG de la pression et/ou des multiplicateurs de Lagrange 35 : * (points CENTRE ) pour chaque operateur de contrainte 36 : * KGEOC SPG pour la totalite des points CENTRE. 37 : * KGEOS SPG pour la totalite des points SOMMET (Diagonale vitesse) 38 : * KLEMC Connectivites de l'ensemble des contraintes 39 : * LIZAFM(NBSOUS) contient les pointeurs IZAFM des sous-zones 40 : 41 : SEGMENT MATRAK 42 : INTEGER LGEOC(NBOP),IDEBS(NBOP),IFINS(NBOP) 43 : INTEGER LIZAFM(NBSOUS) 44 : INTEGER IKAM0 (NBSOUS) 45 : INTEGER IMEM (NBELC) 46 : INTEGER KLEMC,KGEOS,KGEOC,KDIAG,KCAC,KIZCL,KIZGC 47 : ENDSEGMENT 48 : 49 : SEGMENT IZAFM 50 : REAL*8 AM(NNELP,NP,IESP),RPGI(NELAX) 51 : ENDSEGMENT 52 : 53 : POINTEUR IPMJ.IZAFM,IPMK.IZAFM 54 : 55 : C******************************************************************* 56 : POINTEUR IVA.MELEME 57 : -INC CCOPTIO 58 : -INC TMCOLAC 59 : ICO1=KCOLA(1) 60 : ICO2=KCOLA(2) 61 : ILISSE=ILISSG 62 : SEGACT ILISSE*MOD 63 : DO 604 IEL=M1,M2 64 : MATRAK=ITLAC(IEL) 65 : IF (MATRAK.EQ.0) GO TO 604 66 : SEGACT MATRAK*MOD 67 : NBOP=LGEOC(/1) 68 : IF (NBOP.NE.0)THEN 69 : DO 605 I=1,NBOP 70 : IVA=LGEOC(I) 71 : IF (IVA.GT.0) THEN 72 : SEGDES IVA 72 : CALL AJOUN(ICO1,IVA,ILISSE,1) 73 : IF(IIICHA.EQ.1) LGEOC(I) =-IVA 74 : ENDIF 75 : 605 CONTINUE 76 : ENDIF 77 : IVA=KLEMC 78 : IF (IVA.GT.0) THEN 79 : SEGDES IVA 79 : CALL AJOUN(ICO1,IVA,ILISSE,1) 80 : IF(IIICHA.EQ.1) KLEMC =-IVA 81 : ENDIF 82 : IVA=KGEOS 83 : IF (IVA.GT.0) THEN 84 : SEGDES IVA 84 : CALL AJOUN(ICO1,IVA,ILISSE,1) 85 : IF(IIICHA.EQ.1) KGEOS =-IVA 86 : ENDIF 87 : IVA=KGEOC 88 : IF (IVA.GT.0) THEN 89 : SEGDES IVA 89 : CALL AJOUN(ICO1,IVA,ILISSE,1) 90 : IF(IIICHA.EQ.1) KGEOC =-IVA 91 : ENDIF 92 : IVA=KDIAG 93 : IF (IVA.GT.0) THEN 94 : SEGDES IVA 94 : CALL AJOUN(ICO2,IVA,ILISSE,1) 95 : IF(IIICHA.EQ.1) KDIAG =-IVA 96 : ENDIF 97 : SEGDES MATRAK 98 : 604 CONTINUE 99 : * SEGDES ILISSE 100 : RETURN 101 : C ************ 102 : END 103 : 104 : 105 : 106 : 107 : 108 : 109 : 110 : 111 : 112 : 113 : 114 : 115 :
© Cast3M 2003 - All rights reserved.
Disclaimer