Télécharger mknbnc.eso

Retour à la liste

Numérotation des lignes :

  1. C MKNBNC SOURCE GOUNAND 06/04/26 21:15:49 5414
  2. SUBROUTINE MKNBNC(JCPRIB,LIPNMC,KRIPRI,
  3. $ LINBNC,
  4. $ IMPR,IRET)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM : MKNBNC
  9. C DESCRIPTION : Construction d'une liste indexée de correspondance :
  10. C matrice B -> liste des matrices C ayant la même inconnue
  11. C primale.
  12. C
  13. C
  14. C LANGAGE : ESOPE
  15. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  16. C mél : gounand@semt2.smts.cea.fr
  17. C***********************************************************************
  18. C APPELES : -
  19. C APPELE PAR : PROMAT
  20. C***********************************************************************
  21. C ENTREES : JCPRIB, LIPNMC
  22. C SORTIES : LINBNC
  23. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  24. C***********************************************************************
  25. C VERSION : v1, 07/02/2000, version initiale
  26. C HISTORIQUE : v1, 07/02/2000, création
  27. C HISTORIQUE :
  28. C HISTORIQUE :
  29. C***********************************************************************
  30. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  31. C en cas de modification de ce sous-programme afin de faciliter
  32. C la maintenance !
  33. C***********************************************************************
  34. -INC PPARAM
  35. -INC CCOPTIO
  36. -INC SMLENTI
  37. POINTEUR JCPRIB.MLENTI
  38. POINTEUR KRIPRI.MLENTI
  39. * Includes persos
  40. * Segment LSTIND (liste séquentielle indexée)
  41. INTEGER NBM,NBTVAL
  42. SEGMENT LSTIND
  43. INTEGER IDX(NBM+1)
  44. INTEGER IVAL(NBTVAL)
  45. ENDSEGMENT
  46. *-INC SLSTIND
  47. POINTEUR LIPNMC.LSTIND
  48. POINTEUR LINBNC.LSTIND
  49. *
  50. INTEGER IMPR,IRET
  51. *
  52. INTEGER NNBMEB
  53. INTEGER INBMEB
  54. INTEGER IVNBNC,JVPNMC,JVSTRT,JVSTOP
  55. INTEGER NOPBNC,NUPRIB
  56. *
  57. * Executable statements
  58. *
  59. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mknbnc.eso'
  60. * Dimensionnement de LINBNC
  61. * Pour l'instant LINBNC.IDX(INBMEB+1)=nombre de NBMEC reliés à
  62. * JCPRIB(INBMEB)
  63. SEGACT KRIPRI
  64. SEGACT JCPRIB
  65. NNBMEB=JCPRIB.LECT(/1)
  66. NBM=NNBMEB
  67. NBTVAL=0
  68. SEGINI LINBNC
  69. SEGACT LIPNMC
  70. DO 1 INBMEB=1,NNBMEB
  71. NUPRIB=JCPRIB.LECT(INBMEB)
  72. JVPRIB=KRIPRI.LECT(NUPRIB)
  73. NOPBNC=LIPNMC.IDX(JVPRIB+1)-LIPNMC.IDX(JVPRIB)
  74. *bug! NOPBNC=LIPNMC.IDX(NUPRIB+1)-LIPNMC.IDX(NUPRIB)
  75. LINBNC.IDX(INBMEB+1)=NOPBNC
  76. 1 CONTINUE
  77. * LINBNC.IDX est transformé en la liste d'indexation sur
  78. * LINBNC.IVAL
  79. LINBNC.IDX(1)=1
  80. DO 3 INBMEB=1,NNBMEB
  81. LINBNC.IDX(INBMEB+1)=LINBNC.IDX(INBMEB+1)+LINBNC.IDX(INBMEB)
  82. 3 CONTINUE
  83. NBM=NNBMEB
  84. NBTVAL=LINBNC.IDX(NNBMEB+1)-1
  85. SEGADJ,LINBNC
  86. * Remplissage de LINBNC
  87. IVNBNC=0
  88. DO 5 INBMEB=1,NNBMEB
  89. NUPRIB=JCPRIB.LECT(INBMEB)
  90. JVPRIB=KRIPRI.LECT(NUPRIB)
  91. JVSTRT=LIPNMC.IDX(JVPRIB)
  92. JVSTOP=LIPNMC.IDX(JVPRIB+1)-1
  93. *bug! JVSTRT=LIPNMC.IDX(NUPRIB)
  94. *bug! JVSTOP=LIPNMC.IDX(NUPRIB+1)-1
  95. DO 52 JVPNMC=JVSTRT,JVSTOP
  96. IVNBNC=IVNBNC+1
  97. LINBNC.IVAL(IVNBNC)=LIPNMC.IVAL(JVPNMC)
  98. 52 CONTINUE
  99. 5 CONTINUE
  100. SEGDES LIPNMC
  101. SEGDES JCPRIB
  102. SEGDES LINBNC
  103. SEGDES KRIPRI
  104. *
  105. * Normal termination
  106. *
  107. IRET=0
  108. RETURN
  109. *
  110. * Format handling
  111. *
  112. *
  113. * Error handling
  114. *
  115. 9999 CONTINUE
  116. IRET=1
  117. WRITE(IOIMP,*) 'An error was detected in subroutine mknbnc'
  118. RETURN
  119. *
  120. * End of subroutine MKNBNC
  121. *
  122. END
  123.  
  124.  
  125.  
  126.  
  127.  

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