Télécharger wrmtak.eso

Retour à la liste

Numérotation des lignes :

wrmtak
  1. C WRMTAK SOURCE PV 17/12/05 21:17:29 9646
  2. SUBROUTINE WRMTAK(IFSAU,ITLACC,IMAX1,IFORM,IDEB)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C***********************************************************************
  6. C NOM : WRMTAK
  7. C DESCRIPTION : Ecriture des objets de type MATRAK sur le
  8. C fichier IFSAU
  9. C (appelé par wrpil.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) : ECDIFE (ecriture d'un tableau d'entiers)
  16. C ECDIFR (ecriture d'un tableau de REAL*8)
  17. C***********************************************************************
  18. C SYNTAXE GIBIANE : SAUV
  19. C ENTREES : IFSAU, numéro du fichier en écriture
  20. C IDEB, IMAX1, indice de début et de fin
  21. C de la pile des objets MATRAK (ITLACC)
  22. C à écrire.
  23. C IFORM, le fichier a ecrire est formaté ou
  24. C non.
  25. C***********************************************************************
  26. C VERSION : v1, 15/07/98, version initiale
  27. C HISTORIQUE : v1, 15/07/98, création
  28. C HISTORIQUE :
  29. C HISTORIQUE :
  30. C***********************************************************************
  31. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  32. C en cas de modification de ce sous-programme afin de faciliter
  33. C la maintenance !
  34. C***********************************************************************
  35.  
  36. -INC PPARAM
  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. C
  76. C ... BOUCLE SUR LES MATRAK DE LA PILE
  77. DO 1 IEL=IDEB,IMAX1
  78. MATRAK=ITLAC(IEL)
  79. IF (MATRAK.EQ.0) THEN
  80. WRITE(IOIMP,*) 'Failing to save a nil pointer'
  81. WRITE(IOIMP,*) 'MATRAK type object...'
  82. GOTO 9999
  83. ENDIF
  84. C Sauvegarde du chapeau
  85. C Dimensions
  86. SEGACT MATRAK
  87. NBOP =LGEOC(/1)
  88. NBSOUS=LIZAFM(/1)
  89. NBELC =IMEM(/1)
  90. ILENA(1)=NBOP
  91. ILENA(2)=NBSOUS
  92. ILENA(3)=NBELC
  93. NDTAB=3
  94. CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM)
  95. C Rigidités élémentaires
  96. NDTAB=NBOP
  97. CALL ECDIFE(IFSAU,NDTAB,LGEOC,IFORM)
  98. NDTAB=NBOP
  99. CALL ECDIFE(IFSAU,NDTAB,IDEBS,IFORM)
  100. NDTAB=NBOP
  101. CALL ECDIFE(IFSAU,NDTAB,IFINS,IFORM)
  102. NDTAB=NBSOUS
  103. CALL ECDIFE(IFSAU,NDTAB,LIZAFM,IFORM)
  104. NDTAB=NBSOUS
  105. CALL ECDIFE(IFSAU,NDTAB,IKAM0,IFORM)
  106. NDTAB=NBELC
  107. CALL ECDIFE(IFSAU,NDTAB,IMEM,IFORM)
  108. ILENA( 1)=KLEMC
  109. ILENA( 2)=KGEOS
  110. ILENA( 3)=KGEOC
  111. ILENA( 4)=KDIAG
  112. ILENA( 5)=KCAC
  113. ILENA( 6)=KIZCL
  114. ILENA( 7)=KIZGC
  115. NDTAB=7
  116. CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM)
  117. C Sauvegarde des IZAFM
  118. DO 11 I=1,NBSOUS
  119. IZAFM=LIZAFM(I)
  120. IF (IZAFM.NE.0) THEN
  121. SEGACT IZAFM
  122. NNELP=AM(/1)
  123. NP =AM(/2)
  124. IESP =AM(/3)
  125. NELAX=RPGI(/1)
  126. ILENA(1)=NNELP
  127. ILENA(2)=NP
  128. ILENA(3)=IESP
  129. ILENA(4)=NELAX
  130. NDTAB=4
  131. CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM)
  132. NDTAB=NNELP*NP*IESP
  133. CALL ECDIFR(IFSAU,NDTAB,AM,IFORM)
  134. NDTAB=NELAX
  135. CALL ECDIFR(IFSAU,NDTAB,RPGI,IFORM)
  136. SEGDES IZAFM
  137. ENDIF
  138. 11 CONTINUE
  139. C Sauvegarde du IZL
  140. IF (KIZCL.NE.0) THEN
  141. IZL=KIZCL
  142. SEGACT IZL
  143. C Dimensions
  144. NJA=KZA(/1)
  145. NJAN=NUAN(/1)
  146. NJAB=B(/1)
  147. ILENA(1)=NJA
  148. ILENA(2)=NJAN
  149. ILENA(3)=NJAB
  150. ILENA(4)=KZA1
  151. NDTAB=4
  152. CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM)
  153. C Contenu des tableaux
  154. NDTAB=NJA
  155. CALL ECDIFE(IFSAU,NDTAB,KZA,IFORM)
  156. NDTAB=NJAN
  157. CALL ECDIFE(IFSAU,NDTAB,NUAN,IFORM)
  158. NDTAB=NJAN
  159. CALL ECDIFE(IFSAU,NDTAB,NUNA,IFORM)
  160. NDTAB=NJAN
  161. CALL ECDIFE(IFSAU,NDTAB,IMEL,IFORM)
  162. NDTAB=NJAN
  163. CALL ECDIFE(IFSAU,NDTAB,IMJ,IFORM)
  164. NDTAB=NJAB
  165. CALL ECDIFR(IFSAU,NDTAB,B,IFORM)
  166. C Sauvegarde du IDMAT
  167. IF (KZA1.NE.0) THEN
  168. IDMAT=KZA1
  169. SEGACT IDMAT
  170. C Dimension
  171. NBLK=IDESCR(/1)
  172. ILENA(1)=NBLK
  173. ILENA(2)=IDIAG
  174. NDTAB=2
  175. CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM)
  176. NDTAB=NBLK
  177. CALL ECDIFE(IFSAU,NDTAB,IDESCR,IFORM)
  178. NDTAB=NBLK+1
  179. CALL ECDIFE(IFSAU,NDTAB,NLDBLK,IFORM)
  180. IF (IDIAG.NE.0) THEN
  181. IZA=IDIAG
  182. SEGACT IZA
  183. NBVA=A(/1)
  184. ILENA(1)=NBVA
  185. NDTAB=1
  186. CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM)
  187. NDTAB=NBVA
  188. CALL ECDIFR(IFSAU,NDTAB,A,IFORM)
  189. SEGDES IZA
  190. ENDIF
  191. C Sauvegarde des IDBLK
  192. DO 211 INBLK=1,NBLK
  193. IDBLK=IDESCR(INBLK)
  194. IF (IDBLK.NE.0) THEN
  195. SEGACT IDBLK
  196. C Dimension
  197. NLBLK=IDEBLK(/1)-1
  198. ILENA(1)=NLBLK
  199. ILENA(2)=IMAT
  200. ILENA(3)=ILON
  201. NDTAB=3
  202. CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM)
  203. NDTAB=NLBLK+1
  204. CALL ECDIFE(IFSAU,NDTAB,IDEBLK,IFORM)
  205. IF (IMAT.NE.0) THEN
  206. IZA=IMAT
  207. SEGACT IZA
  208. NBVA=A(/1)
  209. ILENA(1)=NBVA
  210. NDTAB=1
  211. CALL ECDIFE(IFSAU,NDTAB,ILENA,IFORM)
  212. NDTAB=NBVA
  213. CALL ECDIFR(IFSAU,NDTAB,A,IFORM)
  214. SEGDES IZA
  215. ENDIF
  216. SEGDES IDBLK
  217. ENDIF
  218. 211 CONTINUE
  219. SEGDES IDMAT
  220. ENDIF
  221. SEGDES IZL
  222. ENDIF
  223. SEGDES MATRAK
  224. 1 CONTINUE
  225. *
  226. * Normal termination
  227. *
  228. RETURN
  229. *
  230. * Format handling
  231. *
  232. *
  233. * Error handling
  234. *
  235. 9999 CONTINUE
  236. WRITE(IOIMP,*) 'An error was detected in subroutine wrmtak'
  237. RETURN
  238. *
  239. * End of subroutine WRMTIK
  240. *
  241. END
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  
  255.  

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