Télécharger mkiza.eso

Retour à la liste

Numérotation des lignes :

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

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