Télécharger limmat.eso

Retour à la liste

Numérotation des lignes :

  1. C LIMMAT SOURCE PV 16/11/17 22:00:36 9180
  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
  49. CALL LFCDIE (IENTRE,ITOTO,ILENA,IRETOU,IFORM)
  50. IF (IRETOU.NE.0) GO TO 1000
  51. INC = ILENA(1)
  52. IGEOMA= ILENA(2)
  53. IJMAX = ILENA(3)
  54. INEG = ILENA(4)
  55. NENS = ILENA(5)
  56. MAXI = ILENA(6)
  57. NNOE = ILENA(7)
  58. LHAR = ILENA(8)
  59. LMIK = ILENA(9)
  60. LDUA = ILENA(10)
  61.  
  62. IF(IONIVE.GE.9) INSYM = ILENA(11)
  63.  
  64. SEGINI MILIGN
  65.  
  66. CALL LFCDIE(IENTRE,INC,ITTR,IRETOU,IFORM)
  67. IF(IRETOU.NE.0) GOTO 1000
  68.  
  69. CALL LFCDIE(IENTRE,INC,IPNO,IRETOU,IFORM)
  70. IF(IRETOU.NE.0) GOTO 1000
  71.  
  72. DO 2601 I=1,NNOE
  73. ITOTO=7
  74. CALL LFCDIE (IENTRE,ITOTO,ILENA,IRETOU,IFORM)
  75. IF (IRETOU.NE.0) GO TO 1000
  76.  
  77. NVALL = ILENA(1)
  78. NA = ILENA(2)
  79. NBPAR = ILENA(7)
  80. SEGINI LIGN
  81. ILIGN(I)=LIGN
  82. NA1 = ILENA(3)
  83. IMM = ILENA(4)
  84. IPREL = ILENA(5)
  85. IDERL = ILENA(6)
  86.  
  87. CALL LFCDI2(IENTRE,NVALL,VAL,IRETOU,IFORM)
  88. IF (IRETOU.NE.0) GO TO 1000
  89.  
  90. CALL LFCDIE(IENTRE,NA,IMMM,IRETOU,IFORM)
  91. IF (IRETOU.NE.0) GO TO 1000
  92.  
  93. CALL LFCDIE(IENTRE,NA1,IPPVV,IRETOU,IFORM)
  94. IF (IRETOU.NE.0) GO TO 1000
  95.  
  96. CALL LFCDIE(IENTRE,2*NBPAR,IVPO,IRETOU,IFORM)
  97. SEGDES LIGN
  98. IF(IRETOU.NE.0) GOTO 1000
  99.  
  100. 2601 CONTINUE
  101.  
  102. IILIGN=MILIGN
  103. SEGDES MILIGN
  104. C
  105. IF(INSYM.NE.0) THEN
  106.  
  107. SEGINI MILIGN
  108.  
  109. DO 26011 I=1,NNOE
  110. ITOTO=7
  111. CALL LFCDIE (IENTRE,ITOTO,ILENA,IRETOU,IFORM)
  112. IF (IRETOU.NE.0) GO TO 1000
  113.  
  114. NVALL = ILENA(1)
  115. NA = ILENA(2)
  116. NBPAR = ILENA(7)
  117. SEGINI LIGN
  118. ILIGN(I)=LIGN
  119. NA1 = ILENA(3)
  120. IMM = ILENA(4)
  121. IPREL = ILENA(5)
  122. IDERL = ILENA(6)
  123.  
  124. CALL LFCDI2(IENTRE,NVALL,VAL,IRETOU,IFORM)
  125. IF (IRETOU.NE.0) GO TO 1000
  126.  
  127. CALL LFCDIE(IENTRE,NA,IMMM,IRETOU,IFORM)
  128. IF (IRETOU.NE.0) GO TO 1000
  129.  
  130. CALL LFCDIE(IENTRE,NA1,IPPVV,IRETOU,IFORM)
  131. IF (IRETOU.NE.0) GO TO 1000
  132.  
  133. CALL LFCDIE(IENTRE,2*NBPAR,IVPO,IRETOU,IFORM)
  134. SEGDES LIGN
  135. IF(IRETOU.NE.0) GOTO 1000
  136.  
  137. 26011 CONTINUE
  138.  
  139. IILIGS=MILIGN
  140. SEGDES MILIGN
  141.  
  142. ENDIF
  143. C
  144. SEGINI MINCPO
  145. IINCPO=MINCPO
  146. L=MAXI*NNOE
  147. CALL LFCDIE(IENTRE,L,INCPO,IRETOU,IFORM)
  148. SEGDES MINCPO
  149. IF(IRETOU.NE.0) GOTO 1000
  150. C
  151. SEGINI MHARK
  152. IHARK=MHARK
  153. DO 2603 I=1,LHAR
  154. IHAR(**)=0
  155. 2603 CONTINUE
  156. CALL LFCDIE(IENTRE,LHAR,IHAR(1),IRETOU,IFORM)
  157. SEGDES MHARK
  158. IF(IRETOU.NE.0) GOTO 1000
  159. C
  160. NM=LMIK+LDUA
  161. SEGINI ITBBM1
  162. CALL LFCDIM (IENTRE,NM,ITABM1,IRETOU,IFORM)
  163. IF (IRETOU.NE.0) GO TO 1000
  164. SEGINI MIMIK
  165. SEGINI MIDUA
  166. IIMIK=MIMIK
  167. IIDUA=MIDUA
  168. DO 2602 I=1,LMIK
  169. WRITE (CPV,FMT='(A4)') ITABM1(I)
  170. IMIK(**)=CPV
  171. 2602 CONTINUE
  172. DO 2605 I=1,LDUA
  173. WRITE (CPV,FMT='(A4)') ITABM1(LMIK+I)
  174. IDUA(**)=CPV
  175. 2605 CONTINUE
  176. SEGSUP ITBBM1
  177. SEGDES MIDUA,MIMIK
  178. C
  179. SEGINI MDNOR
  180. IDNORM=MDNOR
  181. CALL LFCDI2(IENTRE,INC,DNOR,IRETOU,IFORM)
  182. SEGDES MDNOR
  183. IF(IRETOU.NE.0) GOTO 1000
  184.  
  185. SEGINI MDIAG
  186. IDIAG= MDIAG
  187. CALL LFCDI2(IENTRE,INC,DIAG,IRETOU,IFORM)
  188. SEGDES MDIAG
  189. IF(IRETOU.NE.0) GOTO 1000
  190.  
  191. SEGDES MMATRI
  192. 2600 CONTINUE
  193. GOTO 1098
  194.  
  195. ********************* ON REBOUCLE EN LECTURE **********************
  196.  
  197. 1000 CONTINUE
  198. IRETOU=1
  199. 1098 CONTINUE
  200. IRET=IRETOU
  201. IF (ITBBM1.NE.0) SEGSUP ITBBM1
  202. RETURN
  203. C -------------------------------------------------------
  204. END
  205.  
  206.  
  207.  
  208.  
  209.  
  210.  
  211.  
  212.  
  213.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales