1 : C RESTCH SOURCE CHAT 07/07/11 21:15:11 5788 2 : SUBROUTINE RESTCH (ICOLAC,ITLACC,IMAX1,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 TABLEAU KCOLA : 12 : C 1 MELEME 2 CHPOIN 3 MRIGID 4 MCHAFF 5 MCHELM 6 MCLSTR 13 : C 7 MELSTR 8 MSOLUT 9 MSTRUC 10 11 MAFFEC 12 MSOSTU 14 : C 13 IMATRI 14 MJONCT 15 MATTAC 16 MMATRI 17 MDEFOR 18 MLREEL 15 : C 19 MLENTI 20 MCHARG 21 MODELE 22 MEVOLL 23 MSUPER 16 : C======================================================================= 17 : -INC CCOPTIO 18 : -INC SMCHPOI 19 : -INC TMCOLAC 20 : C 21 : C **************************CHPOINT********************************* 22 : 6002 CONTINUE 23 : ITLAC1=KCOLA(1) 24 : DO 1101 IEL=IDEB,IMAX1 25 : MCHPOI=ITLAC(IEL) 26 : IF (MCHPOI.EQ.0) GO TO 1101 27 : SEGACT MCHPOI 28 : NSOUPO=IPCHP(/1) 29 : IJK=IPCHP(/1) 30 : IF (IJK.EQ.0) GO TO 10 31 : DO 1103 ISOU=1,NSOUPO 32 : MSOUPO=IPCHP(ISOU) 33 : IF (MSOUPO.EQ.0) GO TO 1103 34 : SEGACT MSOUPO*MOD 35 : IVA=ABS(IGEOC) 36 : nnb=itlac1.itlac(/1) 37 : * IF (IVA.NE.0) IGEOC=ITLAC1.ITLAC(IVA) MILL 3 / 9 / 92 38 : IF (IVA.NE.0) IGEOC=ITLAC1.ITLAC(IVA) 39 : * IF (IGEOC.LT.0) IGEOC=ITLAC1.ITLAC(IVA) 40 : SEGDES MSOUPO 41 : 1103 CONTINUE 42 : 10 SEGDES MCHPOI 43 : 1101 CONTINUE 44 : GOTO 1098 45 : C*********************************************************************** 46 : 1098 CONTINUE 47 : C 48 : RETURN 49 : END 50 : 51 : 52 : 53 : 54 : 55 : 56 : 57 : 58 :
© Cast3M 2003 - All rights reserved.
Disclaimer