C LIMMAT SOURCE PV 20/09/26 21:18:38 10724 SUBROUTINE LIMMAT (IENTRE,ITLACC,IMAX1,IRET,IFORM) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) C======================================================================= C BUT : LECTURE DES MMATRI C APPELE PAR : LIPIL C APPELLE : LFCDIM LFCDIE LFCDI2 C ECRIT PAR FARVACQUE -REPRIS PAR LENA 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 C======================================================================= -INC PPARAM -INC CCOPTIO -INC SMMATRI C C======================================================================= SEGMENT/ITBBM1/( ITABM1(NM)) SEGMENT/ITLACC/( ITLAC(0)) C CHARACTER*4 CPV DIMENSION ILENA(15) C-------------------------------------------------------------------- IRET=0 IRETOU=0 ITBBM1=0 C ***************************** MMATRI ***************************** 6016 CONTINUE DO 2600 IEL=1,IMAX1 SEGINI MMATRI ITLAC(**)=MMATRI C READ(IENTRE,8000,END=1000,ERR=1000)INC,IGEOMA,IJMAX,INEG,NENS,MAXI, C *NNOE,LHAR IF(IONIVE.LE.8) THEN ITOTO = 10 INSYM = 0 ELSE ITOTO = 11 ENDIF CALL LFCDIE (IENTRE,ITOTO,ILENA,IRETOU,IFORM) IF (IRETOU.NE.0) GO TO 1000 INC = ILENA(1) IGEOMA= ILENA(2) IJMAX = ILENA(3) INEG = ILENA(4) NENS = ILENA(5) MAXI = ILENA(6) NNOE = ILENA(7) LHAR = ILENA(8) LMIK = ILENA(9) LDUA = ILENA(10) IF(IONIVE.GE.9) INSYM = ILENA(11) SEGINI MILIGN CALL LFCDIE(IENTRE,INC,ITTR,IRETOU,IFORM) IF(IRETOU.NE.0) GOTO 1000 CALL LFCDIE(IENTRE,INC,IPNO,IRETOU,IFORM) IF(IRETOU.NE.0) GOTO 1000 DO 2601 I=1,NNOE ITOTO=7 CALL LFCDIE (IENTRE,ITOTO,ILENA,IRETOU,IFORM) IF (IRETOU.NE.0) GO TO 1000 NVALL = ILENA(1) NA = ILENA(2) NBPAR = ILENA(7) SEGINI LIGN ILIGN(I)=LIGN NA1 = ILENA(3) IMM = ILENA(4) IPREL = ILENA(5) IDERL = ILENA(6) CALL LFCDI2(IENTRE,NVALL,VAL,IRETOU,IFORM) IF (IRETOU.NE.0) GO TO 1000 CALL LFCDIE(IENTRE,NA,IMMM,IRETOU,IFORM) IF (IRETOU.NE.0) GO TO 1000 CALL LFCDIE(IENTRE,NA1,IPPVV,IRETOU,IFORM) IF (IRETOU.NE.0) GO TO 1000 CALL LFCDIE(IENTRE,2*NBPAR,IVPO,IRETOU,IFORM) SEGDES LIGN IF(IRETOU.NE.0) GOTO 1000 2601 CONTINUE IILIGN=MILIGN SEGDES MILIGN C IF(INSYM.NE.0) THEN SEGINI MILIGN DO 26011 I=1,NNOE ITOTO=7 CALL LFCDIE (IENTRE,ITOTO,ILENA,IRETOU,IFORM) IF (IRETOU.NE.0) GO TO 1000 NVALL = ILENA(1) NA = ILENA(2) NBPAR = ILENA(7) SEGINI LIGN ILIGN(I)=LIGN NA1 = ILENA(3) IMM = ILENA(4) IPREL = ILENA(5) IDERL = ILENA(6) CALL LFCDI2(IENTRE,NVALL,VAL,IRETOU,IFORM) IF (IRETOU.NE.0) GO TO 1000 CALL LFCDIE(IENTRE,NA,IMMM,IRETOU,IFORM) IF (IRETOU.NE.0) GO TO 1000 CALL LFCDIE(IENTRE,NA1,IPPVV,IRETOU,IFORM) IF (IRETOU.NE.0) GO TO 1000 CALL LFCDIE(IENTRE,2*NBPAR,IVPO,IRETOU,IFORM) SEGDES LIGN IF(IRETOU.NE.0) GOTO 1000 26011 CONTINUE IILIGS=MILIGN SEGDES MILIGN ENDIF C SEGINI MINCPO IINCPO=MINCPO L=MAXI*NNOE CALL LFCDIE(IENTRE,L,INCPO,IRETOU,IFORM) SEGDES MINCPO IF(IRETOU.NE.0) GOTO 1000 C SEGINI MHARK IHARK=MHARK DO 2603 I=1,LHAR IHAR(**)=0 2603 CONTINUE CALL LFCDIE(IENTRE,LHAR,IHAR(1),IRETOU,IFORM) SEGDES MHARK IF(IRETOU.NE.0) GOTO 1000 C NM=LMIK+LDUA SEGINI ITBBM1 CALL LFCDIM (IENTRE,NM,ITABM1,IRETOU,IFORM) IF (IRETOU.NE.0) GO TO 1000 SEGINI MIMIK SEGINI MIDUA IIMIK=MIMIK IIDUA=MIDUA DO 2602 I=1,LMIK WRITE (CPV,FMT='(A4)') ITABM1(I) IMIK(**)=CPV 2602 CONTINUE DO 2605 I=1,LDUA WRITE (CPV,FMT='(A4)') ITABM1(LMIK+I) IDUA(**)=CPV 2605 CONTINUE SEGSUP ITBBM1 SEGDES MIDUA,MIMIK C SEGINI MDNOR IDNORM=MDNOR CALL LFCDI2(IENTRE,INC,DNOR,IRETOU,IFORM) SEGDES MDNOR IF(IRETOU.NE.0) GOTO 1000 SEGINI MDIAG IDIAG= MDIAG CALL LFCDI2(IENTRE,INC,DIAG,IRETOU,IFORM) SEGDES MDIAG IF(IRETOU.NE.0) GOTO 1000 SEGDES MMATRI 2600 CONTINUE GOTO 1098 ********************* ON REBOUCLE EN LECTURE ********************** 1000 CONTINUE IRETOU=1 1098 CONTINUE IRET=IRETOU IF (ITBBM1.NE.0) SEGSUP ITBBM1 RETURN C ------------------------------------------------------- END