Télécharger li2mas.eso

Retour à la liste

Numérotation des lignes :

  1. C LI2MAS SOURCE PV 16/11/17 22:00:35 9180
  2. SUBROUTINE LI2MAS(ICPCDB,ICDCDB,ICOGLO,
  3. $ LMPCDB,LMDCDB,LMACDB,
  4. $ MPCDB,MDCDB,IMTCDB,
  5. $ IMPR,IRET)
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8 (A-H,O-Z)
  8. C***********************************************************************
  9. C NOM : LI2MAS
  10. C DESCRIPTION : Transformation des listes indexées résultats en
  11. C maillages et en matrices.
  12. C
  13. C
  14. C LANGAGE : ESOPE
  15. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  16. C mél : gounand@semt2.smts.cea.fr
  17. C***********************************************************************
  18. C APPELES : -
  19. C APPELE PAR : PROMAT
  20. C***********************************************************************
  21. C ENTREES : ICPCDB, ICDCDB, ICOGLO, LMPCDB, LMDCDB, LMACDB
  22. C SORTIES : MPCDB, MDCDB, IMTCDB
  23. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  24. C***********************************************************************
  25. C VERSION : v1, 16/02/2000, version initiale
  26. C HISTORIQUE : v1, 16/02/2000, création
  27. C HISTORIQUE :
  28. C HISTORIQUE :
  29. C***********************************************************************
  30. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  31. C en cas de modification de ce sous-programme afin de faciliter
  32. C la maintenance !
  33. C***********************************************************************
  34.  
  35. -INC PPARAM
  36. -INC CCOPTIO
  37. -INC SMELEME
  38. INTEGER NBNN,NBELEM,NBSOUS,NBREF
  39. POINTEUR MPCDB.MELEME
  40. POINTEUR MDCDB.MELEME
  41. POINTEUR SMPCDB.MELEME
  42. POINTEUR SMDCDB.MELEME
  43. INTEGER NBME
  44. POINTEUR IMTCDB.IMATRI
  45. INTEGER NBEL,NP,MP
  46. POINTEUR SMTCDB.IZAFM
  47. -INC SMLMOTS
  48. POINTEUR ICOGLO.MLMOTS
  49. -INC SMLENTI
  50. POINTEUR ICPCDB.MLENTI
  51. POINTEUR NPLPRI.MLENTI
  52. POINTEUR NPLDUA.MLENTI
  53. INTEGER JG
  54. POINTEUR KCPLPD.MLENTI
  55. * Includes persos
  56. * Segment LSTIND (liste séquentielle indexée)
  57. SEGMENT LSTIND
  58. INTEGER IDX(NBM+1)
  59. INTEGER IVAL(NBTVAL)
  60. ENDSEGMENT
  61. *-INC SLSTIND
  62. POINTEUR ICDCDB.LSTIND
  63. POINTEUR LMPCDB.LSTIND
  64. POINTEUR LMDCDB.LSTIND
  65. INTEGER NBM,NBTVAL
  66. POINTEUR CPLEL.LSTIND
  67. SEGMENT LSRIND
  68. INTEGER IDXX(NBM+1)
  69. REAL*8 XVAL(NBTVAL)
  70. ENDSEGMENT
  71. POINTEUR SMACDB.LSRIND
  72. SEGMENT LLI
  73. POINTEUR LISLI(NBME).LSRIND
  74. ENDSEGMENT
  75. POINTEUR LMACDB.LLI
  76. *
  77. INTEGER IMPR,IRET
  78. *
  79. INTEGER IBCLPD,ILCDB,IIPRI,IMP,INP
  80. INTEGER NBCLPD,NLCDB,NIPRI
  81. INTEGER IVPLEL,IVSTRT,IVSTOP
  82. INTEGER IBME,IBSTRT,IBSTOP
  83. INTEGER JVPCDB,JVSTRT,JVSTOP
  84. INTEGER JVDCDB,JVPLEL
  85. INTEGER KVSTRT
  86. INTEGER NUEL,NUEL1,KICPD
  87. INTEGER ICPD,NPPCDB,NPDCDB,NTCLPD
  88. INTEGER MXPCDB,MXDCDB
  89. *
  90. * Executable statements
  91. *
  92. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans li2mas.eso'
  93. * SEGPRT,ICPCDB
  94. * SEGPRT,ICDCDB
  95. * SEGPRT,ICOGLO
  96. * SEGPRT,LMPCDB
  97. * SEGPRT,LMDCDB
  98. * SEGPRT,LMACDB
  99. * SEGACT LMACDB
  100. * LSRIND=LMACDB.LISLI(1)
  101. * SEGPRT,LSRIND
  102.  
  103. *
  104. * Il faut construire une partition de la matrice LMACDB
  105. * dont les supports primaux et duaux sont LMPCDB et LMDCDB
  106. *
  107. * Comptons le nb max. de points de LMPCDB et de LMDCDB pour
  108. * dimensionnement du tableau de repérage dans la partition :
  109. * On crée aussi les tableaux de nb. de points par éléments (plus
  110. * pratiques)
  111. SEGACT LMPCDB
  112. SEGACT LMDCDB
  113. NLCDB=LMPCDB.IDX(/1)-1
  114. * D'abord, on crée les tableaux de nb. de points par éléments (plus
  115. * pratiques)
  116. JG=NLCDB
  117. SEGINI NPLPRI
  118. SEGINI NPLDUA
  119. MXPCDB=0
  120. MXDCDB=0
  121. DO 1 ILCDB=1,NLCDB
  122. NPPCDB=LMPCDB.IDX(ILCDB+1)-LMPCDB.IDX(ILCDB)
  123. NPLPRI.LECT(ILCDB)=NPPCDB
  124. MXPCDB=MAX(MXPCDB,NPPCDB)
  125. NPDCDB=LMDCDB.IDX(ILCDB+1)-LMDCDB.IDX(ILCDB)
  126. NPLDUA.LECT(ILCDB)=NPDCDB
  127. MXDCDB=MAX(MXDCDB,NPDCDB)
  128. 1 CONTINUE
  129. SEGDES LMDCDB
  130. SEGDES LMPCDB
  131. * SEGPRT,NPLPRI
  132. * SEGPRT,NPLDUA
  133. * WRITE(IOIMP,*) 'MXPCDB=',MXPCDB
  134. * WRITE(IOIMP,*) 'MXDCDB=',MXDCDB
  135. * Dimension de l'espace des couples (nb. points primaux, nb. points
  136. * duaux)
  137. NTCLPD=MXPCDB*MXDCDB
  138. JG=NTCLPD
  139. SEGINI KCPLPD
  140. * Nb. de couples distincts et segment de repérage sur ces couples
  141. IBCLPD=0
  142. DO 2 ILCDB=1,NLCDB
  143. ICPD=((NPLPRI.LECT(ILCDB)-1)*MXDCDB)
  144. $ +NPLDUA.LECT(ILCDB)
  145. IF (KCPLPD.LECT(ICPD).EQ.0) THEN
  146. IBCLPD=IBCLPD+1
  147. KCPLPD.LECT(ICPD)=IBCLPD
  148. ENDIF
  149. 2 CONTINUE
  150. NBCLPD=IBCLPD
  151. * Création d'une liste indexée :
  152. * A chaque couple repéré par son numéro d'ordre, on associe
  153. * les numéros d'éléments ILCDB
  154. * Dimensionnement de CPLEL
  155. * Pour l'instant CPLEL.IDX(IBCLPD+1)=nombre d'éléments associés au
  156. * IBCLPDème couple.
  157. NBM=NBCLPD
  158. NBTVAL=0
  159. SEGINI CPLEL
  160. DO 3 ILCDB=1,NLCDB
  161. ICPD=((NPLPRI.LECT(ILCDB)-1)*MXDCDB)
  162. $ +NPLDUA.LECT(ILCDB)
  163. KICPD=KCPLPD.LECT(ICPD)
  164. CPLEL.IDX(KICPD+1)=CPLEL.IDX(KICPD+1)+1
  165. 3 CONTINUE
  166. * CPLEL.IDX est transformé en la liste d'indexation sur CPLEL.IVAL
  167. CPLEL.IDX(1)=1
  168. DO 4 IBCLPD=1,NBCLPD
  169. CPLEL.IDX(IBCLPD+1)=CPLEL.IDX(IBCLPD+1)+CPLEL.IDX(IBCLPD)
  170. 4 CONTINUE
  171. NBM=NBCLPD
  172. NBTVAL=CPLEL.IDX(NBCLPD+1)-1
  173. SEGADJ,CPLEL
  174. * CPLEL.IDX est désormais la liste des index courants sur
  175. * CPLEL.IVAL que l'on remplit.
  176. DO 5 ILCDB=1,NLCDB
  177. ICPD=((NPLPRI.LECT(ILCDB)-1)*MXDCDB)
  178. $ +NPLDUA.LECT(ILCDB)
  179. KICPD=KCPLPD.LECT(ICPD)
  180. CPLEL.IVAL(CPLEL.IDX(KICPD))=ILCDB
  181. CPLEL.IDX(KICPD)=CPLEL.IDX(KICPD)+1
  182. 5 CONTINUE
  183. * On restaure les valeurs de CPLEL.IDX
  184. DO 6 IBCLPD=NBCLPD,2,-1
  185. CPLEL.IDX(IBCLPD)=CPLEL.IDX(IBCLPD-1)
  186. 6 CONTINUE
  187. CPLEL.IDX(1)=1
  188. *
  189. * Création et remplissage de MPCDB
  190. *
  191. SEGACT LMPCDB
  192. NBNN=0
  193. NBELEM=0
  194. NBSOUS=NBCLPD
  195. NBREF=0
  196. C SEGINI MPCDB
  197. SEGINI MPCDB
  198. DO 7 IBCLPD=1,NBCLPD
  199. IVSTRT=CPLEL.IDX(IBCLPD)
  200. IVSTOP=CPLEL.IDX(IBCLPD+1)-1
  201. NUEL1=CPLEL.IVAL(IVSTRT)
  202. NBNN=NPLPRI.LECT(NUEL1)
  203. NBELEM=IVSTOP-IVSTRT+1
  204. NBSOUS=0
  205. NBREF=0
  206. SEGINI SMPCDB
  207. * Type d'élément : POLY (cf. bdata.eso)
  208. SMPCDB.ITYPEL=32
  209. DO 72 IVPLEL=IVSTRT,IVSTOP
  210. NUEL=CPLEL.IVAL(IVPLEL)
  211. JVSTRT=LMPCDB.IDX(NUEL)
  212. JVSTOP=LMPCDB.IDX(NUEL+1)-1
  213. DO 722 JVPCDB=JVSTRT,JVSTOP
  214. SMPCDB.NUM(JVPCDB-JVSTRT+1,IVPLEL-IVSTRT+1)=
  215. $ LMPCDB.IVAL(JVPCDB)
  216. 722 CONTINUE
  217. 72 CONTINUE
  218. SEGDES SMPCDB
  219. MPCDB.LISOUS(IBCLPD)=SMPCDB
  220. 7 CONTINUE
  221. IF (NBCLPD.EQ.1) THEN
  222. SMPCDB=MPCDB.LISOUS(1)
  223. SEGSUP MPCDB
  224. MPCDB=SMPCDB
  225. ELSE
  226. SEGDES MPCDB
  227. ENDIF
  228. SEGDES LMPCDB
  229. *
  230. * Création et remplissage de MDCDB
  231. *
  232. SEGACT LMDCDB
  233. NBNN=0
  234. NBELEM=0
  235. NBSOUS=NBCLPD
  236. NBREF=0
  237. C SEGINI MDCDB
  238. SEGINI MDCDB
  239. DO 8 IBCLPD=1,NBCLPD
  240. IVSTRT=CPLEL.IDX(IBCLPD)
  241. IVSTOP=CPLEL.IDX(IBCLPD+1)-1
  242. NUEL1=CPLEL.IVAL(IVSTRT)
  243. NBNN=NPLDUA.LECT(NUEL1)
  244. NBELEM=IVSTOP-IVSTRT+1
  245. NBSOUS=0
  246. NBREF=0
  247. SEGINI SMDCDB
  248. * Type d'élément : POLY (cf. bdata.eso)
  249. SMDCDB.ITYPEL=32
  250. DO 82 IVPLEL=IVSTRT,IVSTOP
  251. NUEL=CPLEL.IVAL(IVPLEL)
  252. JVSTRT=LMDCDB.IDX(NUEL)
  253. JVSTOP=LMDCDB.IDX(NUEL+1)-1
  254. DO 822 JVDCDB=JVSTRT,JVSTOP
  255. SMDCDB.NUM(JVDCDB-JVSTRT+1,IVPLEL-IVSTRT+1)=
  256. $ LMDCDB.IVAL(JVDCDB)
  257. 822 CONTINUE
  258. 82 CONTINUE
  259. SEGDES SMDCDB
  260. MDCDB.LISOUS(IBCLPD)=SMDCDB
  261. 8 CONTINUE
  262. IF (NBCLPD.EQ.1) THEN
  263. SMDCDB=MDCDB.LISOUS(1)
  264. SEGSUP MDCDB
  265. MDCDB=SMDCDB
  266. ELSE
  267. SEGDES MDCDB
  268. ENDIF
  269. SEGDES LMDCDB
  270. *
  271. * Création et remplissage de IMTCDB
  272. *
  273. SEGACT ICOGLO
  274. SEGACT ICPCDB
  275. SEGACT ICDCDB
  276. SEGACT LMPCDB
  277. SEGACT LMDCDB
  278. SEGACT LMACDB
  279. NBME=ICDCDB.IVAL(/1)
  280. NBSOUS=NBCLPD
  281. SEGINI IMTCDB
  282. NIPRI=ICPCDB.LECT(/1)
  283. DO 9 IIPRI=1,NIPRI
  284. IBSTRT=ICDCDB.IDX(IIPRI)
  285. IBSTOP=ICDCDB.IDX(IIPRI+1)-1
  286. DO 92 IBME=IBSTRT,IBSTOP
  287. IMTCDB.LISPRI(IBME)=ICOGLO.MOTS(ICPCDB.LECT(IIPRI))
  288. IMTCDB.LISDUA(IBME)=ICOGLO.MOTS(ICDCDB.IVAL(IBME))
  289. SMACDB=LMACDB.LISLI(IBME)
  290. SEGACT SMACDB
  291. DO 922 IBCLPD=1,NBCLPD
  292. JVSTRT=CPLEL.IDX(IBCLPD)
  293. JVSTOP=CPLEL.IDX(IBCLPD+1)-1
  294. NUEL1=CPLEL.IVAL(JVSTRT)
  295. NBEL=JVSTOP-JVSTRT+1
  296. NP=NPLPRI.LECT(NUEL1)
  297. MP=NPLDUA.LECT(NUEL1)
  298. SEGINI SMTCDB
  299. DO 9222 JVPLEL=JVSTRT,JVSTOP
  300. NUEL=CPLEL.IVAL(JVPLEL)
  301. KVSTRT=SMACDB.IDXX(NUEL)
  302. DO 92222 IMP=1,MP
  303. DO 92224 INP=1,NP
  304. SMTCDB.AM(JVPLEL-JVSTRT+1,INP,IMP)=
  305. $ SMACDB.XVAL(KVSTRT)
  306. KVSTRT=KVSTRT+1
  307. 92224 CONTINUE
  308. 92222 CONTINUE
  309. 9222 CONTINUE
  310. SEGDES SMTCDB
  311. IMTCDB.LIZAFM(IBCLPD,IBME)=SMTCDB
  312. 922 CONTINUE
  313. SEGDES SMACDB
  314. 92 CONTINUE
  315. 9 CONTINUE
  316. SEGDES IMTCDB
  317. SEGDES LMACDB
  318. SEGDES LMDCDB
  319. SEGDES LMPCDB
  320. SEGDES ICDCDB
  321. SEGDES ICPCDB
  322. SEGDES ICOGLO
  323. SEGSUP CPLEL
  324. SEGSUP KCPLPD
  325. SEGSUP NPLDUA
  326. SEGSUP NPLPRI
  327. * SEGPRT,MPCDB
  328. * SEGPRT,MDCDB
  329. * SEGPRT,IMTCDB
  330. *
  331. * Normal termination
  332. *
  333. IRET=0
  334. RETURN
  335. *
  336. * Format handling
  337. *
  338. *
  339. * Error handling
  340. *
  341. 9999 CONTINUE
  342. IRET=1
  343. WRITE(IOIMP,*) 'An error was detected in subroutine li2mas'
  344. RETURN
  345. *
  346. * End of subroutine LI2MAS
  347. *
  348. END
  349.  
  350.  
  351.  
  352.  
  353.  
  354.  
  355.  
  356.  

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