Télécharger makpr2.eso

Retour à la liste

Numérotation des lignes :

  1. C MAKPR2 SOURCE PV 16/11/17 22:00:40 9180
  2. SUBROUTINE MAKPR2(MELPRI,KRINCP,
  3. $ MELDUA,NPODUA,KJSPGD,KRSPGD,KRINCD,
  4. $ KMINCT,KRSPGT,
  5. $ LDDLDU,PMCOU,
  6. $ IMPR,IRET)
  7. IMPLICIT INTEGER(I-N)
  8. IMPLICIT REAL*8 (A-H,O-Z)
  9. C***********************************************************************
  10. C NOM : MAKPR2
  11. C PROJET : Noyau linéaire NLIN
  12. C DESCRIPTION : Matrice élémentaire + repérage => profil Morse de la
  13. C matrice assemblée (les colonnes ne sont pas
  14. C ordonnées).
  15. C
  16. C LANGAGE : ESOPE
  17. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  18. C mél : gounand@semt2.smts.cea.fr
  19. C***********************************************************************
  20. C APPELES : PONBL2, POELM2, PONBPO, POPOIN, MKPMOR
  21. C APPELE PAR : PRASEM
  22. C***********************************************************************
  23. C ENTREES : tout sauf PMCOU
  24. C SORTIES : PMCOU
  25. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  26. C***********************************************************************
  27. C VERSION : v1, 13/12/99, création
  28. C HISTORIQUE : v1, 13/12/99, création
  29. C HISTORIQUE :
  30. C HISTORIQUE :
  31. C***********************************************************************
  32. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  33. C en cas de modification de ce sous-programme afin de faciliter
  34. C la maintenance !
  35. C***********************************************************************
  36. -INC CCOPTIO
  37. -INC SMELEME
  38. POINTEUR MELPRI.MELEME
  39. POINTEUR MELDUA.MELEME
  40. POINTEUR KJSPGD.MELEME
  41. POINTEUR KMINCT.MINC
  42. POINTEUR PMCOU.PMORS
  43. -INC SMLENTI
  44. POINTEUR KRINCP.MLENTI
  45. POINTEUR KRSPGD.MLENTI
  46. POINTEUR KRINCD.MLENTI
  47. POINTEUR KRSPGT.MLENTI
  48. POINTEUR PONBLD.MLENTI
  49. POINTEUR PODPOP.MLENTI
  50. POINTEUR LDDLDU.MLENTI
  51. INTEGER NPODUA
  52. *
  53. * Includes perso
  54. *
  55. *STAT -INC SMSTAT
  56. *-INC SLSTIND
  57. *
  58. * Segment LSTIND (liste séquentielle indexée)
  59. *
  60. SEGMENT LSTIND
  61. INTEGER IDX(NBM+1)
  62. INTEGER IVAL(NBTVAL)
  63. ENDSEGMENT
  64. *
  65. * LISTE SEQUENTIELLE INDEXEE D'ENTIERS
  66. *
  67. * NBM : NOMBRE DE MULTIPLETS
  68. * NBTVAL : NOMBRE TOTAL DE VALEURS
  69. * IDX(I) : INDICE DE LA PREMIERE VALEUR DU IEME
  70. * MULTIPLET DANS LE TABLEAU IVAL
  71. * IVAL(IDX(I) -> IDX(I+1)-1) : VALEURS DU IEME MULTIPLET
  72. POINTEUR P2ELDU.LSTIND
  73. POINTEUR LPDPP.LSTIND
  74. *
  75. INTEGER IMPR,IRET
  76. *
  77. * Executable statements
  78. *
  79. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans makpr2'
  80. *STAT CALL INMSTA(MSTAT,0)
  81. C - Construire la liste indexée suivante (P2ELDU) :
  82. C * Nombre de multiplets = nb points P1 de MELDUA ;
  83. C * chaque multiplet : numéro des éléments de MELDUA
  84. C contenant P1.
  85. * SEGPRT,MELPRI
  86. * SEGPRT,MELDUA
  87. * SEGPRT,KRSPGD
  88. * In PONBL2 : SEGINI PONBLD
  89. CALL PONBL2(MELDUA,KRSPGD,NPODUA,
  90. $ PONBLD,
  91. $ IMPR,IRET)
  92. IF (IRET.NE.0) GOTO 9999
  93. * SEGPRT,PONBLD
  94. *STAT CALL PRMSTA(' sub. ponbl2',MSTAT,IMPR)
  95. * In POELM2 : SEGINI P2ELDU
  96. CALL POELM2(MELDUA,KRSPGD,PONBLD,
  97. $ P2ELDU,
  98. $ IMPR,IRET)
  99. IF (IRET.NE.0) GOTO 9999
  100. SEGSUP PONBLD
  101. * SEGPRT,P2ELDU
  102. *STAT CALL PRMSTA(' sub. poelm2',MSTAT,IMPR)
  103. C - Construire la liste d'entiers suivante (PODPOP) :
  104. C * Nombre d'entiers = nb points P1 de MELDUA ;
  105. C * pour chaque P1 : nb. de points P2 de MELPRI avec lesquels il
  106. C a une liaison.
  107. * In PONBPO : SEGINI PODPOP
  108. CALL PONBPO(P2ELDU,MELPRI,
  109. $ PODPOP,
  110. $ IMPR,IRET)
  111. IF (IRET.NE.0) GOTO 9999
  112. * SEGPRT,PODPOP
  113. *STAT CALL PRMSTA(' sub. ponbpo',MSTAT,IMPR)
  114. C - Construire la liste indexée suivante (LPDPP) :
  115. C * Nombre de multiplets = nb points P1 de MELDUA
  116. C * pour chaque P1 : numéro des points P2 de MELPRI avec
  117. C lesquels il a une liaison.
  118. * In POPOIN : SEGINI LPDPP
  119. CALL POPOIN(P2ELDU,MELPRI,PODPOP,
  120. $ LPDPP,
  121. $ IMPR,IRET)
  122. IF (IRET.NE.0) GOTO 9999
  123. SEGSUP P2ELDU
  124. SEGSUP PODPOP
  125. IF (IMPR.GT.4) THEN
  126. WRITE(IOIMP,*) 'Liste des points duaux :'
  127. SEGPRT,KJSPGD
  128. WRITE(IOIMP,*) 'Liste indexée de correspondance ',
  129. $ 'point dual-points primaux :'
  130. SEGPRT,LPDPP
  131. ENDIF
  132. *STAT CALL PRMSTA(' sub. popoin',MSTAT,IMPR)
  133. C
  134. C - Initialisation et remplissage du profil de la matrice morse
  135. C
  136. *SG 2016/02/09 Avant, on utilisait MKPMO2
  137. * qui avait un niveau d'indirection en plus => très lent
  138. * MKPMO3 a un niveau d'indirection en moins mais les lignes
  139. * ne sont pas forcément ordonnées. Cela ne pose pas de problème
  140. * à FUSPR5 mais en pose à FUSPRn (n<5) donc il faut avoir METASS=5
  141. * dans tout ce qui appelle l'assemblage de KRES3 (KRESLL, EXDIAG)
  142. CALL MKPMO3(LPDPP,KJSPGD,KRINCP,KRINCD,
  143. $ KRSPGT,KMINCT,
  144. $ LDDLDU,PMCOU,
  145. $ IMPR,IRET)
  146. IF (IRET.NE.0) GOTO 9999
  147. IF (IMPR.GT.4) THEN
  148. WRITE(IOIMP,*) 'Profil Morse non ordonné :'
  149. SEGPRT,PMCOU
  150. ENDIF
  151. SEGSUP LPDPP
  152. *
  153. * Normal termination
  154. *
  155. IRET=0
  156. RETURN
  157. *
  158. * Format handling
  159. *
  160. *
  161. * Error handling
  162. *
  163. 9999 CONTINUE
  164. IRET=1
  165. WRITE(IOIMP,*) 'An error was detected in subroutine makpr2'
  166. RETURN
  167. *
  168. * End of subroutine MAKPR2
  169. *
  170. END
  171.  
  172.  
  173.  
  174.  
  175.  
  176.  
  177.  
  178.  
  179.  
  180.  

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