Télécharger mkizt2.eso

Retour à la liste

Numérotation des lignes :

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

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