Télécharger prmcp2.eso

Retour à la liste

Numérotation des lignes :

  1. C PRMCP2 SOURCE PV 16/11/17 22:01:13 9180
  2. SUBROUTINE PRMCP2(MMLPRI,MMLDUA,MMATEL,MSOPRI,
  3. $ MSODUA,
  4. $ IMPR,IRET)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM : PRMCP2
  9. C DESCRIPTION : Produit matrices élémentaires * msoupo primal
  10. C -> msoupo dual.
  11. C
  12. C
  13. C LANGAGE : ESOPE
  14. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  15. C mél : gounand@semt2.smts.cea.fr
  16. C***********************************************************************
  17. C APPELES : PRMCP3, PRMCP4, PRMCP5, KRIPEE, KRIPME,
  18. C RPENEN, EXENEN, IUNIQ, MLUNIQ
  19. C APPELE PAR : PRDMCP
  20. C***********************************************************************
  21. C ENTREES : MMLPRI, MMLDUA, MMATEL, MSOPRI
  22. C ENTREES/SORTIES : -
  23. C SORTIES : MSODUA
  24. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  25. C***********************************************************************
  26. C VERSION : v1, 18/04/2000, version initiale
  27. C HISTORIQUE : v1, 18/04/2000, création
  28. C HISTORIQUE :
  29. C HISTORIQUE :
  30. C***********************************************************************
  31. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  32. C en cas de modification de ce sous-programme afin de faciliter
  33. C la maintenance !
  34. C***********************************************************************
  35. -INC CCOPTIO
  36. -INC SMCOORD
  37. -INC SMELEME
  38. POINTEUR MMLPRI.MELEME
  39. POINTEUR MMLDUA.MELEME
  40. POINTEUR MLCPRI.MELEME
  41. POINTEUR MLCDUA.MELEME
  42. POINTEUR MMATEL.IMATRI
  43. -INC SMCHPOI
  44. POINTEUR MSOPRI.MSOUPO
  45. POINTEUR MSODUA.MSOUPO
  46. INTEGER N,NC
  47. POINTEUR MPOPRI.MPOVAL
  48. POINTEUR MPODUA.MPOVAL
  49. -INC SMLMOTS
  50. POINTEUR ICOGLO.MLMOTS
  51. -INC SMLENTI
  52. INTEGER JG
  53. POINTEUR ICMPRI.MLENTI
  54. POINTEUR ICMDUA.MLENTI
  55. POINTEUR ICCPRI.MLENTI
  56. POINTEUR ICCDUA.MLENTI
  57. POINTEUR ICOPRI.MLENTI
  58. POINTEUR KRIPRI.MLENTI
  59. POINTEUR KICPRI.MLENTI
  60. POINTEUR KICDUA.MLENTI
  61. POINTEUR KMCPRI.MLENTI
  62. POINTEUR KMCDUA.MLENTI
  63. POINTEUR LNBME.MLENTI
  64. *
  65. * Includes persos
  66. *
  67. INTEGER NBMEL
  68. SEGMENT MELS
  69. POINTEUR LISMEL(NBMEL).MELEME
  70. ENDSEGMENT
  71. POINTEUR GPMELS.MELS
  72. *
  73. INTEGER ICDUA
  74. INTEGER NCDUA
  75. INTEGER NBDUAL,NBDUA2,NIPRI,NIUNIQ,NTOTPO,NPODUA
  76. INTEGER IMPR,IRET
  77. *
  78. * Executable statements
  79. *
  80. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans prmcp2.eso'
  81. *
  82. * On s'occupe d'abord des inconnues
  83. *
  84. * Repérage global des inconnues : ICOGLO (LISTMOTS)
  85. * Numéros des inconnues primales et duales de la matrice exprimées
  86. * dans ce repérage : ICMPRI, ICMDUA
  87. * Numéros des inconnues du chpoint primal : ICCPRI
  88. * i.e.
  89. * ICOGLO: MLMOTS qui contient les inconnues primales,
  90. * duales et les composantes du CHPOINT
  91. * que un seul fois
  92. * ICMPRI.LECT(i) = position de l'inconnue MMATEL.LISPRI(i)
  93. * dans ICOGLO
  94. * ICMDUA.LECT(i) = position de l'inconnue MMATEL.LISDUA(i)
  95. * dans ICOGLO
  96. * ICCPRI.LECT(i) = position de l'inconnue MSOPRI.COMP(i)
  97. * dans ICCPRI
  98. *
  99. * In PRMCP3 : SEGINI ICOGLO
  100. * In PRMCP3 : SEGINI ICMPRI
  101. * In PRMCP3 : SEGINI ICMDUA
  102. * In PRMCP3 : SEGINI ICCPRI
  103. CALL PRMCP3(MMATEL,MSOPRI,
  104. $ ICOGLO,ICMPRI,ICMDUA,ICCPRI,
  105. $ IMPR,IRET)
  106.  
  107. IF (IRET.NE.0) GOTO 9999
  108. SEGACT ICOGLO
  109. NIUNIQ=ICOGLO.MOTS(/2)
  110. SEGDES ICOGLO
  111. *
  112. * Construction de ICOPRI (LISTENTI), liste des inconnues
  113. * appartenant à la fois à ICMPRI et ICCPRI
  114. * i.e.
  115. * ICOPRI.LECT(/1) = nombre d'inconnues communes
  116. * ICOGLO.MOTS(ICOPRI.LECT(i)) = les inconnues communes
  117. *
  118. * In PRCMP4 : SEGINI ICOPRI
  119. CALL PRMCP4(ICMPRI,ICCPRI,NIUNIQ,
  120. $ ICOPRI,
  121. $ IMPR,IRET)
  122. IF (IRET.NE.0) GOTO 9999
  123. * Bien sur, si ICOPRI est vide, il n'y a pas d'inconnues
  124. * communes; donc on sort prématurément
  125. SEGACT ICOPRI
  126. NIPRI=ICOPRI.LECT(/1)
  127. SEGDES ICOPRI
  128. IF (NIPRI.EQ.0) THEN
  129. * SEGINI ICOPRI
  130. * SEGINI ICCPRI
  131. * SEGINI ICMDUA
  132. * SEGINI ICMPRI
  133. * SEGINI ICOGLO
  134. SEGSUP ICOPRI
  135. SEGSUP ICCPRI
  136. SEGSUP ICMDUA
  137. SEGSUP ICMPRI
  138. SEGSUP ICOGLO
  139. GOTO 9998
  140. ENDIF
  141. * Sinon, on construit KRIPRI où on a repéré les inconnues de ICOPRI
  142. * dans le segment des inconnues globales
  143. * i.e.
  144. * KRIPRI.LECT(j) = 0 si ICOGLO.MOTS(j) n'est pas une inconnue
  145. * commune; sinon
  146. * KRIPRI.LECT(ICOPRI.LECT(i)) = i
  147. *
  148. * In KRIPEE : SEGINI KRIPRI
  149. CALL KRIPEE(ICOPRI,NIUNIQ,
  150. $ KRIPRI,
  151. $ IMPR,IRET)
  152. IF (IRET.NE.0) GOTO 9999
  153. SEGSUP ICOPRI
  154. * On repère les inconnues de ICMPRI qui sont dans ICOPRI
  155. * i.e.
  156. * LNBME.LECT(/1) = nombre d'inconnues de MMATEL.LISPRI
  157. * qui sont dedans ICOGLO
  158. * LNBME.LECT(i) = inconnues de MMATEL.LISPRI en ICOGLO
  159. *
  160. * In RPENEN : SEGINI LNBME
  161. CALL RPENEN(ICMPRI,KRIPRI,
  162. $ LNBME,
  163. $ IMPR,IRET)
  164. IF (IRET.NE.0) GOTO 9999
  165.  
  166. SEGSUP KRIPRI
  167. *
  168. * Ceci permet de construire les inconnues du chpo. dual
  169. *
  170. * ICCDUA.LECT(/1) = LNBME.LECT(/1)
  171. * ICCDUA.LECT(i) = les inconnues duales qui correspondent
  172. * aux inconnues primales en ICOGLO
  173. * Donc on extrait de ICCDUA (i.e. de MMATEL.LISDUA)
  174. * les seules composantes qui interviennent dans la
  175. * multiplication.
  176. *
  177. * In EXENEN : SEGINI ICCDUA
  178. *
  179. CALL EXENEN(ICMDUA,LNBME,
  180. $ ICCDUA,
  181. $ IMPR,IRET)
  182. IF (IRET.NE.0) GOTO 9999
  183. * On y supprimme le doublons en ICCDUA
  184. SEGACT ICCDUA*MOD
  185. NBDUA2=ICCDUA.LECT(/1)
  186. CALL IUNIQ(ICCDUA.LECT,NBDUA2,
  187. $ ICCDUA.LECT,NBDUAL,IMPR,IRET)
  188. IF (IRET.NE.0) GOTO 9999
  189. JG=NBDUAL
  190. SEGADJ ICCDUA
  191. SEGDES ICCDUA
  192. * On construit KICPRI où on a repéré les inconnues de ICCPRI
  193. * dans le segment des inconnues globales
  194. * In KRIPEE : SEGINI KICPRI
  195. CALL KRIPEE(ICCPRI,NIUNIQ,
  196. $ KICPRI,
  197. $ IMPR,IRET)
  198. IF (IRET.NE.0) GOTO 9999
  199. SEGSUP ICCPRI
  200. * On construit KICDUA où on a repéré les inconnues de ICCDUA
  201. * dans le segment des inconnues globales
  202. * In KRIPEE : SEGINI KICDUA
  203. CALL KRIPEE(ICCDUA,NIUNIQ,
  204. $ KICDUA,
  205. $ IMPR,IRET)
  206. IF (IRET.NE.0) GOTO 9999
  207. *
  208. * On s'occupe des maillages
  209. *
  210. NTOTPO=XCOOR(/1)/(IDIM+1)
  211. * Le support géométrique de MSODUA sera le maillage des points
  212. * de MMLDUA
  213. NBMEL=1
  214. SEGINI GPMELS
  215. GPMELS.LISMEL(1)=MMLDUA
  216. CALL MLUNIQ(GPMELS,MLCDUA,IMPR,IRET)
  217. IF (IRET.NE.0) GOTO 9999
  218. SEGSUP GPMELS
  219. SEGACT MSOPRI
  220. MLCPRI=MSOPRI.IGEOC
  221. MPOPRI=MSOPRI.IPOVAL
  222. SEGDES MSOPRI
  223. * On construit KMCPRI où on a repéré les points de MLCPRI
  224. * dans le segment des points globaux
  225. * In KRIPME : SEGINI KMCPRI
  226. CALL KRIPME(MLCPRI,NTOTPO,
  227. $ KMCPRI,
  228. $ IMPR,IRET)
  229. IF (IRET.NE.0) GOTO 9999
  230. * On construit KMCDUA où on a repéré les points de MLCDUA
  231. * dans le segment des points globaux
  232. * In KRIPME : SEGINI KMCDUA
  233. CALL KRIPME(MLCDUA,NTOTPO,
  234. $ KMCDUA,
  235. $ IMPR,IRET)
  236. IF (IRET.NE.0) GOTO 9999
  237. * On initialise le chpoint dual
  238. * Inconnues
  239. SEGACT ICOGLO
  240. SEGACT ICCDUA
  241. NCDUA=ICCDUA.LECT(/1)
  242. NC=NCDUA
  243. SEGINI MSODUA
  244. DO 3 ICDUA=1,NCDUA
  245. MSODUA.NOCOMP(ICDUA)=ICOGLO.MOTS(ICCDUA.LECT(ICDUA))(1:4)
  246. 3 CONTINUE
  247. * SEGDES ICCDUA
  248. SEGSUP ICCDUA
  249. * SEGDES ICOGLO
  250. SEGSUP ICOGLO
  251. * Maillage
  252. SEGACT MLCDUA
  253. NPODUA=MLCDUA.NUM(/2)
  254. SEGDES MLCDUA
  255. MSODUA.IGEOC=MLCDUA
  256. NC=NCDUA
  257. N=NPODUA
  258. SEGINI MPODUA
  259. SEGDES MPODUA
  260. MSODUA.IPOVAL=MPODUA
  261. SEGDES MSODUA
  262. *
  263. * On effectue le produit (remplissage de MPODUA)
  264. *
  265. CALL PRMCP5(MMLPRI,MMLDUA,MMATEL,ICMPRI,ICMDUA,LNBME,
  266. $ MPOPRI,KICPRI,KMCPRI,
  267. $ KICDUA,KMCDUA,
  268. $ MPODUA,
  269. $ IMPR,IRET)
  270. IF (IRET.NE.0) GOTO 9999
  271. SEGSUP KMCDUA
  272. SEGSUP KMCPRI
  273. SEGSUP KICDUA
  274. SEGSUP KICPRI
  275. SEGSUP LNBME
  276. SEGSUP ICMPRI
  277. SEGSUP ICMDUA
  278. *
  279. * Normal termination
  280. *
  281. IRET=0
  282. RETURN
  283. *
  284. * Format handling
  285. *
  286. *
  287. * Error handling
  288. *
  289. * Pas une erreur proprement dite, mais il n'y avait pas de composantes communes
  290. 9998 CONTINUE
  291. MSODUA=0
  292. IRET=0
  293. RETURN
  294. 9999 CONTINUE
  295. IRET=1
  296. WRITE(IOIMP,*) 'An error was detected in subroutine prmcp2'
  297. RETURN
  298. *
  299. * End of subroutine PRMCP2
  300. *
  301. END
  302.  
  303.  
  304.  
  305.  
  306.  
  307.  
  308.  
  309.  

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