Télécharger mkiz2.eso

Retour à la liste

Numérotation des lignes :

mkiz2
  1. C MKIZ2 SOURCE PV 20/09/26 21:18:52 10724
  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 PPARAM
  43. -INC CCOPTIO
  44. -INC SMELEME
  45. POINTEUR MELDUA.MELEME
  46. POINTEUR ML2DUA.MELEME
  47. POINTEUR SMLDUA.MELEME
  48. POINTEUR MELPRI.MELEME
  49. POINTEUR ML2PRI.MELEME
  50. POINTEUR SMLPRI.MELEME
  51. POINTEUR IMATEL.IMATRI
  52. POINTEUR VMATEL.IZAFM
  53. POINTEUR KMINCT.MINC
  54. POINTEUR PMTOT.PMORS
  55. POINTEUR IZATOT.IZA
  56. * POINTEUR IDMTOT.IDMAT
  57. POINTEUR IDMATP.IDMAT
  58. POINTEUR IDMATD.IDMAT
  59. -INC SMLENTI
  60. POINTEUR KRINCD.MLENTI
  61. POINTEUR KRINCP.MLENTI
  62. POINTEUR KRSPGT.MLENTI
  63. POINTEUR RPMAT.MLENTI
  64. *
  65. INTEGER IMPR,IRET
  66. *
  67. LOGICAL LPARTD,LPARTP
  68. INTEGER IDX,IDXDEB
  69. INTEGER ISOUM,NBSOUM,NBSOUD,NBSOUP
  70. INTEGER ITDDLD,ITDDLP,ITIDUA,ITIPRI,ITPODU,ITPOPR
  71. INTEGER NBCMPD,NBCMPP
  72. INTEGER NELPRI
  73. INTEGER ILMAT,JDMAT,IPMAT,IMATL
  74. INTEGER 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 mkiz2'
  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 IDMTOT
  128. SEGACT IDMATP
  129. SEGACT IDMATD
  130. SEGACT IZATOT*MOD
  131. *
  132. * Parcourons les matrices élémentaires par sous-domaine et
  133. * remplissons les valeurs de la matrice Morse.
  134. *
  135. DO 1 IMATL=1,NBMATL
  136. ITIDUA=KRINCD.LECT(IMATL)
  137. ITIPRI=KRINCP.LECT(IMATL)
  138. NUELG=0
  139. OLDISM=1
  140. VMATEL=IMATEL.LIZAFM(OLDISM,IMATL)
  141. SEGACT VMATEL
  142. DO 12 ISOUM=1,NBSOUM
  143. SMLDUA=ML2DUA.LISOUS(ISOUM)
  144. SEGACT SMLDUA
  145. SMLPRI=ML2PRI.LISOUS(ISOUM)
  146. SEGACT SMLPRI
  147. NELPRI=SMLPRI.NUM(/2)
  148. DO 122 IELEM=1,NELPRI
  149. NUELG=NUELG+1
  150. CALL RPELEM(NUELG,RPMAT,ISOUMA,NUELOC,IMPR,IRET)
  151. IF (IRET.NE.0) GOTO 9999
  152. ISOUMA=MAX(ISOUMA,1)
  153. IF (ISOUMA.NE.OLDISM) THEN
  154. SEGDES VMATEL
  155. VMATEL=IMATEL.LIZAFM(ISOUMA,IMATL)
  156. SEGACT VMATEL
  157. OLDISM=ISOUMA
  158. ENDIF
  159. ILMAT=NUELOC
  160. NPMAT=VMATEL.AM(/2)
  161. NDMAT=VMATEL.AM(/3)
  162. DO 1222 JDMAT=1,NDMAT
  163. ITPODU=KRSPGT.LECT(SMLDUA.NUM(JDMAT,IELEM))
  164. IF (ITPODU.EQ.0) THEN
  165. WRITE(IOIMP,*) 'Point dual ????'
  166. GOTO 9999
  167. ENDIF
  168. C Test du MPOS... déjà fait dans mkpmor...
  169. ITDDLD=IDMATD.NUAN(
  170. $ KMINCT.NPOS(ITPODU)
  171. $ + KMINCT.MPOS(ITPODU,ITIDUA)-1
  172. $ )
  173. IDXDEB=PMTOT.IA(ITDDLD)
  174. LONLIG=PMTOT.IA(ITDDLD+1)-IDXDEB
  175. IF (LONLIG.EQ.0) THEN
  176. WRITE(IOIMP,*) 'Ligne inex. ddl dua =',ITDDLD
  177. GOTO 9999
  178. ENDIF
  179. C IPMAT parce que IDMAT est le nom d'un segment par défaut...
  180. DO 12222 IPMAT=1,NPMAT
  181. ITPOPR=KRSPGT.LECT(SMLPRI.NUM(IPMAT,IELEM))
  182. IF (ITPOPR.EQ.0) THEN
  183. WRITE(IOIMP,*) 'Point primal ????'
  184. GOTO 9999
  185. ENDIF
  186. ITDDLP=IDMATP.NUAN(
  187. $ KMINCT.NPOS(ITPOPR)
  188. $ + KMINCT.MPOS(ITPOPR,ITIPRI)-1
  189. $ )
  190. CALL IFIDIC(LONLIG,PMTOT.JA(IDXDEB),ITDDLP,
  191. $ IDX,
  192. $ IMPR,IRET)
  193. IF (IRET.NE.0) GOTO 9999
  194. IZATOT.A(IDXDEB+IDX-1)=IZATOT.A(IDXDEB+IDX-1)
  195. $ + VMATEL.AM(ILMAT,IPMAT,JDMAT)
  196. 12222 CONTINUE
  197. 1222 CONTINUE
  198. 122 CONTINUE
  199. SEGDES SMLPRI
  200. SEGDES SMLDUA
  201. 12 CONTINUE
  202. SEGDES VMATEL
  203. 1 CONTINUE
  204. SEGDES IZATOT
  205. SEGDES IDMATP
  206. SEGDES IDMATD
  207. * SEGDES IDMTOT
  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 mkiz2'
  233. RETURN
  234. *
  235. * End of subroutine MKIZ2
  236. *
  237. END
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  

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