Télécharger promat.eso

Retour à la liste

Numérotation des lignes :

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

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