1 : C RESTME SOURCE CHAT 05/01/13 02:54:00 5004 2 : SUBROUTINE RESTME (ITLACC,IMAX1,ICOLAC,IDEB) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C======================================================================= 6 : C RESTAURATION DES POINTEURS 7 : C 8 : C APPELE PAR RESTPI 9 : C APPELLE : ERREUR 10 : C======================================================================= 11 : C 1 MELEME 2 CHPOIN 3 MRIGID 4 MCHAFF 5 MCHELM 6 MCLSTR 12 : C 7 MELSTR 8 MSOLUT 9 MSTRUC 10 11 MAFFEC 12 MSOSTU 13 : C 13 IMATRI 14 MJONCT 15 MATTAC 16 MMATRI 17 MDEFOR 18 MLREEL 14 : C 19 MLENTI 20 MCHARG 21 MODELE 22 MEVOLL 23 MSUPER 15 : C======================================================================= 16 : -INC CCOPTIO 17 : -INC SMELEME 18 : -INC TMCOLAC 19 : C======================================================================= 20 : C A EXAMINER. 21 : C APRES, CONTIENTPOUR CHAQUE PILE LE NBRE D'OBJETS A 22 : C SORTIR 23 : C======================================================================= 24 : C 25 : C 26 : C 27 : C****** BOUCLE SUR LES FILES DE SORTIE IFILE=1,NITLAC****************** 28 : C 29 : C ****************************** MELEME **************************** 30 : ITLAC1=KCOLA(32) 31 : 6001 CONTINUE 32 : DO 20 I=IDEB,IMAX1 33 : MELEME=ITLAC(I) 34 : IF (MELEME.EQ.0) GO TO 20 35 : SEGACT MELEME*MOD 36 : IF (LISOUS(/1).EQ.0) GOTO 21 37 : DO 1003 J=1,LISOUS(/1) 38 : LISOUS(J)=ITLAC(LISOUS(J)) 39 : 1003 CONTINUE 40 : 21 CONTINUE 41 : IF (LISREF(/1).EQ.0) GOTO 25 42 : DO 1004 J=1,LISREF(/1) 43 : LISREF(J)=ITLAC(LISREF(J)) 44 : 1004 CONTINUE 45 : 25 CONTINUE 46 : IF(NUM(/2).EQ.0) GO TO 60 47 : IF(IONIVE.GT.9) THEN 48 : DO 61 K2=1,NUM(/2) 49 : DO 61 K1=1,NUM(/1) 50 : NUM(K1,K2) = ITLAC1.ITLAC(NUM(K1,K2)) 51 : 61 CONTINUE 52 : ENDIF 53 : 60 CONTINUE 54 : SEGDES MELEME 55 : 20 CONTINUE 56 : GOTO 1098 57 : C*********************************************************************** 58 : 1098 CONTINUE 59 : C********************************************************************* 60 : C 61 : RETURN 62 : END 63 : 64 : 65 : 66 : 67 : 68 : 69 :
© Cast3M 2003 - All rights reserved.
Disclaimer