Télécharger ecmatk.eso

Retour à la liste

Numérotation des lignes :

  1. C ECMATK SOURCE PV 16/11/17 21:59:14 9180
  2. SUBROUTINE ECMATK(IMATRK)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C***********************************************************************
  6. C NOM : ECMATK
  7. C DESCRIPTION : Impression d'un segment de type MATRIK
  8. C
  9. C Les sous-programmes ECIMAT, ECMINC, ECMORS sont
  10. C également appelables indépendamment en Esope.
  11. C (utiles pour la mise au point).
  12. C
  13. C Ils impriment respectivement les segments de type
  14. C IMATRI, MINC, (KMORS, KISA)<->matrice Morse.
  15. C
  16. C Pour plus de précisions, voir la notice de ces
  17. C sous-programmes et l'include SMMATRIK.
  18. C
  19. C
  20. C LANGAGE : ESOPE
  21. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  22. C mél : gounand@semt2.smts.cea.fr
  23. C***********************************************************************
  24. C APPELES (E/S) : LIRENT, ERREUR
  25. C ECIMAT, ECMINC, ECMORS
  26. C***********************************************************************
  27. C SYNTAXE GIBIANE : 'LIST' MATRIK NIVIMP
  28. C ENTREES : IMATRK
  29. C ENTREES/SORTIES : -
  30. C SORTIES : -
  31. C CODE RETOUR (IRET) : -
  32. C IMATRK : segment de type MATRIK (include SMMATRIK)
  33. C NIVIMP : niveau d'impression. Suivant sa valeur, on obtient :
  34. C Convention (probablement non totalement respectée) :
  35. C ---------- 0 : presque rien (numéro de pointeur)
  36. C 1 : affichage du chapeau MATRIK
  37. C 2 : affichage des données concernant les objets
  38. C pointés par MATRIK
  39. C 3 : affichage du contenu des objets vectoriels
  40. C 4 : affichage du contenu des objets matriciels
  41. C On ne change pas l'état (actif ou inactif) du segment IMATRK.
  42. C***********************************************************************
  43. C VERSION : 20/12/99
  44. C HISTORIQUE : v1, 01/04/98, création
  45. C HISTORIQUE : 29/10/98, modif. l'état du segment reste inchangé
  46. C en sortie
  47. C HISTORIQUE : 20/12/99, ajout des nouveaux types de matrice (-3) et de
  48. C l'affichage éventuel des maillages supports.
  49. C HISTORIQUE :
  50. C***********************************************************************
  51. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  52. C en cas de modification de ce sous-programme afin de faciliter
  53. C la maintenance !
  54. C***********************************************************************
  55. -INC CCOPTIO
  56. POINTEUR IMATRK.MATRIK
  57. *
  58. * Variables pour la gestion des options de l'opérateur LIST
  59. *
  60. INTEGER NIVIMP
  61. *
  62. INTEGER I,IRETOU,LENTYP,NA
  63. INTEGER NBID,NBLK,NBTMAT,NKMT
  64. INTEGER NKZA,NMATRI,NPT,NRIGE
  65. * Variable d'état du segment IMATRK
  66. INTEGER IMAETA
  67. *
  68. * Tableau de correspondance (numéro <-> type de matrice)
  69. * stocké dans IRIGEL(7,.)
  70. PARAMETER (LENTYP=30)
  71. PARAMETER (NBTMAT=9)
  72. CHARACTER*(LENTYP) TYPMAT(-3:NBTMAT)
  73.  
  74. * Initialisations des tableaux
  75. * Tableau des types de matrice
  76. DATA TYPMAT/
  77. $ 'RECTANGULAIRE (DUAL mult.lag.)',
  78. $ 'inconnu au bataillon ',
  79. $ 'inconnu au bataillon ',
  80. $ 'SYMETRIQUE ',
  81. $ 'ANTISYMETRIQUE ',
  82. $ 'NON SYMETRIQUE ',
  83. $ 'RECTANGULAIRE ',
  84. $ 'CCt (DUAL mult.lag.)',
  85. $ 'DIAGONALE ',
  86. $ 'MORSE ',
  87. $ 'SYMETRIQUE apres assemblage ',
  88. $ 'NON SYMETRIQUE apres assem. ',
  89. $ 'MATRICE DE ROTATION '/
  90.  
  91. * Tableau message d'erreur
  92. MOTERR(1:40)=' '
  93. * Lecture des options :
  94. * On précise un niveau d'impression.
  95. * Par défaut : 1
  96. *
  97. CALL LIRENT(NIVIMP,0,IRETOU)
  98. IF (IRETOU.EQ.0) THEN
  99. NIVIMP=1
  100. ELSEIF ((NIVIMP.LT.0).OR.(NIVIMP.GT.9)) THEN
  101. * %m1:40
  102. * Données incompatibles
  103. MOTERR(1:6)='NIVIMP'
  104. CALL ERREUR(-301)
  105. CALL ERREUR(21)
  106. GOTO 9999
  107. ENDIF
  108. * Début
  109. MATRIK=IMATRK
  110. CALL OOOETA(MATRIK,IMAETA)
  111. IF (IMAETA.NE.1) SEGACT MATRIK
  112. WRITE(IOIMP,2001) 'Segment MATRIK de pointeur ',MATRIK
  113. *
  114. * Affichage du chapeau
  115. *
  116. IF (NIVIMP.GT.0) THEN
  117. NRIGE =IRIGEL(/1)
  118. NMATRI=IRIGEL(/2)
  119. WRITE(IOIMP,1999) 'Rigidités élémentaires :'
  120. WRITE(IOIMP,1000) 'Tableau IRIGEL (',NRIGE,',',NMATRI,')'
  121. DO 2 I=1,NMATRI
  122. WRITE(IOIMP,1001) 'IRIGEL(1,',I,')=',IRIGEL(1,I),
  123. $ ' (Pointeur MELEME primal)'
  124. WRITE(IOIMP,1001) 'IRIGEL(2,',I,')=',IRIGEL(2,I),
  125. $ ' (Pointeur MELEME dual)'
  126. WRITE(IOIMP,1001) 'IRIGEL(4,',I,')=',IRIGEL(4,I),
  127. $ ' (Pointeur IMATRI)'
  128. WRITE(IOIMP,1001) 'IRIGEL(5,',I,')=',IRIGEL(5,I),
  129. $ ' (Non utilisé)'
  130. WRITE(IOIMP,1001) 'IRIGEL(6,',I,')=',IRIGEL(6,I),
  131. $ ' (Non utilisé)'
  132. WRITE(IOIMP,1001) 'IRIGEL(7,',I,')=',IRIGEL(7,I),
  133. $ ' : matrice ',TYPMAT(IRIGEL(7,I))
  134. WRITE(IOIMP,1998) '---'
  135. 2 CONTINUE
  136. WRITE(IOIMP,1999) ' '
  137. WRITE(IOIMP,1999) 'Matrice assemblée :'
  138. WRITE(IOIMP,1996) 'KSYM=',KSYM,' : matrice ',TYPMAT(KSYM)
  139. WRITE(IOIMP,1998) 'Pointeurs MINC (répartition des inconnues)'
  140. WRITE(IOIMP,1002) 'KMINC =',KMINC,'(total)',
  141. $ 'KMINCP=',KMINCP,'(primal)',
  142. $ 'KMINCD=',KMINCD,'(dual)'
  143. WRITE(IOIMP,1998) 'Pointeurs MELEME (SPG assemblés)'
  144. WRITE(IOIMP,1003) 'KISPGT=',KISPGT,
  145. $ 'KISPGP=',KISPGP,
  146. $ 'KISPGD=',KISPGD
  147. IF (NIVIMP.GT.4.AND.KISPGT.NE.0) THEN
  148. MELEME=KISPGT
  149. WRITE(IOIMP,2001) 'Segment MELEME de pointeur',MELEME
  150. WRITE(IOIMP,*) 'pointé par KISPGT'
  151. CALL ECROBJ('MAILLAGE',MELEME)
  152. CALL PRLIST
  153. ENDIF
  154. WRITE(IOIMP,1998) 'Nombre d''inconnues total'
  155. WRITE(IOIMP,1003) 'KNTTT =',KNTTT,
  156. $ 'KNTTP =',KNTTP,
  157. $ 'KNTTD =',KNTTD
  158. WRITE(IOIMP,1998) 'Pointeur MELEME (connectivités globales)'
  159. WRITE(IOIMP,1005) 'KIZM =',KIZM
  160. WRITE(IOIMP,1999) ' '
  161. WRITE(IOIMP,1999) 'Tableau KIDMAT(9) (stockage Choleski) :'
  162. WRITE(IOIMP,1998) 'Pointeur IDMAT'
  163. WRITE(IOIMP,1004) '(1) IDMATP=',KIDMAT(1),
  164. $ '(2) IDMATD=',KIDMAT(2)
  165. WRITE(IOIMP,1998) 'Pointeur IZA (second membre)'
  166. WRITE(IOIMP,1005) '(3) KS2B =',KIDMAT(3)
  167. WRITE(IOIMP,1998) 'Pointeurs PMORS,IZA (matrice assemblée)'
  168. WRITE(IOIMP,1004) '(4) KMORS =',KIDMAT(4),
  169. $ '(5) KISA =',KIDMAT(5)
  170. WRITE(IOIMP,1998) 'Pointeurs PMORS,IZA (matrice assemblée AAt)'
  171. WRITE(IOIMP,1004) '(6) KMRST =',KIDMAT(6),
  172. $ '(7) KIST =',KIDMAT(7)
  173. WRITE(IOIMP,1998) 'Pointeur MCHPOI (conditions aux limites)'
  174. WRITE(IOIMP,1005) '(8) KCLIM =',KIDMAT(8)
  175. WRITE(IOIMP,1007) '(9) KTRING=',KIDMAT(9),'(0=non triangulée)'
  176. NKMT=KKMMT(/1)
  177. WRITE(IOIMP,1999) ' '
  178. WRITE(IOIMP,1006) 'Tableau KKMMT(',NKMT,')',(KKMMT(I),I=1,NKMT)
  179. WRITE(IOIMP,1999) 'END Segment MATRIK'
  180. WRITE(IOIMP,1999) ' '
  181. ENDIF
  182. *
  183. * Affichage des segments pointés par MATRIK
  184. *
  185. IF (NIVIMP.GT.1) THEN
  186. * Affichage des IMATRI
  187. DO 3 I=1,NMATRI
  188. IF (NIVIMP.GT.4) THEN
  189. MELEME=IRIGEL(1,I)
  190. WRITE(IOIMP,2001) 'Segment MELEME de pointeur',MELEME
  191. WRITE(IOIMP,2002) 'pointé par IRIGEL(1,',I,')'
  192. CALL ECROBJ('MAILLAGE',MELEME)
  193. CALL PRLIST
  194. MELEME=IRIGEL(2,I)
  195. WRITE(IOIMP,2001) 'Segment MELEME de pointeur',MELEME
  196. WRITE(IOIMP,2002) 'pointé par IRIGEL(2,',I,')'
  197. CALL ECROBJ('MAILLAGE',MELEME)
  198. CALL PRLIST
  199. ENDIF
  200. IMATRI=IRIGEL(4,I)
  201. WRITE(IOIMP,2001) 'Segment IMATRI de pointeur',IMATRI
  202. WRITE(IOIMP,2002) 'pointé par IRIGEL(4,',I,')'
  203. IF (IMATRI.NE.0) THEN
  204. CALL ECIMAT(IMATRI,NIVIMP)
  205. ENDIF
  206. WRITE(IOIMP,1999) 'End segment IMATRI'
  207. WRITE(IOIMP,1999) ' '
  208. 3 CONTINUE
  209. * Affichage des MINC
  210. IF (KMINC.NE.0) THEN
  211. WRITE(IOIMP,3000) KMINC,'Total'
  212. MINC=KMINC
  213. CALL ECMINC(MINC,NIVIMP)
  214. WRITE(IOIMP,1999) 'End segment MINC'
  215. WRITE(IOIMP,1999) ' '
  216. ENDIF
  217. IF ((KMINCP.NE.0).AND.(KMINCP.NE.KMINC)) THEN
  218. WRITE(IOIMP,3000) KMINCP,'Primal'
  219. MINC=KMINCP
  220. CALL ECMINC(MINC,NIVIMP)
  221. WRITE(IOIMP,1999) 'End segment MINC'
  222. WRITE(IOIMP,1999) ' '
  223. ENDIF
  224. IF ((KMINCD.NE.0).AND.(KMINCD.NE.KMINC).AND.(KMINCD.NE.KMINCP))
  225. $ THEN
  226. WRITE(IOIMP,3000) KMINCD,'Dual'
  227. MINC=KMINCD
  228. CALL ECMINC(MINC,NIVIMP)
  229. WRITE(IOIMP,1999) 'End segment MINC'
  230. WRITE(IOIMP,1999) ' '
  231. ENDIF
  232. * Affichage des matrices stockées en MORSE
  233. PMORS=KIDMAT(4)
  234. IZA=KIDMAT(5)
  235. IF ((PMORS.NE.0).AND.(IZA.NE.0)) THEN
  236. WRITE(IOIMP,4000) PMORS,IZA,'assemblée'
  237. CALL ECMORS(PMORS,IZA,NIVIMP)
  238. WRITE(IOIMP,1999) 'End Matrice Morse'
  239. WRITE(IOIMP,1999) ' '
  240. ENDIF
  241. PMORS=KIDMAT(6)
  242. IZA=KIDMAT(7)
  243. IF ((PMORS.NE.0).AND.(IZA.NE.0)) THEN
  244. WRITE(IOIMP,4000) PMORS,IZA,'assemblée AAt'
  245. CALL ECMORS(PMORS,IZA,NIVIMP)
  246. WRITE(IOIMP,1999) 'End Matrice Morse'
  247. WRITE(IOIMP,1999) ' '
  248. ENDIF
  249. * Affichage du segment stockage bloc Choleski
  250. IF (NIVIMP.GT.3) THEN
  251. DO 5 NBID=1,2
  252. IDMAT=KIDMAT(NBID)
  253. IF (IDMAT.NE.0) THEN
  254. SEGACT IDMAT
  255. IF (NBID.EQ.1) WRITE(IOIMP,5000) IDMAT,'primal'
  256. IF (NBID.EQ.2) WRITE(IOIMP,5000) IDMAT,'dual'
  257. WRITE(IOIMP,*) 'IDIAG=',IDIAG
  258. IF (IDIAG.NE.0) THEN
  259. IZA=IDIAG
  260. SEGACT IZA
  261. NA=A(/1)
  262. WRITE(IOIMP,1902) (A(I),I=1,NA)
  263. SEGDES IZA
  264. ENDIF
  265. NKZA=KZA(/1)
  266. WRITE(IOIMP,*) 'KZA(1..',NKZA,')'
  267. WRITE(IOIMP,5001) (KZA(I),I=1,NKZA)
  268. WRITE(IOIMP,*) 'NUIA(1..',NKZA,',2)'
  269. WRITE(IOIMP,5001) (NUIA(I,1),I=1,NKZA)
  270. WRITE(IOIMP,5001) (NUIA(I,2),I=1,NKZA)
  271. NPT=NUAN(/1)
  272. WRITE(IOIMP,*) 'NUAN(1..',NPT,')'
  273. WRITE(IOIMP,5001) (NUAN(I),I=1,NPT)
  274. WRITE(IOIMP,*) 'NUNA(1..',NPT,')'
  275. WRITE(IOIMP,5001) (NUNA(I),I=1,NPT)
  276. NBLK=IDESCL(/1)
  277. WRITE(IOIMP,*) 'IDESCL(1..',NBLK,')'
  278. WRITE(IOIMP,5001) (IDESCL(I),I=1,NBLK)
  279. WRITE(IOIMP,*) 'IDESCU(1..',NBLK,')'
  280. WRITE(IOIMP,5001) (IDESCU(I),I=1,NBLK)
  281. WRITE(IOIMP,*) 'NLDBLK(1..',NBLK+1,')'
  282. WRITE(IOIMP,5001) (NLDBLK(I),I=1,NBLK+1)
  283. SEGDES IDMAT
  284. ENDIF
  285. 5 CONTINUE
  286. ENDIF
  287. ENDIF
  288. IF (IMAETA.NE.1) SEGDES MATRIK
  289. *
  290. * Normal termination
  291. *
  292. RETURN
  293. *
  294. * Format handling
  295. *
  296. 1901 FORMAT ( ' OBJET DE TYPE MATRIK '/
  297. & ' -------------------- ')
  298. 1902 FORMAT (8(1X,1PE11.2))
  299. * Chapeau MATRIK
  300. 1000 FORMAT (2X,A,I1,A,I1,A)
  301. 1001 FORMAT (4X,A,I1,A,I6,2A)
  302. 1002 FORMAT (4X,A,I6,1X,A,4X,A,I6,1X,A,4X,A,I6,1X,A)
  303. 1003 FORMAT (4X,A,I6,4X,A,I6,4X,A,I6)
  304. 1004 FORMAT (4X,A,I6,4X,A,I6)
  305. 1005 FORMAT (4X,A,I6)
  306. 1006 FORMAT (A,I1,A,8(1X,I6))
  307. 1007 FORMAT (4X,A,I1,2X,A)
  308. 1996 FORMAT (2X,A,I1,A,A)
  309. 1997 FORMAT (4X,A)
  310. 1998 FORMAT (2X,A)
  311. 1999 FORMAT (A)
  312. * Segments IMATRI
  313. 2001 FORMAT (A,1X,I6)
  314. 2002 FORMAT (A,I1,A)
  315. * Segments MINC
  316. 3000 FORMAT ('Segment MINC de pointeur',1X,I6,1X,'(',A,')')
  317. * Matrices Morses
  318. 4000 FORMAT ('Matrice Morse de pointeurs',1X,I6,1X,I6,1X,'(',A,')')
  319. * Chapeau Choleski
  320. 5000 FORMAT ('Chapeau Choleski de pointeur',1X,I6,1X,'(',A,')')
  321. 5001 FORMAT (8(1X,I8))
  322. *
  323. * Error handling
  324. *
  325. 9999 CONTINUE
  326. RETURN
  327. *
  328. * End of subroutine ECMATK
  329. *
  330. END
  331.  
  332.  
  333.  
  334.  
  335.  
  336.  
  337.  

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