Télécharger makprm.eso

Retour à la liste

Numérotation des lignes :

  1. C MAKPRM SOURCE PV 16/11/17 22:00:40 9180
  2. SUBROUTINE MAKPRM(MELPRI,KRINCP,
  3. $ MELDUA,NPODUA,KJSPGD,KRSPGD,KRINCD,
  4. $ KMINCT,KRSPGT,
  5. $ PMCOU,
  6. $ IMPR,IRET)
  7. IMPLICIT INTEGER(I-N)
  8. IMPLICIT REAL*8 (A-H,O-Z)
  9. C***********************************************************************
  10. C NOM : MAKPRM
  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. INTEGER NPODUA
  51. *
  52. * Includes perso
  53. *
  54. *STAT -INC SMSTAT
  55. *-INC SLSTIND
  56. *
  57. * Segment LSTIND (liste séquentielle indexée)
  58. *
  59. SEGMENT LSTIND
  60. INTEGER IDX(NBM+1)
  61. INTEGER IVAL(NBTVAL)
  62. ENDSEGMENT
  63. *
  64. * LISTE SEQUENTIELLE INDEXEE D'ENTIERS
  65. *
  66. * NBM : NOMBRE DE MULTIPLETS
  67. * NBTVAL : NOMBRE TOTAL DE VALEURS
  68. * IDX(I) : INDICE DE LA PREMIERE VALEUR DU IEME
  69. * MULTIPLET DANS LE TABLEAU IVAL
  70. * IVAL(IDX(I) -> IDX(I+1)-1) : VALEURS DU IEME MULTIPLET
  71. POINTEUR P2ELDU.LSTIND
  72. POINTEUR LPDPP.LSTIND
  73. *
  74. INTEGER IMPR,IRET
  75. *
  76. * Executable statements
  77. *
  78. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans makprm'
  79. *STAT CALL INMSTA(MSTAT,0)
  80. C - Construire la liste indexée suivante (P2ELDU) :
  81. C * Nombre de multiplets = nb points P1 de MELDUA ;
  82. C * chaque multiplet : numéro des éléments de MELDUA
  83. C contenant P1.
  84. * SEGPRT,MELPRI
  85. * SEGPRT,MELDUA
  86. * SEGPRT,KRSPGD
  87. * In PONBL2 : SEGINI PONBLD
  88. CALL PONBL2(MELDUA,KRSPGD,NPODUA,
  89. $ PONBLD,
  90. $ IMPR,IRET)
  91. IF (IRET.NE.0) GOTO 9999
  92. * SEGPRT,PONBLD
  93. *STAT CALL PRMSTA(' sub. ponbl2',MSTAT,IMPR)
  94. * In POELM2 : SEGINI P2ELDU
  95. CALL POELM2(MELDUA,KRSPGD,PONBLD,
  96. $ P2ELDU,
  97. $ IMPR,IRET)
  98. IF (IRET.NE.0) GOTO 9999
  99. SEGSUP PONBLD
  100. * SEGPRT,P2ELDU
  101. *STAT CALL PRMSTA(' sub. poelm2',MSTAT,IMPR)
  102. C - Construire la liste d'entiers suivante (PODPOP) :
  103. C * Nombre d'entiers = nb points P1 de MELDUA ;
  104. C * pour chaque P1 : nb. de points P2 de MELPRI avec lesquels il
  105. C a une liaison.
  106. * In PONBPO : SEGINI PODPOP
  107. CALL PONBPO(P2ELDU,MELPRI,
  108. $ PODPOP,
  109. $ IMPR,IRET)
  110. IF (IRET.NE.0) GOTO 9999
  111. * SEGPRT,PODPOP
  112. *STAT CALL PRMSTA(' sub. ponbpo',MSTAT,IMPR)
  113. C - Construire la liste indexée suivante (LPDPP) :
  114. C * Nombre de multiplets = nb points P1 de MELDUA
  115. C * pour chaque P1 : numéro des points P2 de MELPRI avec
  116. C lesquels il a une liaison.
  117. * In POPOIN : SEGINI LPDPP
  118. CALL POPOIN(P2ELDU,MELPRI,PODPOP,
  119. $ LPDPP,
  120. $ IMPR,IRET)
  121. IF (IRET.NE.0) GOTO 9999
  122. SEGSUP P2ELDU
  123. SEGSUP PODPOP
  124. IF (IMPR.GT.4) THEN
  125. WRITE(IOIMP,*) 'Liste des points duaux :'
  126. SEGPRT,KJSPGD
  127. WRITE(IOIMP,*) 'Liste indexée de correspondance ',
  128. $ 'point dual-points primaux :'
  129. SEGPRT,LPDPP
  130. ENDIF
  131. *STAT CALL PRMSTA(' sub. popoin',MSTAT,IMPR)
  132. C
  133. C - Initialisation et remplissage du profil de la matrice morse
  134. C
  135. CALL MKPMOR(LPDPP,KJSPGD,KRINCP,KRINCD,
  136. $ KRSPGT,KMINCT,
  137. $ PMCOU,
  138. $ IMPR,IRET)
  139. IF (IRET.NE.0) GOTO 9999
  140. IF (IMPR.GT.4) THEN
  141. WRITE(IOIMP,*) 'Profil Morse non ordonné :'
  142. SEGPRT,PMCOU
  143. ENDIF
  144. SEGSUP LPDPP
  145. *
  146. * Normal termination
  147. *
  148. IRET=0
  149. RETURN
  150. *
  151. * Format handling
  152. *
  153. *
  154. * Error handling
  155. *
  156. 9999 CONTINUE
  157. IRET=1
  158. WRITE(IOIMP,*) 'An error was detected in subroutine makprm'
  159. RETURN
  160. *
  161. * End of subroutine MAKPRM
  162. *
  163. END
  164.  
  165.  
  166.  
  167.  
  168.  
  169.  
  170.  

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