Télécharger promat.eso

Retour à la liste

Numérotation des lignes :

  1. C PROMAT SOURCE PV 16/11/17 22:01:17 9180
  2. SUBROUTINE PROMAT(MPRIB,MDUAB,IMATB,
  3. $ MPRIC,MDUAC,IMATC,
  4. $ CHPOD,
  5. $ MPCDB,MDCDB,IMTCDB,
  6. $ IMPR,IRET)
  7. IMPLICIT INTEGER(I-N)
  8. IMPLICIT REAL*8 (A-H,O-Z)
  9. C***********************************************************************
  10. C NOM : PROMAT
  11. C DESCRIPTION : Produit de matrices élémentaires.
  12. C
  13. C
  14. C LANGAGE : ESOPE
  15. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  16. C mél : gounand@semt2.smts.cea.fr
  17. C***********************************************************************
  18. C APPELES : REPICO, INCCOM, KRIPEE
  19. C MELCOM, KRIPME
  20. C RPENEN, EXINCS, RPENLE, MKNBNC, MIPCDB, MIDCDB
  21. C RPELEN, ML2LIE, RPELLE, MKLBLC, MLDCDB
  22. C CP2LR, MA2LIR, PROLIS, LI2MAS
  23. C APPELES (STAT.) : PRMSTA, INMSTA
  24. C APPELE PAR : PRCMCT
  25. C***********************************************************************
  26. C ENTREES : MPRIB, MDUAB, IMATB, MPRIC, MDUAC, IMATC, CHPOD
  27. C SORTIES : MPCDB, MDCDB, IMTCDB
  28. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  29. C***********************************************************************
  30. C VERSION : v1, 12/05/99, version initiale
  31. C HISTORIQUE : v1, 12/05/99, création
  32. C HISTORIQUE :
  33. C HISTORIQUE :
  34. C***********************************************************************
  35. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  36. C en cas de modification de ce sous-programme afin de faciliter
  37. C la maintenance !
  38. C***********************************************************************
  39. *
  40. * Il faudra faire les suppressions de segments en tenant
  41. * compte des exceptions.
  42. *
  43. -INC CCOPTIO
  44. -INC SMCOORD
  45. -INC SMELEME
  46. POINTEUR MPRIB.MELEME
  47. POINTEUR MDUAB.MELEME
  48. POINTEUR MPRIC.MELEME
  49. POINTEUR MDUAC.MELEME
  50. POINTEUR MPCDB.MELEME
  51. POINTEUR MDCDB.MELEME
  52. POINTEUR MAIPRI.MELEME
  53. POINTEUR IMATB.IMATRI
  54. POINTEUR IMATC.IMATRI
  55. POINTEUR IMTCDB.IMATRI
  56. -INC SMCHPOI
  57. POINTEUR CHPOD.MCHPOI
  58. -INC SMLMOTS
  59. POINTEUR ICOGLO.MLMOTS
  60. -INC SMLENTI
  61. POINTEUR ICPRIB.MLENTI
  62. POINTEUR ICDUAB.MLENTI
  63. POINTEUR ICPRIC.MLENTI
  64. POINTEUR ICDUAC.MLENTI
  65. POINTEUR ICPRID.MLENTI
  66. POINTEUR JCPRIB.MLENTI
  67. POINTEUR JCDUAB.MLENTI
  68. POINTEUR JCPRIC.MLENTI
  69. POINTEUR JCDUAC.MLENTI
  70. POINTEUR ICOPRI.MLENTI
  71. POINTEUR KRIPRI.MLENTI
  72. POINTEUR LNBMEB.MLENTI
  73. POINTEUR LNBMEC.MLENTI
  74. POINTEUR ICPCDB.MLENTI
  75. POINTEUR KRMPRI.MLENTI
  76. POINTEUR LELEMB.MLENTI
  77. POINTEUR LELEMC.MLENTI
  78. *
  79. * Includes persos
  80. *
  81. *
  82. * Segment LSTIND (liste séquentielle indexée)
  83. *
  84. SEGMENT LSTIND
  85. INTEGER IDX(NBM+1)
  86. INTEGER IVAL(NBTVAL)
  87. ENDSEGMENT
  88. *
  89. * LISTE SEQUENTIELLE INDEXEE D'ENTIERS
  90. *
  91. * NBM : NOMBRE DE MULTIPLETS
  92. * NBTVAL : NOMBRE TOTAL DE VALEURS
  93. * IDX(I) : INDICE DE LA PREMIERE VALEUR DU IEME
  94. * MULTIPLET DANS LE TABLEAU IVAL
  95. * IVAL(IDX(I) -> IDX(I+1)-1) : VALEURS DU IEME MULTIPLET
  96. *-INC SLSTIND
  97. POINTEUR LIPNMC.LSTIND
  98. POINTEUR LINBNC.LSTIND
  99. POINTEUR ICDCDB.LSTIND
  100. POINTEUR LMDUAB.LSTIND
  101. POINTEUR LMPRIB.LSTIND
  102. POINTEUR LMPRIC.LSTIND
  103. POINTEUR LMDUAC.LSTIND
  104. POINTEUR LIPNLC.LSTIND
  105. POINTEUR LILBLC.LSTIND
  106. POINTEUR LMPCDB.LSTIND
  107. POINTEUR LMDCDB.LSTIND
  108. SEGMENT LSRIND
  109. INTEGER IDXX(NBM+1)
  110. REAL*8 XVAL(NBTVAL)
  111. ENDSEGMENT
  112. SEGMENT LLI
  113. POINTEUR LISLI(NBME).LSRIND
  114. ENDSEGMENT
  115. POINTEUR LMATRB.LLI
  116. POINTEUR LMATRC.LLI
  117. POINTEUR LMACDB.LLI
  118. -INC SMLREEL
  119. SEGMENT LLR
  120. POINTEUR LISLR(NBME).MLREEL
  121. ENDSEGMENT
  122. POINTEUR LCHPOD.LLR
  123. *STAT-INC SMSTAT
  124. *STAT POINTEUR MSTEMP.MSTAT
  125. *
  126. INTEGER IMPR,IRET
  127. *
  128. INTEGER NIUNIQ,NIPRI
  129. INTEGER NTOTPO,NPPRI,NELC
  130. *
  131. * Executable statements
  132. *
  133. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans promat.eso'
  134. *STAT CALL INMSTA(MSTAT,0)
  135. * Repérage global des inconnues : ICOGLO (LISTMOTS)
  136. * Noms des inconnues primales et duales de B et C exprimées
  137. * dans ce repérage : IC{PRI,DUA}{B,C}
  138. * (Eventuellement, si CHPOD.NE.0) :
  139. * Noms des inconnues de CHPOD dans ce repérage
  140. * In REPICO : SEGINI ICOGLO
  141. * In REPICO : SEGINI ICPRIB
  142. * In REPICO : SEGINI ICDUAB
  143. * In REPICO : SEGINI ICPRIC
  144. * In REPICO : SEGINI ICDUAC
  145. * In REPICO : SEGINI ICPRID
  146. *STAT CALL INMSTA(MSTEMP,0)
  147. * WRITE(IOIMP,*) 'repico'
  148. CALL REPICO(IMATB,IMATC,CHPOD,
  149. $ ICOGLO,ICPRIB,ICDUAB,ICPRIC,ICDUAC,ICPRID,
  150. $ IMPR,IRET)
  151. IF (IRET.NE.0) GOTO 9999
  152. * SEGPRT,ICOGLO
  153. *STAT CALL PRMSTA(' repico',MSTEMP,1)
  154. *STAT CALL SUMSTA(MSTEMP,0)
  155. SEGACT ICOGLO
  156. NIUNIQ=ICOGLO.MOTS(/2)
  157. SEGDES ICOGLO
  158. * Construction de ICOPRI (LISTENTI), liste des inconnues
  159. * appartenant à la fois à ICPRIB, ICPRIC et ICPRID
  160. * In INCCOM : SEGINI ICOPRI
  161. *STAT CALL INMSTA(MSTEMP,0)
  162. * WRITE(IOIMP,*) 'inccom'
  163. CALL INCCOM(ICPRIB,ICPRIC,ICPRID,NIUNIQ,
  164. $ ICOPRI,
  165. $ IMPR,IRET)
  166. IF (IRET.NE.0) GOTO 9999
  167. * SEGPRT,ICOPRI
  168. *STAT CALL PRMSTA(' inccom',MSTEMP,1)
  169. *STAT CALL SUMSTA(MSTEMP,0)
  170. * Si ICOPRI est vide, on sort prématurément
  171. SEGACT ICOPRI
  172. NIPRI=ICOPRI.LECT(/1)
  173. SEGDES ICOPRI
  174. IF (NIPRI.EQ.0) THEN
  175. *! write(ioimp,*) 'pas d''inconnues communes'
  176. * SEGINI ICOPRI
  177. * SEGINI ICPRID
  178. * SEGINI ICDUAC
  179. * SEGINI ICPRIC (exception)
  180. * SEGINI ICDUAB
  181. * SEGINI ICPRIB
  182. * SEGINI ICOGLO
  183. SEGSUP ICOPRI
  184. SEGSUP ICPRID
  185. SEGSUP ICDUAC
  186. SEGSUP ICPRIC
  187. SEGSUP ICDUAB
  188. SEGSUP ICPRIB
  189. SEGSUP ICOGLO
  190. GOTO 9998
  191. ENDIF
  192. * Sinon, on construit KRIPRI où on a repéré les inconnues de ICOPRI
  193. * dans le segment des inconnues globales
  194. * In KRIPEE : SEGINI KRIPRI
  195. *STAT CALL INMSTA(MSTEMP,0)
  196. * WRITE(IOIMP,*) 'kripee'
  197. CALL KRIPEE(ICOPRI,NIUNIQ,
  198. $ KRIPRI,
  199. $ IMPR,IRET)
  200. IF (IRET.NE.0) GOTO 9999
  201. * SEGPRT,KRIPRI
  202. *STAT CALL PRMSTA(' kripee',MSTEMP,1)
  203. *STAT CALL SUMSTA(MSTEMP,0)
  204. *STAT CALL PRMSTA(' Inc. primales communes',MSTAT,1)
  205. SEGSUP ICOPRI
  206. * Construction du maillage des points communs au maillage
  207. * primal de B, au maillage primal de C et au maillage sous-tendant
  208. * CHPOD (si CHPOD.NE.0)
  209. NTOTPO=XCOOR(/1)/(IDIM+1)
  210. * In MELCOM : SEGINI MAIPRI
  211. *STAT CALL INMSTA(MSTEMP,0)
  212. * WRITE(IOIMP,*) 'melcom'
  213. CALL MELCOM(MPRIB,CHPOD,MPRIC,
  214. $ MAIPRI,
  215. $ IMPR,IRET)
  216. IF (IRET.NE.0) GOTO 9999
  217. *STAT CALL PRMSTA(' melcom',MSTEMP,1)
  218. *STAT CALL SUMSTA(MSTEMP,0)
  219. * Si MAIPRI est vide, on sort prématurément
  220. SEGACT MAIPRI
  221. NPPRI=MAIPRI.NUM(/2)
  222. SEGDES MAIPRI
  223. IF (NPPRI.EQ.0) THEN
  224. *! write(ioimp,*) 'pas de points communs'
  225. * SEGINI MAIPRI
  226. * SEGINI KRIPRI
  227. * SEGINI ICPRID
  228. * SEGINI ICDUAC (exception)
  229. * SEGINI ICPRIC
  230. * SEGINI ICDUAB
  231. * SEGINI ICPRIB
  232. * SEGINI ICOGLO
  233. SEGSUP MAIPRI
  234. SEGSUP KRIPRI
  235. SEGSUP ICPRID
  236. SEGSUP ICDUAC
  237. SEGSUP ICPRIC
  238. SEGSUP ICDUAB
  239. SEGSUP ICPRIB
  240. SEGSUP ICOGLO
  241. GOTO 9998
  242. ENDIF
  243. * Sinon, on construit le segment de repérage dans MAIPRI
  244. * In KRIPME : SEGINI KRMPRI
  245. *STAT CALL INMSTA(MSTEMP,0)
  246. * WRITE(IOIMP,*) 'kripme'
  247. CALL KRIPME(MAIPRI,NTOTPO,
  248. $ KRMPRI,
  249. $ IMPR,IRET)
  250. IF (IRET.NE.0) GOTO 9999
  251. *STAT CALL PRMSTA(' kripme',MSTEMP,1)
  252. *STAT CALL SUMSTA(MSTEMP,0)
  253. *STAT CALL PRMSTA(' Points primaux communs',MSTAT,1)
  254. SEGSUP MAIPRI
  255. *
  256. * Traitement des inconnues
  257. *
  258. * On repère les éléments de ICPRIB qui sont dans ICOPRI
  259. * In RPENEN : SEGINI LNBMEB
  260. *STAT CALL INMSTA(MSTEMP,0)
  261. * WRITE(IOIMP,*) 'rpenen1'
  262. CALL RPENEN(ICPRIB,KRIPRI,
  263. $ LNBMEB,
  264. $ IMPR,IRET)
  265. IF (IRET.NE.0) GOTO 9999
  266. * On repère les éléments de ICPRIC qui sont dans ICOPRI
  267. * In RPENEN : SEGINI LNBMEC
  268. * WRITE(IOIMP,*) 'rpenen2'
  269. CALL RPENEN(ICPRIC,KRIPRI,
  270. $ LNBMEC,
  271. $ IMPR,IRET)
  272. IF (IRET.NE.0) GOTO 9999
  273. * SEGPRT,LNBMEB
  274. * SEGPRT,LNBMEC
  275. *STAT CALL PRMSTA(' rpenen*2',MSTEMP,1)
  276. *STAT CALL SUMSTA(MSTEMP,0)
  277. * Extraction des inconnues qui vont servir
  278. * In EXINCS : SEGINI JCPRIB
  279. * In EXINCS : SEGINI JCDUAB
  280. * In EXINCS : SEGINI JCPRIC
  281. * In EXINCS : SEGINI JCDUAC
  282. *STAT CALL INMSTA(MSTEMP,0)
  283. * WRITE(IOIMP,*) 'exincs'
  284. CALL EXINCS(ICDUAB,ICPRIB,ICPRIC,ICDUAC,
  285. $ LNBMEB,LNBMEC,
  286. $ JCDUAB,JCPRIB,JCPRIC,JCDUAC,
  287. $ IMPR,IRET)
  288. IF (IRET.NE.0) GOTO 9999
  289. *STAT CALL PRMSTA(' exincs',MSTEMP,1)
  290. *STAT CALL SUMSTA(MSTEMP,0)
  291. SEGSUP ICDUAC
  292. SEGSUP ICPRIC
  293. SEGSUP ICDUAB
  294. SEGSUP ICPRIB
  295. * On crée la liste indexée de correspondance :
  296. * une inconnue de ICOPRI -> n°s(IBMEs) matrice C tels que
  297. * JCPRIC(IBME)=ICOPRI
  298. * In RPENLE : SEGINI LIPNMC
  299. *STAT CALL INMSTA(MSTEMP,0)
  300. * WRITE(IOIMP,*) 'rpenle'
  301. CALL RPENLE(JCPRIC,KRIPRI,NIPRI,
  302. $ LIPNMC,
  303. $ IMPR,IRET)
  304. IF (IRET.NE.0) GOTO 9999
  305. * SEGPRT,JCPRIC
  306. * SEGPRT,LIPNMC
  307. *STAT CALL PRMSTA(' rpenle',MSTEMP,1)
  308. *STAT CALL SUMSTA(MSTEMP,0)
  309. * On crée la liste indexée de correspondance :
  310. * n°(NBME) matrice B -> n°s(NBMEs) matrice C ayant la même inconnue
  311. * primale
  312. * In MKNBNC : SEGINI LINBNC
  313. *STAT CALL INMSTA(MSTEMP,0)
  314. * SEGPRT,JCPRIB
  315. * WRITE(IOIMP,*) 'mknbnc'
  316. CALL MKNBNC(JCPRIB,LIPNMC,KRIPRI,
  317. $ LINBNC,
  318. $ IMPR,IRET)
  319. IF (IRET.NE.0) GOTO 9999
  320. *STAT CALL PRMSTA(' mknbnc',MSTEMP,1)
  321. *STAT CALL SUMSTA(MSTEMP,0)
  322. * On construit la liste des inconnues primales de CD-1Bt
  323. * In MIPCDB : SEGINI ICPCDB
  324. *STAT CALL INMSTA(MSTEMP,0)
  325. * WRITE(IOIMP,*) 'mipcdb'
  326. CALL MIPCDB(JCDUAB,NIUNIQ,
  327. $ ICPCDB,
  328. $ IMPR,IRET)
  329. IF (IRET.NE.0) GOTO 9999
  330. *STAT CALL PRMSTA(' mipcdb',MSTEMP,1)
  331. *STAT CALL SUMSTA(MSTEMP,0)
  332. * On construit la liste indexée à la précédente des
  333. * inconnues duales de CD-1Bt.
  334. * In MIDCDB : SEGINI ICDCDB
  335. *STAT CALL INMSTA(MSTEMP,0)
  336. * WRITE(IOIMP,*) 'midcdb'
  337. CALL MIDCDB(ICPCDB,JCDUAB,LINBNC,JCDUAC,NIUNIQ,
  338. $ ICDCDB,
  339. $ IMPR,IRET)
  340. IF (IRET.NE.0) GOTO 9999
  341. *STAT CALL PRMSTA(' midcdb',MSTEMP,1)
  342. *STAT CALL SUMSTA(MSTEMP,0)
  343. *STAT CALL PRMSTA(' Traitement des inconnues',MSTAT,1)
  344. SEGSUP LINBNC
  345. *
  346. * Traitement des maillages
  347. *
  348. * Construction de la liste des éléments du maillage primal de B
  349. * qui contiennent un point de MAIPRI.
  350. * In RPELEN : SEGINI LELEMB
  351. *STAT CALL INMSTA(MSTEMP,0)
  352. * WRITE(IOIMP,*) 'rpelen1'
  353. CALL RPELEN(MPRIB,KRMPRI,
  354. $ LELEMB,
  355. $ IMPR,IRET)
  356. IF (IRET.NE.0) GOTO 9999
  357. * SEGPRT,LELEMB
  358. * Construction de la liste des éléments du maillage primal de C
  359. * qui contiennent un point de MAIPRI.
  360. * In RPELEN : SEGINI LELEMC
  361. * WRITE(IOIMP,*) 'rpelen2'
  362. CALL RPELEN(MPRIC,KRMPRI,
  363. $ LELEMC,
  364. $ IMPR,IRET)
  365. IF (IRET.NE.0) GOTO 9999
  366. * SEGPRT,LELEMC
  367. *STAT CALL PRMSTA(' rpelen*2',MSTEMP,1)
  368. *STAT CALL SUMSTA(MSTEMP,0)
  369. * Extraction des éléments des MELEMEs qui vont servir et
  370. * transformation en listes indexées plus faciles à manipuler
  371. * In ML2LIE : SEGINI LMDUAB
  372. * In ML2LIE : SEGINI LMPRIB
  373. * In ML2LIE : SEGINI LMPRIC
  374. * In ML2LIE : SEGINI LMDUAC
  375. *STAT CALL INMSTA(MSTEMP,0)
  376. * WRITE(IOIMP,*) 'ml2lie'
  377. CALL ML2LIE(MDUAB,MPRIB,MPRIC,MDUAC,
  378. $ LELEMB,LELEMC,
  379. $ LMDUAB,LMPRIB,LMPRIC,LMDUAC,
  380. $ IMPR,IRET)
  381. IF (IRET.NE.0) GOTO 9999
  382. *STAT CALL PRMSTA(' ml2lie',MSTEMP,1)
  383. *STAT CALL SUMSTA(MSTEMP,0)
  384. * On crée la liste indexée de correspondance :
  385. * un point de MAIPRI -> n°s des éléments de LMPRIC qui contiennent
  386. * ce point
  387. * In REPELLE : SEGINI LIPNLC
  388. *STAT CALL INMSTA(MSTEMP,0)
  389. * WRITE(IOIMP,*) 'rpelle'
  390. CALL RPELLE(LMPRIC,KRMPRI,NPPRI,
  391. $ LIPNLC,
  392. $ IMPR,IRET)
  393. IF (IRET.NE.0) GOTO 9999
  394. *STAT CALL PRMSTA(' rpelle',MSTEMP,1)
  395. *STAT CALL SUMSTA(MSTEMP,0)
  396. * On crée la liste indexée de correspondance :
  397. * n° matrice élémentaire B -> n°s matrices élémentaires C
  398. SEGACT LMPRIC
  399. NELC=LMPRIC.IDX(/1)-1
  400. SEGDES LMPRIC
  401. * In MKLBLC : SEGINI LILBLC
  402. *STAT CALL INMSTA(MSTEMP,0)
  403. * WRITE(IOIMP,*) 'mklblc'
  404. CALL MKLBLC(LMPRIB,KRMPRI,LIPNLC,NELC,
  405. $ LILBLC,
  406. $ IMPR,IRET)
  407. IF (IRET.NE.0) GOTO 9999
  408. *STAT CALL PRMSTA(' mklblc',MSTEMP,1)
  409. *STAT CALL SUMSTA(MSTEMP,0)
  410. SEGSUP LIPNLC
  411. * On construit la liste des éléments primaux de CD-1Bt.
  412. * C'est déjà fait, c'est LMDUAB
  413. LMPCDB=LMDUAB
  414. * On construit la liste des éléments duaux de CD-1Bt.
  415. * In MLDCDB : SEGINI LMDCDB
  416. *STAT CALL INMSTA(MSTEMP,0)
  417. * WRITE(IOIMP,*) 'mldcdb'
  418. CALL MLDCDB(LILBLC,LMDUAC,NTOTPO,
  419. $ LMDCDB,
  420. $ IMPR,IRET)
  421. IF (IRET.NE.0) GOTO 9999
  422. *STAT CALL PRMSTA(' mldcdb',MSTEMP,1)
  423. *STAT CALL SUMSTA(MSTEMP,0)
  424. *STAT CALL PRMSTA(' Traitement des maillages',MSTAT,1)
  425. *
  426. * Traitement (éventuel) du chpoint
  427. *
  428. * In CP2LR : SEGINI LCHPOD
  429. * In CP2LR : SEGINI LCHPOD.LISLR(*)
  430. * Attention, 2 segments supp. sont créés du fait du fonctionnement de
  431. * DTCHPO.
  432. *STAT CALL INMSTA(MSTEMP,0)
  433. * WRITE(IOIMP,*) 'cp2lr'
  434. CALL CP2LR(CHPOD,
  435. $ ICPRID,ICOGLO,KRIPRI,NIPRI,
  436. $ KRMPRI,NPPRI,
  437. $ LCHPOD,
  438. $ IMPR,IRET)
  439. IF (IRET.NE.0) GOTO 9999
  440. *STAT CALL PRMSTA(' cp2lr ',MSTEMP,1)
  441. *STAT CALL SUMSTA(MSTEMP,0)
  442. *STAT CALL PRMSTA(' Traitement du chpoint',MSTAT,1)
  443. IF (ICPRID.NE.0) THEN
  444. SEGSUP ICPRID
  445. ENDIF
  446. *
  447. * Traitement des matrices
  448. *
  449. * Extraction des éléments des IMATRIs qui vont servir et
  450. * transformation en listes indexées plus faciles à manipuler
  451. * In MA2LIR : SEGINI LMATRB
  452. * In MA2LIR : SEGINI LMATRB.LISLI(*)
  453. * In MA2LIR : SEGINI LMATRC
  454. * In MA2LIR : SEGINI LMATRC.LISLI(*)
  455. *STAT CALL INMSTA(MSTEMP,0)
  456. * WRITE(IOIMP,*) 'ma2lir'
  457. CALL MA2LIR(IMATB,IMATC,
  458. $ LNBMEB,LNBMEC,LELEMB,LELEMC,
  459. $ LMATRB,LMATRC,
  460. $ IMPR,IRET)
  461. IF (IRET.NE.0) GOTO 9999
  462. * SEGPRT,LMATRB
  463. * SEGPRT,LMATRC
  464. *STAT CALL PRMSTA(' ma2lir',MSTEMP,1)
  465. *STAT CALL SUMSTA(MSTEMP,0)
  466. *STAT CALL PRMSTA(' Traitement des matrices',MSTAT,1)
  467. SEGSUP LELEMC
  468. SEGSUP LELEMB
  469. SEGSUP LNBMEC
  470. SEGSUP LNBMEB
  471. * Produit des matrices stockées sous forme de listes indexées
  472. * In MA2LIR : SEGINI LMACDB
  473. * In MA2LIR : SEGINI LMACDB.LISLI(*)
  474. *STAT CALL INMSTA(MSTEMP,0)
  475. * WRITE(IOIMP,*) 'prolis'
  476. CALL PROLIS(JCDUAB,JCPRIB,JCPRIC,JCDUAC,
  477. $ LIPNMC, KRIPRI,
  478. $ LMDUAB,LMPRIB,LMPRIC,LMDUAC,
  479. $ LILBLC,KRMPRI,
  480. $ LCHPOD,LMATRB,LMATRC,
  481. $ ICPCDB,ICDCDB,NIUNIQ,
  482. $ LMPCDB,LMDCDB,NTOTPO,
  483. $ LMACDB,
  484. $ IMPR,IRET)
  485. IF (IRET.NE.0) GOTO 9999
  486. * WRITE(IOIMP,*) 'apres prolis'
  487. *STAT CALL PRMSTA(' prolis',MSTEMP,1)
  488. *STAT CALL SUMSTA(MSTEMP,0)
  489. *STAT CALL PRMSTA(' On effectue le produit',MSTAT,1)
  490. SEGACT LMATRC*MOD
  491. SEGSUP LMATRC.LISLI(*)
  492. * SEGDES LMATRC
  493. SEGSUP LMATRC
  494. SEGACT LMATRB*MOD
  495. SEGSUP LMATRB.LISLI(*)
  496. * SEGDES LMATRB
  497. SEGSUP LMATRB
  498. IF (LCHPOD.NE.0) THEN
  499. SEGACT LCHPOD*MOD
  500. SEGSUP LCHPOD.LISLR(*)
  501. * SEGDES LCHPOD
  502. SEGSUP LCHPOD
  503. ENDIF
  504. SEGSUP LILBLC
  505. SEGSUP LMDUAC
  506. SEGSUP LMPRIC
  507. SEGSUP LMPRIB
  508. SEGSUP LIPNMC
  509. SEGSUP JCDUAC
  510. SEGSUP JCPRIC
  511. SEGSUP JCDUAB
  512. SEGSUP JCPRIB
  513. SEGSUP KRMPRI
  514. SEGSUP KRIPRI
  515. * Transformation des listes indexées résultats en maillages et en
  516. * matrices.
  517. *STAT CALL INMSTA(MSTEMP,0)
  518. * WRITE(IOIMP,*) 'li2mas'
  519. CALL LI2MAS(ICPCDB,ICDCDB,ICOGLO,
  520. $ LMPCDB,LMDCDB,LMACDB,
  521. $ MPCDB,MDCDB,IMTCDB,
  522. $ IMPR,IRET)
  523. IF (IRET.NE.0) GOTO 9999
  524. *STAT CALL PRMSTA(' Traitement du produit',MSTAT,1)
  525. *STAT CALL PRMSTA(' li2mas',MSTEMP,1)
  526. *STAT CALL SUMSTA(MSTEMP,0)
  527. SEGACT LMACDB*MOD
  528. SEGSUP LMACDB.LISLI(*)
  529. * SEGDES LMACDB
  530. SEGSUP LMACDB
  531. SEGSUP LMDCDB
  532. SEGSUP LMPCDB
  533. SEGSUP ICDCDB
  534. SEGSUP ICPCDB
  535. SEGSUP ICOGLO
  536. *STAT CALL SUMSTA(MSTAT,0)
  537. *
  538. * Normal termination
  539. *
  540. IRET=0
  541. RETURN
  542. *
  543. * Format handling
  544. *
  545. *
  546. * Error handling
  547. *
  548. * Pas une erreur proprement dite, mais il n'y avait rien à multiplier
  549. 9998 CONTINUE
  550. MPCDB=0
  551. MDCDB=0
  552. IMTCDB=0
  553. IRET=0
  554. RETURN
  555. 9999 CONTINUE
  556. IRET=1
  557. WRITE(IOIMP,*) 'An error was detected in subroutine promat'
  558. RETURN
  559. *
  560. * End of subroutine PROMAT
  561. *
  562. END
  563.  
  564.  
  565.  
  566.  
  567.  
  568.  
  569.  
  570.  

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