1 : C LIMMAT SOURCE CHAT 05/01/13 01:18:12 5004 2 : SUBROUTINE LIMMAT (IENTRE,ITLACC,IMAX1,IRET,IFORM) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C======================================================================= 6 : C BUT : LECTURE DES MMATRI 7 : C APPELE PAR : LIPIL 8 : C APPELLE : LFCDIM LFCDIE LFCDI2 9 : C ECRIT PAR FARVACQUE -REPRIS PAR LENA 10 : C 11 : C======================================================================= 12 : C TABLEAU KCOLA : 13 : C 1 MELEME 2 CHPOIN 3 MRIGID 4 MCHAFF 5 MCHELM 6 14 : C 7 8 MSOLUT 9 MSTRUC 10 11 MAFFEC 12 MSOSTU 15 : C 13 IMATRI 14 MJONCT 15 MATTAC 16 MMATRI 17 MDEFOR 18 MLREEL 16 : C 19 MLENTI 20 MCHARG 21 MODELE 22 MEVOLL 17 : C======================================================================= 18 : -INC CCOPTIO 19 : -INC SMMATRI 20 : C 21 : C======================================================================= 22 : SEGMENT/ITBBM1/( ITABM1(NM)) 23 : SEGMENT/ITLACC/( ITLAC(0)) 24 : C 25 : CHARACTER*4 CPV 26 : DIMENSION ILENA(15) 27 : C-------------------------------------------------------------------- 28 : IRET=0 29 : IRETOU=0 30 : ITBBM1=0 31 : 32 : C ***************************** MMATRI ***************************** 33 : 34 : 6016 CONTINUE 35 : 36 : DO 2600 IEL=1,IMAX1 37 : SEGINI MMATRI 38 : ITLAC(**)=MMATRI 39 : 40 : C READ(IENTRE,8000,END=1000,ERR=1000)INC,IGEOMA,IJMAX,INEG,NENS,MAXI, 41 : C *NNOE,LHAR 42 : 43 : IF(IONIVE.LE.8) THEN 44 : ITOTO = 10 45 : INSYM = 0 46 : ELSE 47 : ITOTO = 11 48 : ENDIF 48 : CALL LFCDIE (IENTRE,ITOTO,ILENA,IRETOU,IFORM) 49 : IF (IRETOU.NE.0) GO TO 1000 50 : INC = ILENA(1) 51 : IGEOMA= ILENA(2) 52 : IJMAX = ILENA(3) 53 : INEG = ILENA(4) 54 : NENS = ILENA(5) 55 : MAXI = ILENA(6) 56 : NNOE = ILENA(7) 57 : LHAR = ILENA(8) 58 : LMIK = ILENA(9) 59 : LDUA = ILENA(10) 60 : 61 : IF(IONIVE.GE.9) INSYM = ILENA(11) 62 : 63 : SEGINI MILIGN 64 : 64 : CALL LFCDIE(IENTRE,INC,ITTR,IRETOU,IFORM) 65 : IF(IRETOU.NE.0) GOTO 1000 66 : 66 : CALL LFCDIE(IENTRE,INC,IPNO,IRETOU,IFORM) 67 : IF(IRETOU.NE.0) GOTO 1000 68 : 69 : DO 2601 I=1,NNOE 70 : ITOTO=7 70 : CALL LFCDIE (IENTRE,ITOTO,ILENA,IRETOU,IFORM) 71 : IF (IRETOU.NE.0) GO TO 1000 72 : 73 : NVALL = ILENA(1) 74 : NA = ILENA(2) 75 : NBPAR = ILENA(7) 76 : SEGINI LIGN 77 : ILIGN(I)=LIGN 78 : NA1 = ILENA(3) 79 : IMM = ILENA(4) 80 : IPREL = ILENA(5) 81 : IDERL = ILENA(6) 82 : 82 : CALL LFCDI2(IENTRE,NVALL,VAL,IRETOU,IFORM) 83 : IF (IRETOU.NE.0) GO TO 1000 84 : 84 : CALL LFCDIE(IENTRE,NA,IMMM,IRETOU,IFORM) 85 : IF (IRETOU.NE.0) GO TO 1000 86 : 86 : CALL LFCDIE(IENTRE,NA1,IPPVV,IRETOU,IFORM) 87 : IF (IRETOU.NE.0) GO TO 1000 88 : 88 : CALL LFCDIE(IENTRE,2*NBPAR,IVPO,IRETOU,IFORM) 89 : SEGDES LIGN 90 : IF(IRETOU.NE.0) GOTO 1000 91 : 92 : 2601 CONTINUE 93 : 94 : IILIGN=MILIGN 95 : SEGDES MILIGN 96 : C 97 : IF(INSYM.NE.0) THEN 98 : 99 : SEGINI MILIGN 100 : 101 : DO 26011 I=1,NNOE 102 : ITOTO=7 102 : CALL LFCDIE (IENTRE,ITOTO,ILENA,IRETOU,IFORM) 103 : IF (IRETOU.NE.0) GO TO 1000 104 : 105 : NVALL = ILENA(1) 106 : NA = ILENA(2) 107 : NBPAR = ILENA(7) 108 : SEGINI LIGN 109 : ILIGN(I)=LIGN 110 : NA1 = ILENA(3) 111 : IMM = ILENA(4) 112 : IPREL = ILENA(5) 113 : IDERL = ILENA(6) 114 : 114 : CALL LFCDI2(IENTRE,NVALL,VAL,IRETOU,IFORM) 115 : IF (IRETOU.NE.0) GO TO 1000 116 : 116 : CALL LFCDIE(IENTRE,NA,IMMM,IRETOU,IFORM) 117 : IF (IRETOU.NE.0) GO TO 1000 118 : 118 : CALL LFCDIE(IENTRE,NA1,IPPVV,IRETOU,IFORM) 119 : IF (IRETOU.NE.0) GO TO 1000 120 : 120 : CALL LFCDIE(IENTRE,2*NBPAR,IVPO,IRETOU,IFORM) 121 : SEGDES LIGN 122 : IF(IRETOU.NE.0) GOTO 1000 123 : 124 : 26011 CONTINUE 125 : 126 : IILIGS=MILIGN 127 : SEGDES MILIGN 128 : 129 : ENDIF 130 : C 131 : SEGINI MINCPO 132 : IINCPO=MINCPO 133 : L=MAXI*NNOE 133 : CALL LFCDIE(IENTRE,L,INCPO,IRETOU,IFORM) 134 : SEGDES MINCPO 135 : IF(IRETOU.NE.0) GOTO 1000 136 : C 137 : SEGINI MHARK 138 : IHARK=MHARK 139 : DO 2603 I=1,LHAR 140 : IHAR(**)=0 141 : 2603 CONTINUE 141 : CALL LFCDIE(IENTRE,LHAR,IHAR(1),IRETOU,IFORM) 142 : SEGDES MHARK 143 : IF(IRETOU.NE.0) GOTO 1000 144 : C 145 : NM=LMIK+LDUA 146 : SEGINI ITBBM1 146 : CALL LFCDIM (IENTRE,NM,ITABM1,IRETOU,IFORM) 147 : IF (IRETOU.NE.0) GO TO 1000 148 : SEGINI MIMIK 149 : SEGINI MIDUA 150 : IIMIK=MIMIK 151 : IIDUA=MIDUA 152 : DO 2602 I=1,LMIK 153 : WRITE (CPV,FMT='(A4)') ITABM1(I) 154 : IMIK(**)=CPV 155 : 2602 CONTINUE 156 : DO 2605 I=1,LDUA 157 : WRITE (CPV,FMT='(A4)') ITABM1(LMIK+I) 158 : IDUA(**)=CPV 159 : 2605 CONTINUE 160 : SEGSUP ITBBM1 161 : SEGDES MIDUA,MIMIK 162 : C 163 : SEGINI MDNOR 164 : IDNORM=MDNOR 164 : CALL LFCDI2(IENTRE,INC,DNOR,IRETOU,IFORM) 165 : SEGDES MDNOR 166 : IF(IRETOU.NE.0) GOTO 1000 167 : 168 : SEGINI MDIAG 169 : IDIAG= MDIAG 169 : CALL LFCDI2(IENTRE,INC,DIAG,IRETOU,IFORM) 170 : SEGDES MDIAG 171 : IF(IRETOU.NE.0) GOTO 1000 172 : 173 : SEGDES MMATRI 174 : 2600 CONTINUE 175 : GOTO 1098 176 : 177 : ********************* ON REBOUCLE EN LECTURE ********************** 178 : 179 : 1000 CONTINUE 180 : IRETOU=1 181 : 1098 CONTINUE 182 : IRET=IRETOU 183 : IF (ITBBM1.NE.0) SEGSUP ITBBM1 184 : RETURN 185 : C ------------------------------------------------------- 186 : END 187 : 188 : 189 : 190 : 191 :
© Cast3M 2003 - All rights reserved.
Disclaimer