Télécharger mkpmo3.eso

Retour à la liste

Numérotation des lignes :

  1. C MKPMO3 SOURCE PV 16/11/17 22:00:50 9180
  2. SUBROUTINE MKPMO3(LPDPP,KJSPGD,KRINCP,KRINCD,
  3. $ KRSPGT,KMINCT,
  4. $ LDDLDU,PMCOU,
  5. $ IMPR,IRET)
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8 (A-H,O-Z)
  8. C***********************************************************************
  9. C NOM : MKPMO3
  10. C PROJET : Assemblage matrice élémentaire -> matrice Morse
  11. C DESCRIPTION : Matrice élémentaire + liste indexée d'entiers(popoin) =>
  12. C Profil Morse de la matrice assemblée (les colonnes ne
  13. C sont pas ordonnées).
  14. C Basé sur mkpmo2, mais ici les lignes ne sont pas non plus
  15. C ordonnées.
  16. C
  17. C
  18. C
  19. C LANGAGE : ESOPE
  20. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  21. C mél : gounand@semt2.smts.cea.fr
  22. C***********************************************************************
  23. C APPELES : CORINC
  24. C APPELE PAR : MAKPRM
  25. C***********************************************************************
  26. C ENTREES : LPDPP, KJSPGD, KRINCP, KRINCD, KRSPGT, KMINCT
  27. C SORTIES : PMCOU
  28. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  29. C***********************************************************************
  30. C VERSION : v1, 09/02/2016, version initiale
  31. C HISTORIQUE : v1, 09/02/2016, création
  32. C HISTORIQUE :
  33. C HISTORIQUE :
  34. C***********************************************************************
  35. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  36. C en cas de modification de ce sous-programme afin de faciliter
  37. C la maintenance !
  38. C***********************************************************************
  39. *
  40. *
  41. * On peut optimiser les boucles en sortant les NPOS
  42. *
  43. *
  44. -INC CCOPTIO
  45. -INC SMELEME
  46. POINTEUR KJSPGD.MELEME
  47. POINTEUR KMINCT.MINC
  48. INTEGER NTT,NJA
  49. POINTEUR PMCOU.PMORS
  50. -INC SMLENTI
  51. INTEGER JG
  52. POINTEUR KRINCD.MLENTI
  53. POINTEUR KRIDUN.MLENTI
  54. POINTEUR KRINCP.MLENTI
  55. POINTEUR KRSPGT.MLENTI
  56. POINTEUR DD2DP.MLENTI
  57. POINTEUR LDDLDU.MLENTI
  58. POINTEUR KDDLDU.MLENTI
  59. *
  60. * Includes perso
  61. *
  62. *-INC SLSTIND
  63. *
  64. * Segment LSTIND (liste séquentielle indexée)
  65. *
  66. SEGMENT LSTIND
  67. INTEGER IDX(NBM+1)
  68. INTEGER IVAL(NBTVAL)
  69. ENDSEGMENT
  70. *
  71. * LISTE SEQUENTIELLE INDEXEE D'ENTIERS
  72. *
  73. * NBM : NOMBRE DE MULTIPLETS
  74. * NBTVAL : NOMBRE TOTAL DE VALEURS
  75. * IDX(I) : INDICE DE LA PREMIERE VALEUR DU IEME
  76. * MULTIPLET DANS LE TABLEAU IVAL
  77. * IVAL(IDX(I) -> IDX(I+1)-1) : VALEURS DU IEME MULTIPLET
  78. POINTEUR LIPUN.LSTIND
  79. POINTEUR LPDPP.LSTIND
  80. *
  81. INTEGER IMPR,IRET
  82. *
  83. LOGICAL LEXIST
  84. INTEGER IDEPA
  85. INTEGER IDUNIQ,IPUNIQ,IPDUA,IPPRI,ITTDDL
  86. INTEGER NDUNIQ,NPDUA, NTTDDL
  87. INTEGER NOPPR,NOPDU
  88. INTEGER NUTPPR,NUTPDU,NUTDPR,NUTDDU
  89. INTEGER NTOTCO,NTOTPO
  90. *
  91. * Executable statements
  92. *
  93. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mkpmo3'
  94. C Pour chaque composante primale distincte, il faudrait déterminer
  95. C avec quels composantes duales distinctes il est relié :
  96. C Par exemple, si on a :
  97. C KRINCD = 1 1 1 2
  98. C KRINCP = 2 2 3 4
  99. C On a : KRIDUN = 1 2
  100. C On veut : LIPUN = (2 3) (4) (c'est une liste indexée)
  101. C
  102. CALL CORINC(KRINCD,KRINCP,
  103. $ KRIDUN,LIPUN,
  104. $ IMPR,IRET)
  105. IF (IRET.NE.0) GOTO 9999
  106. SEGACT KRIDUN
  107. NDUNIQ=KRIDUN.LECT(/1)
  108. SEGACT LIPUN
  109. SEGACT KJSPGD
  110. SEGACT KRSPGT
  111. SEGACT KMINCT
  112. NTOTPO=KMINCT.NPOS(/1)-1
  113. * NTTDDL=KMINCT.NPOS(NTOTPO+1)-1
  114. * JG=NTTDDL
  115. * SEGINI DD2DP
  116. SEGACT LPDPP
  117. NPDUA=KJSPGD.NUM(/2)
  118. nddldu=npdua*nduniq
  119. jg=nddldu
  120. segini lddldu
  121. segact lpdpp
  122. nja=0
  123. do ipdua=1,npdua
  124. nppri=LPDPP.IDX(IPDUA+1)-LPDPP.IDX(IPDUA)
  125. do iduniq=1,nduniq
  126. npuniq=LIPUN.IDX(IDUNIQ+1)-LIPUN.IDX(IDUNIQ)
  127. nja=nja+(npuniq*nppri)
  128. enddo
  129. enddo
  130.  
  131. * write(ioimp,*) 'dimensionnement'
  132. * write(ioimp,*) 'nddldu= ',nddldu
  133. * write(ioimp,*) 'nja= ',nja
  134. ntt=nddldu
  135. segini pmcou
  136. *
  137. iddldu=1
  138. ija=1
  139. * pmcou.ia(1)=ija
  140. do ipdua=1,npdua
  141. nutpdu=krspgt.lect(kjspgd.num(1,ipdua))
  142. do iduniq=1,nduniq
  143. nutddu=KMINCT.NPOS(NUTPDU)
  144. $ +KMINCT.MPOS(NUTPDU,KRIDUN.LECT(IDUNIQ))-1
  145. lddldu.lect(iddldu)=nutddu
  146. pmcou.ia(iddldu)=ija
  147. iddldu=iddldu+1
  148. do ippri=LPDPP.IDX(IPDUA),LPDPP.IDX(IPDUA+1)-1
  149. nutppr=krspgt.lect(lpdpp.ival(ippri))
  150. do ipuniq=LIPUN.IDX(IDUNIQ),LIPUN.IDX(IDUNIQ+1)-1
  151. NUTDPR=KMINCT.NPOS(NUTPPR)
  152. $ +KMINCT.MPOS(NUTPPR,LIPUN.IVAL(IPUNIQ))-1
  153. pmcou.ja(ija)=nutdpr
  154. ija=ija+1
  155. enddo
  156. enddo
  157. enddo
  158. enddo
  159. pmcou.ia(iddldu)=ija
  160. * write(ioimp,*) 'profil morse'
  161. * write(ioimp,*) 'iddldu= ',iddldu
  162. * write(ioimp,*) 'ija= ',ija
  163. * stop 16
  164.  
  165. SEGDES LDDLDU
  166. SEGDES PMCOU
  167. SEGDES LPDPP
  168. SEGDES KMINCT
  169. SEGDES KRSPGT
  170. SEGDES KJSPGD
  171. SEGSUP LIPUN
  172. SEGSUP KRIDUN
  173. *
  174. * Normal termination
  175. *
  176. IRET=0
  177. RETURN
  178. *
  179. * Format handling
  180. *
  181. *
  182. * Error handling
  183. *
  184. 9999 CONTINUE
  185. IRET=1
  186. WRITE(IOIMP,*) 'An error was detected in subroutine mkpmo3'
  187. RETURN
  188. *
  189. * End of subroutine MKPMO3
  190. *
  191. END
  192.  
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  

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