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

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