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 CCOPTIO
  45. -INC SMELEME
  46. POINTEUR MELDUA.MELEME
  47. POINTEUR ML2DUA.MELEME
  48. POINTEUR SMLDUA.MELEME
  49. POINTEUR MELPRI.MELEME
  50. POINTEUR ML2PRI.MELEME
  51. POINTEUR SMLPRI.MELEME
  52. POINTEUR IMATEL.IMATRI
  53. POINTEUR VMATEL.IZAFM
  54. POINTEUR KMINCT.MINC
  55. POINTEUR PMTOT.PMORS
  56. POINTEUR IZATOT.IZA
  57. * POINTEUR IDMTOT.IDMAT
  58. POINTEUR IDMATP.IDMAT
  59. POINTEUR IDMATD.IDMAT
  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 mkizt2'
  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. C IPMAT parce que IDMAT est le nom d'un segment par défaut...
  174. DO 12222 IPMAT=1,NPMAT
  175. ITPOPR=KRSPGT.LECT(SMLPRI.NUM(IPMAT,IELEM))
  176. IF (ITPOPR.EQ.0) THEN
  177. WRITE(IOIMP,*) 'Point primal ????'
  178. GOTO 9999
  179. ENDIF
  180. ITDDLP=IDMATP.NUAN(
  181. $ KMINCT.NPOS(ITPOPR)
  182. $ + KMINCT.MPOS(ITPOPR,ITIPRI)-1
  183. $ )
  184. IDXDEB=PMTOT.IA(ITDDLP)
  185. LONLIG=PMTOT.IA(ITDDLP+1)-IDXDEB
  186. IF (LONLIG.EQ.0) THEN
  187. WRITE(IOIMP,*) 'Ligne inex. ddl pri =',ITDDLP
  188. GOTO 9999
  189. ENDIF
  190. CALL IFIDIC(LONLIG,PMTOT.JA(IDXDEB),ITDDLD,
  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 VMATEL
  200. 12 CONTINUE
  201. SEGDES SMLPRI
  202. SEGDES SMLDUA
  203. 1 CONTINUE
  204. SEGDES IZATOT
  205. SEGDES IDMATD
  206. SEGDES IDMATP
  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 mkizt2'
  233. RETURN
  234. *
  235. * End of subroutine MKIZT2
  236. *
  237. END
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  

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