Télécharger limtik.eso

Retour à la liste

Numérotation des lignes :

  1. C LIMTIK SOURCE PV 16/11/26 21:15:59 9205
  2. SUBROUTINE LIMTIK(IFRES,ITLACC,IMAX1,IRET,IFORM)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C***********************************************************************
  6. C NOM : LIMTAK
  7. C DESCRIPTION : Lecture d'un objet de type MATRIK sur le
  8. C fichier IFRES
  9. C (appelé par lipil.eso)
  10. C
  11. C LANGAGE : ESOPE
  12. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  13. C mél : gounand@semt2.smts.cea.fr
  14. C***********************************************************************
  15. C APPELES (E/S) : LFCDIE (lecture d'un tableau d'entiers)
  16. C LFCDI2 (lecture d'un tableau de REAL*8)
  17. C LFCDIM (lecture d'un tableau de CHARACTER*4)
  18. C***********************************************************************
  19. C SYNTAXE GIBIANE : RESTITUER
  20. C ENTREES : IFRES, numéro du fichier de lecture
  21. C IMAX1, nombre d'objets MATRIK à lire
  22. C IFORM, le fichier à lire est formaté ou
  23. C non.
  24. C ENTREES/SORTIES : ITLACC, la pile des objets MATRIK à
  25. C laquelle on ajoute les objets lus
  26. C CODE RETOUR (IRET) : 0, ok
  27. C 1, erreur dans la lecture de l'objet
  28. C***********************************************************************
  29. C VERSION : v1, 15/07/98, version initiale
  30. C HISTORIQUE : v1, 15/07/98, création
  31. C HISTORIQUE :
  32. C HISTORIQUE :
  33. C***********************************************************************
  34. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  35. C en cas de modification de ce sous-programme afin de faciliter
  36. C la maintenance !
  37. C***********************************************************************
  38. -INC CCOPTIO
  39. -INC TMCOLAC
  40. SEGMENT/ITBBM1/( ITABM1(NM))
  41. C
  42. INTEGER NDTAB
  43. INTEGER IEL,I,J,K,L
  44. INTEGER ILENA(11)
  45. C======================================================================
  46. *
  47. * Executable statements
  48. *
  49. IRET=0
  50. IRETOU=0
  51. NM=0
  52. SEGINI ITBBM1
  53. DO 1 IEL=1,IMAX1
  54. C Restitution du chapeau
  55. C.... On initialise des piles d'objets non connus de CASTEM
  56. C MINC, PMORS, IZA, IDMAT
  57. SEGINI ITLAC1
  58. SEGINI ITLAC2
  59. SEGINI ITLAC3
  60. SEGINI ITLAC4
  61. MATRIK=0
  62. C Dimensions
  63. NDTAB=4
  64. CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  65. IF (IRETOU.NE.0) GOTO 9999
  66. NRIGE =ILENA(1)
  67. NMATRI=ILENA(2)
  68. NKID =ILENA(3)
  69. NKMT =ILENA(4)
  70. SEGINI MATRIK
  71. C Rigidités élémentaires
  72. NDTAB = NRIGE * NMATRI
  73. CALL LFCDIE(IFRES,NDTAB,IRIGEL,IRETOU,IFORM)
  74. IF (IRETOU.NE.0) GOTO 9999
  75. C Matrice assemblée
  76. NDTAB=11
  77. CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  78. IF (IRETOU.NE.0) GOTO 9999
  79. KSYM =ILENA( 1)
  80. KMINC =ILENA( 2)
  81. KMINCP=ILENA( 3)
  82. KMINCD=ILENA( 4)
  83. KIZM =ILENA( 5)
  84. KISPGT=ILENA( 6)
  85. KISPGP=ILENA( 7)
  86. KISPGD=ILENA( 8)
  87. KNTTT =ILENA( 9)
  88. KNTTP =ILENA(10)
  89. KNTTD =ILENA(11)
  90. NDTAB=NKID
  91. CALL LFCDIE(IFRES,NDTAB,KIDMAT,IRETOU,IFORM)
  92. IF (IRETOU.NE.0) GOTO 9999
  93. NDTAB=NKMT
  94. CALL LFCDIE(IFRES,NDTAB,KKMMT,IRETOU,IFORM)
  95. IF (IRETOU.NE.0) GOTO 9999
  96. C Restitution des IMATRI
  97. DO 11 I=1,NMATRI
  98. IMATRI=IRIGEL(4,I)
  99. IF (IMATRI.NE.0) THEN
  100. NDTAB=2
  101. CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  102. IF (IRETOU.NE.0) GOTO 9999
  103. NBSOUS=ILENA(1)
  104. NBME =ILENA(2)
  105. SEGINI IMATRI
  106. NM=4*NBME
  107. SEGADJ ITBBM1
  108. CALL LFCDIM(IFRES,NM,ITABM1,IRETOU,IFORM)
  109. DO 111 J=1,NBME
  110. J4=(4*J)-3
  111. WRITE(LISPRI(J),FMT='(2A4)') ITABM1(J4),ITABM1(J4+1)
  112. WRITE(LISDUA(J),FMT='(2A4)') ITABM1(J4+2),ITABM1(J4+3)
  113. 111 CONTINUE
  114. NDTAB=NBSOUS*NBME
  115. CALL LFCDIE(IFRES,NDTAB,LIZAFM,IRETOU,IFORM)
  116. IF (IRETOU.NE.0) GOTO 9999
  117. NDTAB=2
  118. CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  119. IF (IRETOU.NE.0) GOTO 9999
  120. KSPGP=ILENA(1)
  121. KSPGD=ILENA(2)
  122. C Restitution des IZAFM
  123. DO 112 K=1,NBME
  124. DO 1121 L=1,NBSOUS
  125. IZAFM=LIZAFM(L,K)
  126. IF (IZAFM.NE.0) THEN
  127. NDTAB=3
  128. CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  129. IF (IRETOU.NE.0) GOTO 9999
  130. NBEL=ILENA(1)
  131. NP =ILENA(2)
  132. MP =ILENA(3)
  133. SEGINI IZAFM
  134. NDTAB=NBEL*NP*MP
  135. CALL LFCDI2(IFRES,NDTAB,AM,IRETOU,IFORM)
  136. IF (IRETOU.NE.0) GOTO 9999
  137. SEGDES IZAFM
  138. LIZAFM(L,K)=IZAFM
  139. ENDIF
  140. 1121 CONTINUE
  141. 112 CONTINUE
  142. SEGDES IMATRI
  143. IRIGEL(4,I)=IMATRI
  144. ENDIF
  145. 11 CONTINUE
  146. C Restitution des MINC
  147. NDTAB=4
  148. CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  149. IF (IRETOU.NE.0) GOTO 9999
  150. NBMINC=ILENA(1)
  151. JMINC =ILENA(2)
  152. JMINCP=ILENA(3)
  153. JMINCD=ILENA(4)
  154. DO 12 I=1,NBMINC
  155. NDTAB=2
  156. CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  157. IF (IRETOU.NE.0) GOTO 9999
  158. NPT=ILENA(1)
  159. NBI=ILENA(2)
  160. SEGINI MINC
  161. NM=2*NBI
  162. SEGADJ ITBBM1
  163. CALL LFCDIM(IFRES,NM,ITABM1,IRETOU,IFORM)
  164. IF (IRETOU.NE.0) GOTO 9999
  165. DO 121 J=1,NBI
  166. J2=(2*J)-1
  167. WRITE(LISINC(J),FMT='(2A4)') ITABM1(J2),ITABM1(J2+1)
  168. 121 CONTINUE
  169. NDTAB=NPT+1
  170. CALL LFCDIE(IFRES,NDTAB,NPOS,IRETOU,IFORM)
  171. IF (IRETOU.NE.0) GOTO 9999
  172. NDTAB=NPT*(NBI+1)
  173. CALL LFCDIE(IFRES,NDTAB,MPOS,IRETOU,IFORM)
  174. IF (IRETOU.NE.0) GOTO 9999
  175. SEGDES MINC
  176. ITLAC1.ITLAC(**)=MINC
  177. 12 CONTINUE
  178. IF (JMINC.NE.0) KMINC =ITLAC1.ITLAC(JMINC)
  179. IF (JMINCP.NE.0) KMINCP=ITLAC1.ITLAC(JMINCP)
  180. IF (JMINCD.NE.0) KMINCD=ITLAC1.ITLAC(JMINCD)
  181. C Restitution des PMORS
  182. NDTAB=3
  183. CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  184. IF (IRETOU.NE.0) GOTO 9999
  185. NBMORS=ILENA(1)
  186. JMORS =ILENA(2)
  187. JMRST =ILENA(3)
  188. DO 13 I=1,NBMORS
  189. NDTAB=2
  190. CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  191. IF (IRETOU.NE.0) GOTO 9999
  192. NTT=ILENA(1)
  193. NJA=ILENA(2)
  194. SEGINI PMORS
  195. NDTAB=NTT+1
  196. CALL LFCDIE(IFRES,NDTAB,IA,IRETOU,IFORM)
  197. IF (IRETOU.NE.0) GOTO 9999
  198. NDTAB=NJA
  199. CALL LFCDIE(IFRES,NDTAB,JA,IRETOU,IFORM)
  200. IF (IRETOU.NE.0) GOTO 9999
  201. SEGDES PMORS
  202. ITLAC2.ITLAC(**)=PMORS
  203. 13 CONTINUE
  204. IF (JMORS.NE.0) KIDMAT(4)=ITLAC2.ITLAC(JMORS)
  205. IF (JMRST.NE.0) KIDMAT(6)=ITLAC2.ITLAC(JMRST)
  206. C Restitution des IDMAT (faite avant les IZA
  207. C car IDIAG pointe sur un IZA)
  208. NDTAB=3
  209. CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  210. IF (IRETOU.NE.0) GOTO 9999
  211. NBIDMA=ILENA(1)
  212. JDMATP=ILENA(2)
  213. JDMATD=ILENA(3)
  214. DO 15 I=1,NBIDMA
  215. NDTAB=4
  216. CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  217. IF (IRETOU.NE.0) GOTO 9999
  218. NTT =ILENA(1)
  219. NPT =ILENA(2)
  220. NBLK=ILENA(3)
  221. SEGINI IDMAT
  222. IDIAG=ILENA(4)
  223. NDTAB=NTT
  224. CALL LFCDIE(IFRES,NDTAB,KZA,IRETOU,IFORM)
  225. IF (IRETOU.NE.0) GOTO 9999
  226. NDTAB=2*NTT
  227. CALL LFCDIE(IFRES,NDTAB,NUIA,IRETOU,IFORM)
  228. IF (IRETOU.NE.0) GOTO 9999
  229. NDTAB=NPT
  230. CALL LFCDIE(IFRES,NDTAB,NUAN,IRETOU,IFORM)
  231. IF (IRETOU.NE.0) GOTO 9999
  232. NDTAB=NPT
  233. CALL LFCDIE(IFRES,NDTAB,NUNA,IRETOU,IFORM)
  234. IF (IRETOU.NE.0) GOTO 9999
  235. NDTAB=NBLK
  236. CALL LFCDIE(IFRES,NDTAB,IDESCL,IRETOU,IFORM)
  237. IF (IRETOU.NE.0) GOTO 9999
  238. NDTAB=NBLK
  239. CALL LFCDIE(IFRES,NDTAB,IDESCU,IRETOU,IFORM)
  240. IF (IRETOU.NE.0) GOTO 9999
  241. NDTAB=NBLK+1
  242. CALL LFCDIE(IFRES,NDTAB,NLDBLK,IRETOU,IFORM)
  243. IF (IRETOU.NE.0) GOTO 9999
  244. SEGDES IDMAT
  245. ITLAC4.ITLAC(**)=IDMAT
  246. 15 CONTINUE
  247. IF (JDMATP.NE.0) KIDMAT(1)=ITLAC4.ITLAC(JDMATP)
  248. IF (JDMATD.NE.0) KIDMAT(2)=ITLAC4.ITLAC(JDMATD)
  249. C Restitution des IZA
  250. NDTAB=8
  251. CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  252. IF (IRETOU.NE.0) GOTO 9999
  253. NBIZA =ILENA( 1)
  254. JS2B =ILENA( 2)
  255. JISA =ILENA( 3)
  256. JIST =ILENA( 4)
  257. JZDU =ILENA( 5)
  258. JZDP =ILENA( 6)
  259. JZFU =ILENA( 7)
  260. JZFP =ILENA( 8)
  261. DO 14 I=1,NBIZA
  262. NDTAB=1
  263. CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  264. IF (IRETOU.NE.0) GOTO 9999
  265. NBVA=ILENA(1)
  266. SEGINI IZA
  267. NDTAB=NBVA
  268. CALL LFCDI2(IFRES,NDTAB,A,IRETOU,IFORM)
  269. IF (IRETOU.NE.0) GOTO 9999
  270. SEGDES IZA
  271. ITLAC3.ITLAC(**)=IZA
  272. 14 CONTINUE
  273. IF (JS2B.NE.0) KIDMAT(3)=ITLAC3.ITLAC(JS2B)
  274. IF (JISA.NE.0) KIDMAT(5)=ITLAC3.ITLAC(JISA)
  275. IF (JIST.NE.0) KIDMAT(7)=ITLAC3.ITLAC(JIST)
  276. IF (JZDU.NE.0) KKMMT (4)=ITLAC3.ITLAC(JZDU)
  277. IF (JZDP.NE.0) KKMMT (5)=ITLAC3.ITLAC(JZDP)
  278. IF (JZFU.NE.0) KKMMT (6)=ITLAC3.ITLAC(JZFU)
  279. IF (JZFP.NE.0) KKMMT (7)=ITLAC3.ITLAC(JZFP)
  280. C Restauration des pointeurs des IZA dans IDMAT
  281. DO 17 I=1,NBIDMA
  282. IDMAT=ITLAC4.ITLAC(I)
  283. SEGACT IDMAT*MOD
  284. NBLK=IDESCL(/1)
  285. C IDIAG
  286. IV3=IDIAG
  287. IF (IV3.NE.0) IDIAG=ITLAC3.ITLAC(IV3)
  288. C IDESCL
  289. DO 171 J=1,NBLK
  290. IV3=IDESCL(J)
  291. IF (IV3.NE.0) IDESCL(J)=ITLAC3.ITLAC(IV3)
  292. 171 CONTINUE
  293. C IDESCU
  294. DO 172 J=1,NBLK
  295. IV3=IDESCU(J)
  296. IF (IV3.NE.0) IDESCU(J)=ITLAC3.ITLAC(IV3)
  297. 172 CONTINUE
  298. SEGDES IDMAT
  299. 17 CONTINUE
  300. SEGDES MATRIK
  301. ITLAC(**)=MATRIK
  302. SEGSUP ITLAC4
  303. SEGSUP ITLAC3
  304. SEGSUP ITLAC2
  305. SEGSUP ITLAC1
  306. 1 CONTINUE
  307. SEGSUP ITBBM1
  308. *
  309. * Normal termination
  310. *
  311. IRET=0
  312. RETURN
  313. *
  314. * Format handling
  315. *
  316. *
  317. * Error handling
  318. *
  319. 9999 CONTINUE
  320. WRITE(IOIMP,*) 'An error was detected in subroutine limtik'
  321. IRET=1
  322. RETURN
  323. *
  324. * End of subroutine LIMTIK
  325. *
  326. END
  327.  
  328.  
  329.  
  330.  
  331.  
  332.  
  333.  
  334.  
  335.  
  336.  
  337.  
  338.  
  339.  
  340.  

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