exachp
C EXACHP SOURCE PV 21/01/21 21:15:16 10862 C---------------------------------------------------------------------- C C BUT: REMPLIT LES PILES A PARTIR DE L EXAMEN DES CHPOINTS C SI IIICHA =1 ON CHANGE LES POINTEURS---- C C ENTREE ITLACC POINTEUR DE LA PILE EXAMINEE C ICOLAC POINTEUR SUR LE CHAPEAU DES PILES C M1 @REMIER INDICE D EXAMEN DANS LA PILE C M2 DERNIER INDICE C IIICHA =1 ON CHANGE LES POINTEURS C---------------------------------------------------------------- C APPELE PAR EXPIL C APPELLE AJOUN C C======================================================================= C TABLEAU KCOLA : C 1 MELEME 2 CHPOIN 3 MRIGID 4 MCHAFF 5 MCHELM 6 C 7 8 MSOLUT 9 MSTRUC 10 11 MAFFEC 12 MSOSTU C 13 IMATRI 14 MJONCT 15 MATTAC 16 MMATRI 17 MDEFOR 18 MLREEL C 19 MLENTI 20 MCHARG 21 MODELE 22 MEVOLL 23 MSUPER C======================================================================= C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) logical ooovp1 -INC SMCHPOI -INC PPARAM -INC CCOPTIO -INC TMCOLAC -INC SMCOORD -INC SMELEME iun=1 ICO1=KCOLA(1) ILISSE=ILISSG SEGACT ILISSE*MOD DO 604 IEL=M1,m2 MCHPOI=ITLAC(IEL) IF (MCHPOI.EQ.0) GO TO 604 if (.NOT.ooovp1(mchpoi)) goto 610 SEGACT MCHPOI IJK=IPCHP(/1) IF (IJK.EQ.0) GO TO 606 if (ijk.gt.1000) GOTO 610 DO 605 I=1,IJK MSOUPO=IPCHP(I) IF (MSOUPO.EQ.0) GO TO 610 if (.NOT.ooovp1(msoupo)) goto 610 SEGACT MSOUPO*MOD IVA=IGEOC if (.NOT.ooovp1(iva)) goto 610 meleme=igeoc segact meleme if (num(/1).ne.1.or.num(/2).gt.nbpts) goto 610 * compression des meleme si possible if (iva.gt.0) then ivas=0 ***trop couteux pour le gain si il y a beaucoup de meleme donc uniquement dans la sauvegarde if (ivas.ne.0) then iva=ivas igeoc = iva endif endif IF (IVA.GT.0) THEN IF(IIICHA.EQ.1) IGEOC =-IVA ENDIF SEGDES MSOUPO 605 CONTINUE 606 SEGDES MCHPOI goto 604 610 continue * chpoint invalide. On le supprime de la pile moterr(1:8)='CHPOINT' interr(1)=itlac(iel) itlac(iel)=0 604 CONTINUE RETURN C ************ END
© Cast3M 2003 - Tous droits réservés.
Mentions légales