Télécharger mkizat.eso

Retour à la liste

Numérotation des lignes :

  1. C MKIZAT SOURCE PV 16/11/17 22:00:48 9180
  2. SUBROUTINE MKIZAT(MELDUA,MELPRI,IMATEL,
  3. $ KRINCD,KRINCP,KMINCT,KRSPGT,
  4. $ PMTOT,
  5. $ IZATOT,
  6. $ IMPR,IRET)
  7. IMPLICIT INTEGER(I-N)
  8. IMPLICIT REAL*8 (A-H,O-Z)
  9. C***********************************************************************
  10. C NOM : MKIZAT
  11. C DESCRIPTION : Matrice élémentaire + Profil Morse de la matrice
  12. C assemblée => ajout de la contribution de la transposée
  13. C de la matrice élémentaire aux valeurs de la matrice
  14. C Morse assemblée.
  15. C
  16. C Le profil Morse est supposé avoir ses colonnes
  17. C ordonnées.
  18. C
  19. C !!!!!!!!
  20. C Ce source devrait être quasiment identique à mkiza et évolué en
  21. C même temps...
  22. C
  23. C LANGAGE : ESOPE
  24. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  25. C mél : gounand@semt2.smts.cea.fr
  26. C***********************************************************************
  27. C APPELES : REGMAI, IFIDIC, INIRPM
  28. C APPELE PAR : PRASEM
  29. C***********************************************************************
  30. C ENTREES : MELDUA, MELPRI, IMATEL, KRINCD, KRINCP, KMINCT,
  31. C KRSPGT, PMTOT
  32. C ENTREES/SORTIES : IZATOT
  33. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  34. C***********************************************************************
  35. C VERSION : v1, 16/12/99
  36. C HISTORIQUE : v1, 16/12/99, création
  37. C HISTORIQUE : 05/01/00 : On ne suppose plus les maillages duaux et
  38. C primaux partitionnés de la même façon que les matrices
  39. C élémentaires.
  40. C HISTORIQUE :
  41. C HISTORIQUE :
  42. C***********************************************************************
  43. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  44. C en cas de modification de ce sous-programme afin de faciliter
  45. C la maintenance !
  46. C***********************************************************************
  47. -INC CCOPTIO
  48. -INC SMELEME
  49. POINTEUR MELDUA.MELEME
  50. POINTEUR ML2DUA.MELEME
  51. POINTEUR SMLDUA.MELEME
  52. POINTEUR MELPRI.MELEME
  53. POINTEUR ML2PRI.MELEME
  54. POINTEUR SMLPRI.MELEME
  55. POINTEUR IMATEL.IMATRI
  56. POINTEUR VMATEL.IZAFM
  57. POINTEUR KMINCT.MINC
  58. POINTEUR PMTOT.PMORS
  59. POINTEUR IZATOT.IZA
  60. -INC SMLENTI
  61. POINTEUR KRINCD.MLENTI
  62. POINTEUR KRINCP.MLENTI
  63. POINTEUR KRSPGT.MLENTI
  64. POINTEUR RPMAT.MLENTI
  65. *
  66. INTEGER IMPR,IRET
  67. *
  68. LOGICAL LPARTD,LPARTP
  69. INTEGER IDX,IDXDEB
  70. INTEGER ISOUM,NBSOUM,NBSOUD,NBSOUP
  71. INTEGER ITDDLD,ITDDLP,ITIDUA,ITIPRI,ITPODU,ITPOPR
  72. INTEGER NBCMPD,NBCMPP,NELPRI
  73. INTEGER ILMAT,JDMAT,IPMAT,IMATL
  74. INTEGER NLMAT,NDMAT,NPMAT,NBMATL
  75. INTEGER LONLIG
  76. INTEGER IELEM
  77. INTEGER NUELG,OLDISM,ISOUMA,NUELOC
  78. *
  79. * Executable statements
  80. *
  81. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mkizat'
  82. * On régularise les maillage pour plus se faire chier si LISOUS(/1).EQ.0
  83. * In REGMAI : IF (.NOT.LPARTD) SEGINI ML2DUA
  84. CALL REGMAI(MELDUA,ML2DUA,LPARTD,IMPR,IRET)
  85. IF (IRET.NE.0) GOTO 9999
  86. * In REGMAI : IF (.NOT.LPARTP) SEGINI ML2PRI
  87. CALL REGMAI(MELPRI,ML2PRI,LPARTP,IMPR,IRET)
  88. IF (IRET.NE.0) GOTO 9999
  89. *
  90. * Activons les chapeaux (Matrices et supports)
  91. *
  92. SEGACT ML2DUA
  93. NBSOUD=ML2DUA.LISOUS(/1)
  94. SEGACT ML2PRI
  95. NBSOUP=ML2PRI.LISOUS(/1)
  96. SEGACT IMATEL
  97. NBSOUM=NBSOUP
  98. NBMATL=IMATEL.LIZAFM(/2)
  99. IF (NBSOUD.NE.NBSOUP) THEN
  100. WRITE(IOIMP,*) 'Maillage primal, dual :'
  101. WRITE(IOIMP,*) 'partitionnment différent...'
  102. WRITE(IOIMP,*) 'NBSOUD=',NBSOUD
  103. WRITE(IOIMP,*) 'NBSOUP=',NBSOUP
  104. GOTO 9999
  105. ENDIF
  106. *
  107. * Tableau de repérage dans la matrice
  108. *
  109. * In INIRPM : SEGINI RPMAT
  110. CALL INIRPM(IMATEL,RPMAT,IMPR,IRET)
  111. IF (IRET.NE.0) GOTO 9999
  112. *
  113. * Activons les tableaux de repérage
  114. *
  115. SEGACT KRINCD
  116. NBCMPD=KRINCD.LECT(/1)
  117. SEGACT KRINCP
  118. NBCMPP=KRINCP.LECT(/1)
  119. IF (NBCMPD.NE.NBMATL.OR.NBCMPP.NE.NBMATL) THEN
  120. WRITE(IOIMP,*) 'KRINCD, KRINCP et IMATEL :'
  121. WRITE(IOIMP,*) 'nb. comp. différents...'
  122. GOTO 9999
  123. ENDIF
  124. SEGACT KMINCT
  125. SEGACT KRSPGT
  126. SEGACT PMTOT
  127. SEGACT IZATOT*MOD
  128. *
  129. * Parcourons les matrices élémentaires par sous-domaine et
  130. * remplissons les valeurs de la matrice Morse.
  131. *
  132. DO 1 IMATL=1,NBMATL
  133. ITIDUA=KRINCD.LECT(IMATL)
  134. ITIPRI=KRINCP.LECT(IMATL)
  135. NUELG=0
  136. OLDISM=1
  137. VMATEL=IMATEL.LIZAFM(OLDISM,IMATL)
  138. SEGACT VMATEL
  139. DO 12 ISOUM=1,NBSOUM
  140. SMLDUA=ML2DUA.LISOUS(ISOUM)
  141. SEGACT SMLDUA
  142. SMLPRI=ML2PRI.LISOUS(ISOUM)
  143. SEGACT SMLPRI
  144. NELPRI=SMLPRI.NUM(/2)
  145. DO 122 IELEM=1,NELPRI
  146. NUELG=NUELG+1
  147. CALL RPELEM(NUELG,RPMAT,ISOUMA,NUELOC,IMPR,IRET)
  148. IF (IRET.NE.0) GOTO 9999
  149. ISOUMA=MAX(ISOUMA,1)
  150. IF (ISOUMA.NE.OLDISM) THEN
  151. SEGDES VMATEL
  152. VMATEL=IMATEL.LIZAFM(ISOUMA,IMATL)
  153. SEGACT VMATEL
  154. OLDISM=ISOUMA
  155. ENDIF
  156. ILMAT=NUELOC
  157. NPMAT=VMATEL.AM(/2)
  158. NDMAT=VMATEL.AM(/3)
  159. DO 1222 JDMAT=1,NDMAT
  160. ITPODU=KRSPGT.LECT(SMLDUA.NUM(JDMAT,IELEM))
  161. IF (ITPODU.EQ.0) THEN
  162. WRITE(IOIMP,*) 'Point dual ????'
  163. GOTO 9999
  164. ENDIF
  165. C Test du MPOS... déjà fait dans mkpmor...
  166. ITDDLD=KMINCT.NPOS(ITPODU)
  167. $ + KMINCT.MPOS(ITPODU,ITIDUA)-1
  168. C IPMAT parce que IDMAT est le nom d'un segment par défaut...
  169. DO 12222 IPMAT=1,NPMAT
  170. ITPOPR=KRSPGT.LECT(SMLPRI.NUM(IPMAT,IELEM))
  171. IF (ITPOPR.EQ.0) THEN
  172. WRITE(IOIMP,*) 'Point primal ????'
  173. GOTO 9999
  174. ENDIF
  175. ITDDLP=KMINCT.NPOS(ITPOPR)
  176. $ + KMINCT.MPOS(ITPOPR,ITIPRI)-1
  177. IDXDEB=PMTOT.IA(ITDDLP)
  178. LONLIG=PMTOT.IA(ITDDLP+1)-IDXDEB
  179. IF (LONLIG.EQ.0) THEN
  180. WRITE(IOIMP,*) 'Ligne inex. ddl pri =',ITDDLP
  181. GOTO 9999
  182. ENDIF
  183. CALL IFIDIC(LONLIG,PMTOT.JA(IDXDEB),ITDDLD,
  184. $ IDX,
  185. $ IMPR,IRET)
  186. IF (IRET.NE.0) GOTO 9999
  187. IZATOT.A(IDXDEB+IDX-1)=IZATOT.A(IDXDEB+IDX-1)
  188. $ + VMATEL.AM(ILMAT,IPMAT,JDMAT)
  189. 12222 CONTINUE
  190. 1222 CONTINUE
  191. 122 CONTINUE
  192. SEGDES VMATEL
  193. 12 CONTINUE
  194. SEGDES SMLPRI
  195. SEGDES SMLDUA
  196. 1 CONTINUE
  197. SEGDES IZATOT
  198. SEGDES PMTOT
  199. SEGDES KRSPGT
  200. SEGDES KMINCT
  201. SEGDES KRINCP
  202. SEGDES KRINCD
  203. SEGSUP RPMAT
  204. SEGDES IMATEL
  205. SEGDES ML2PRI
  206. SEGDES ML2DUA
  207. IF (.NOT.LPARTP) SEGSUP ML2PRI
  208. IF (.NOT.LPARTD) SEGSUP ML2DUA
  209. *
  210. * Normal termination
  211. *
  212. IRET=0
  213. RETURN
  214. *
  215. * Format handling
  216. *
  217. *
  218. * Error handling
  219. *
  220. 9999 CONTINUE
  221. IRET=1
  222. WRITE(IOIMP,*) 'An error was detected in subroutine mkizat'
  223. RETURN
  224. *
  225. * End of subroutine MKIZAT
  226. *
  227. END
  228.  
  229.  
  230.  
  231.  
  232.  
  233.  
  234.  
  235.  

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