1 : C EXAMEL SOURCE CHAT 05/01/12 23:47:55 5004 2 : SUBROUTINE EXAMEL (ICOLAC,ITLACC,M1,M2,IIICHA) 3 : C---------------------------------------------------------------------- 4 : C 5 : C BUT: REMPLIT LES PILES A PARTIR DE L EXAMEN DE LA PILE 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 SMELEME 29 : -INC CCOPTIO 30 : -INC TMCOLAC 31 : -INC SMCOORD 32 : SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) 33 : ICO1=KCOLA(1) 34 : ICO2=KCOLA(32) 35 : ILISSE=ILISSG 36 : SEGACT ILISSE*MOD 37 : ITLAC1=ICO2 38 : SEGINI ICPR 39 : IFAIT = ITLAC1.ITLAC(/1) 40 : DO 710 IHU=1,IFAIT 41 : IAM=ITLAC1.ITLAC(IHU) 42 : ICPR(IAM)=IHU 43 : 710 CONTINUE 44 : DO 601 IEL=M1,M2 45 : MELEME=ITLAC(IEL) 46 : C WRITE (IOIMP,8876) MELEME 47 : IF (MELEME.EQ.0) GO TO 601 48 : if (.NOT.ooovp1(meleme)) goto 610 49 : C8876 FORMAT(' MELEME',I6) 50 : SEGACT MELEME*MOD 51 : IF(LISOUS(/1).EQ.0) GO TO 602 52 : IF (LISOUS(/1).LT.0) GOTO 610 53 : DO 603 I=1,LISOUS(/1) 54 : IVA=LISOUS(I) 55 : if (IIICHA.EQ.1.AND..NOT.ooovp1(iva)) goto 610 55 : CALL AJOUN(ICO1,IVA,ILISSE,1) 56 : IF(IIICHA.EQ.1)LISOUS(I)=IVA 57 : 603 CONTINUE 58 : 602 CONTINUE 59 : IF(LISREF(/1).EQ.0) GO TO 645 60 : IF (LISREF(/1).GT.1000) GOTO 610 61 : IF (LISREF(/1).LT.0) GOTO 610 62 : DO 646 I=1,LISREF(/1) 63 : IVA=LISREF(I) 64 : if (IIICHA.EQ.1.AND..NOT.ooovp1(iva)) goto 610 64 : CALL AJOUN(ICO1,IVA,ILISSE,1) 65 : IF(IIICHA.EQ.1)LISREF(I)=IVA 66 : 646 CONTINUE 67 : 645 CONTINUE 68 : IF(NUM(/2).EQ.0) GO TO 660 69 : DO 661 K2=1,NUM(/2) 70 : DO 661 K1=1,NUM(/1) 71 : IVA=NUM(K1,K2) 72 : if (iva.gt.icpr(/1).or.iva.le.0) goto 610 73 : IF(ICPR(IVA).EQ.0) THEN 74 : IFAIT = IFAIT + 1 75 : ICPR(IVA)=IFAIT 76 : * ITLAC1.ITLAC(**)= IVA 76 : * CALL AJOUN(ICO2,IVA,) 77 : ENDIF 78 : IF(IIICHA.EQ.1) NUM(K1,K2)=ICPR(IVA) 79 : 661 CONTINUE 80 : 660 CONTINUE 81 : SEGDES MELEME 82 : GOTO 601 83 : 610 continue 84 : * meleme invalide. On le supprime de la pile 85 : moterr(1:8)='MAILLAGE' 86 : interr(1)=itlac(iel) 86 : call erreur(861) 87 : itlac(iel)=0 88 : 601 CONTINUE 88 : C# MC IF(IICHA.NE.1) CALL ITLACT (ICPR,ITLAC1,IFAIT) 88 : IF(IIICHA.NE.1) CALL ITLACT (ICPR,ITLAC1,IFAIT,ILISSE) 89 : SEGSUP ICPR 90 : * SEGDES ILISSE 91 : RETURN 92 : C ************ 93 : END 94 : 95 : 96 : 97 : 98 : 99 : 100 : 101 : 102 : 103 :
© Cast3M 2003 - All rights reserved.
Disclaimer