Télécharger mkiz2.eso

Retour à la liste

Numérotation des lignes :

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

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