Télécharger limtak.eso

Retour à la liste

Numérotation des lignes :

  1. C LIMTAK SOURCE PV 16/11/26 21:15:58 9205
  2. SUBROUTINE LIMTAK(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 MATRAK 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***********************************************************************
  18. C SYNTAXE GIBIANE : RESTITUER
  19. C ENTREES : IFRES, numéro du fichier de lecture
  20. C IMAX1, nombre d'objets MATRAK à lire
  21. C IFORM, le fichier à lire est formaté ou
  22. C non.
  23. C ENTREES/SORTIES : ITLACC, la pile des objets MATRAK à
  24. C laquelle on ajoute les objets lus
  25. C CODE RETOUR (IRET) : 0, ok
  26. C 1, erreur dans la lecture de l'objet
  27. C***********************************************************************
  28. C VERSION : v1, 15/07/98, version initiale
  29. C HISTORIQUE : v1, 15/07/98, création
  30. C HISTORIQUE :
  31. C HISTORIQUE :
  32. C***********************************************************************
  33. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  34. C en cas de modification de ce sous-programme afin de faciliter
  35. C la maintenance !
  36. C***********************************************************************
  37. -INC CCOPTIO
  38. C-INC SMMATRAKANC
  39. C*************************************************************************
  40. C
  41. C REPERAGE ET STOKAGE DES MATRICES ELEMENTAIRES puis assemblees
  42. C
  43.  
  44. * LGEOC SPG de la pression et/ou des multiplicateurs de Lagrange
  45. * (points CENTRE ) pour chaque operateur de contrainte
  46. * KGEOC SPG pour la totalite des points CENTRE.
  47. * KGEOS SPG pour la totalite des points SOMMET (Diagonale vitesse)
  48. * KLEMC Connectivites de l'ensemble des contraintes
  49. * LIZAFM(NBSOUS) contient les pointeurs IZAFM des sous-zones
  50.  
  51. SEGMENT MATRAK
  52. INTEGER LGEOC(NBOP),IDEBS(NBOP),IFINS(NBOP)
  53. INTEGER LIZAFM(NBSOUS)
  54. INTEGER IKAM0 (NBSOUS)
  55. INTEGER IMEM (NBELC)
  56. INTEGER KLEMC,KGEOS,KGEOC,KDIAG,KCAC,KIZCL,KIZGC
  57. ENDSEGMENT
  58.  
  59. SEGMENT IZAFM
  60. REAL*8 AM(NNELP,NP,IESP),RPGI(NELAX)
  61. ENDSEGMENT
  62. C*************************************************************************
  63. -INC TMCOLAC
  64. SEGMENT IZA
  65. REAL*8 A(NBVA)
  66. ENDSEGMENT
  67. C
  68. INTEGER NDTAB
  69. INTEGER IEL,I
  70. INTEGER ILENA(7)
  71. C======================================================================
  72. *
  73. * Executable statements
  74. *
  75. IRET=0
  76. IRETOU=0
  77. C ... BOUCLE SUR LES MATRAK DE LA PILE
  78. DO 1 IEL=1,IMAX1
  79. C Restitution du chapeau
  80. MATRAK=0
  81. C Dimensions
  82. NDTAB=3
  83. CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  84. IF (IRETOU.NE.0) GOTO 9999
  85. NBOP =ILENA(1)
  86. NBSOUS=ILENA(2)
  87. NBELC =ILENA(3)
  88. SEGINI MATRAK
  89. C Rigidités élémentaires
  90. NDTAB = NBOP
  91. CALL LFCDIE(IFRES,NDTAB,LGEOC,IRETOU,IFORM)
  92. IF (IRETOU.NE.0) GOTO 9999
  93. NDTAB = NBOP
  94. CALL LFCDIE(IFRES,NDTAB,IDEBS,IRETOU,IFORM)
  95. IF (IRETOU.NE.0) GOTO 9999
  96. NDTAB = NBOP
  97. CALL LFCDIE(IFRES,NDTAB,IFINS,IRETOU,IFORM)
  98. IF (IRETOU.NE.0) GOTO 9999
  99. NDTAB = NBSOUS
  100. CALL LFCDIE(IFRES,NDTAB,LIZAFM,IRETOU,IFORM)
  101. IF (IRETOU.NE.0) GOTO 9999
  102. NDTAB = NBSOUS
  103. CALL LFCDIE(IFRES,NDTAB,IKAM0,IRETOU,IFORM)
  104. IF (IRETOU.NE.0) GOTO 9999
  105. NDTAB = NBELC
  106. CALL LFCDIE(IFRES,NDTAB,IMEM,IRETOU,IFORM)
  107. IF (IRETOU.NE.0) GOTO 9999
  108. NDTAB = 7
  109. CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  110. IF (IRETOU.NE.0) GOTO 9999
  111. KLEMC=ILENA( 1)
  112. KGEOS=ILENA( 2)
  113. KGEOC=ILENA( 3)
  114. KDIAG=ILENA( 4)
  115. KCAC =ILENA( 5)
  116. KIZCL=ILENA( 6)
  117. KIZGC=ILENA( 7)
  118. C Restitution des IZAFM
  119. DO 11 I=1,NBSOUS
  120. IZAFM=LIZAFM(I)
  121. IF (IZAFM.NE.0) THEN
  122. NDTAB=4
  123. CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  124. IF (IRETOU.NE.0) GOTO 9999
  125. NNELP=ILENA(1)
  126. NP =ILENA(2)
  127. IESP =ILENA(3)
  128. NELAX=ILENA(4)
  129. SEGINI IZAFM
  130. NDTAB=NNELP*NP*IESP
  131. CALL LFCDI2(IFRES,NDTAB,AM,IRETOU,IFORM)
  132. IF (IRETOU.NE.0) GOTO 9999
  133. NDTAB=NELAX
  134. CALL LFCDI2(IFRES,NDTAB,RPGI,IRETOU,IFORM)
  135. IF (IRETOU.NE.0) GOTO 9999
  136. SEGDES IZAFM
  137. LIZAFM(I)=IZAFM
  138. ENDIF
  139. 11 CONTINUE
  140. C Restitution du IZL
  141. IF (KIZCL.NE.0) THEN
  142. C Dimensions
  143. NDTAB=4
  144. CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  145. IF (IRETOU.NE.0) GOTO 9999
  146. NJA =ILENA(1)
  147. NJAN=ILENA(2)
  148. NJAB=ILENA(3)
  149. SEGINI IZL
  150. KZA1=ILENA(4)
  151. C Contenu des tableaux
  152. NDTAB=NJA
  153. CALL LFCDIE(IFRES,NDTAB,KZA,IRETOU,IFORM)
  154. IF (IRETOU.NE.0) GOTO 9999
  155. NDTAB=NJAN
  156. CALL LFCDIE(IFRES,NDTAB,NUAN,IRETOU,IFORM)
  157. IF (IRETOU.NE.0) GOTO 9999
  158. NDTAB=NJAN
  159. CALL LFCDIE(IFRES,NDTAB,NUNA,IRETOU,IFORM)
  160. IF (IRETOU.NE.0) GOTO 9999
  161. NDTAB=NJAN
  162. CALL LFCDIE(IFRES,NDTAB,IMEL,IRETOU,IFORM)
  163. IF (IRETOU.NE.0) GOTO 9999
  164. NDTAB=NJAN
  165. CALL LFCDIE(IFRES,NDTAB,IMJ,IRETOU,IFORM)
  166. IF (IRETOU.NE.0) GOTO 9999
  167. NDTAB=NJAB
  168. CALL LFCDI2(IFRES,NDTAB,B,IRETOU,IFORM)
  169. IF (IRETOU.NE.0) GOTO 9999
  170. C Restitution du IDMAT
  171. IF (KZA1.NE.0) THEN
  172. C Dimension
  173. NDTAB=2
  174. CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  175. IF (IRETOU.NE.0) GOTO 9999
  176. NBLK =ILENA(1)
  177. SEGINI IDMAT
  178. IDIAG=ILENA(2)
  179. NDTAB=NBLK
  180. CALL LFCDIE(IFRES,NDTAB,IDESCR,IRETOU,IFORM)
  181. IF (IRETOU.NE.0) GOTO 9999
  182. NDTAB=NBLK+1
  183. CALL LFCDIE(IFRES,NDTAB,NLDBLK,IRETOU,IFORM)
  184. IF (IRETOU.NE.0) GOTO 9999
  185. IF (IDIAG.NE.0) THEN
  186. NDTAB=1
  187. CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  188. IF (IRETOU.NE.0) GOTO 9999
  189. NBVA=ILENA(1)
  190. SEGINI IZA
  191. NDTAB=NBVA
  192. CALL LFCDI2(IFRES,NDTAB,A,IRETOU,IFORM)
  193. IF (IRETOU.NE.0) GOTO 9999
  194. SEGDES IZA
  195. IDIAG=IZA
  196. ENDIF
  197. C Restitution des IDBLK
  198. DO 211 INBLK=1,NBLK
  199. IDBLK=IDESCR(INBLK)
  200. IF (IDBLK.NE.0) THEN
  201. C Dimension
  202. NDTAB=3
  203. CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  204. IF (IRETOU.NE.0) GOTO 9999
  205. NLBLK=ILENA(1)
  206. SEGINI IDBLK
  207. IMAT =ILENA(2)
  208. ILON =ILENA(3)
  209. NDTAB=NLBLK+1
  210. CALL LFCDIE(IFRES,NDTAB,IDEBLK,IRETOU,IFORM)
  211. IF (IRETOU.NE.0) GOTO 9999
  212. IF (IMAT.NE.0) THEN
  213. NDTAB=1
  214. CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  215. IF (IRETOU.NE.0) GOTO 9999
  216. NBVA=ILENA(1)
  217. SEGINI IZA
  218. NDTAB=NBVA
  219. CALL LFCDI2(IFRES,NDTAB,A,IRETOU,IFORM)
  220. IF (IRETOU.NE.0) GOTO 9999
  221. SEGDES IZA
  222. IMAT=IZA
  223. ENDIF
  224. SEGDES IDBLK
  225. IDESCR(INBLK)=IDBLK
  226. ENDIF
  227. 211 CONTINUE
  228. SEGDES IDMAT
  229. KZA1=IDMAT
  230. ENDIF
  231. SEGDES IZL
  232. KIZCL=IZL
  233. ENDIF
  234. SEGDES MATRAK
  235. ITLAC(**)=MATRAK
  236. 1 CONTINUE
  237. *
  238. * Normal termination
  239. *
  240. IRET=0
  241. RETURN
  242. *
  243. * Format handling
  244. *
  245. *
  246. * Error handling
  247. *
  248. 9999 CONTINUE
  249. WRITE(IOIMP,*) 'An error was detected in subroutine limtak'
  250. IRET=1
  251. RETURN
  252. *
  253. * End of subroutine LIMTAK
  254. *
  255. END
  256.  
  257.  
  258.  
  259.  
  260.  
  261.  
  262.  
  263.  
  264.  
  265.  

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