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 CCOPTIO
  35. -INC SMLENTI
  36. POINTEUR JCPRIB.MLENTI
  37. POINTEUR KRIPRI.MLENTI
  38. * Includes persos
  39. * Segment LSTIND (liste séquentielle indexée)
  40. INTEGER NBM,NBTVAL
  41. SEGMENT LSTIND
  42. INTEGER IDX(NBM+1)
  43. INTEGER IVAL(NBTVAL)
  44. ENDSEGMENT
  45. *-INC SLSTIND
  46. POINTEUR LIPNMC.LSTIND
  47. POINTEUR LINBNC.LSTIND
  48. *
  49. INTEGER IMPR,IRET
  50. *
  51. INTEGER NNBMEB
  52. INTEGER INBMEB
  53. INTEGER IVNBNC,JVPNMC,JVSTRT,JVSTOP
  54. INTEGER NOPBNC,NUPRIB
  55. *
  56. * Executable statements
  57. *
  58. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mknbnc.eso'
  59. * Dimensionnement de LINBNC
  60. * Pour l'instant LINBNC.IDX(INBMEB+1)=nombre de NBMEC reliés à
  61. * JCPRIB(INBMEB)
  62. SEGACT KRIPRI
  63. SEGACT JCPRIB
  64. NNBMEB=JCPRIB.LECT(/1)
  65. NBM=NNBMEB
  66. NBTVAL=0
  67. SEGINI LINBNC
  68. SEGACT LIPNMC
  69. DO 1 INBMEB=1,NNBMEB
  70. NUPRIB=JCPRIB.LECT(INBMEB)
  71. JVPRIB=KRIPRI.LECT(NUPRIB)
  72. NOPBNC=LIPNMC.IDX(JVPRIB+1)-LIPNMC.IDX(JVPRIB)
  73. *bug! NOPBNC=LIPNMC.IDX(NUPRIB+1)-LIPNMC.IDX(NUPRIB)
  74. LINBNC.IDX(INBMEB+1)=NOPBNC
  75. 1 CONTINUE
  76. * LINBNC.IDX est transformé en la liste d'indexation sur
  77. * LINBNC.IVAL
  78. LINBNC.IDX(1)=1
  79. DO 3 INBMEB=1,NNBMEB
  80. LINBNC.IDX(INBMEB+1)=LINBNC.IDX(INBMEB+1)+LINBNC.IDX(INBMEB)
  81. 3 CONTINUE
  82. NBM=NNBMEB
  83. NBTVAL=LINBNC.IDX(NNBMEB+1)-1
  84. SEGADJ,LINBNC
  85. * Remplissage de LINBNC
  86. IVNBNC=0
  87. DO 5 INBMEB=1,NNBMEB
  88. NUPRIB=JCPRIB.LECT(INBMEB)
  89. JVPRIB=KRIPRI.LECT(NUPRIB)
  90. JVSTRT=LIPNMC.IDX(JVPRIB)
  91. JVSTOP=LIPNMC.IDX(JVPRIB+1)-1
  92. *bug! JVSTRT=LIPNMC.IDX(NUPRIB)
  93. *bug! JVSTOP=LIPNMC.IDX(NUPRIB+1)-1
  94. DO 52 JVPNMC=JVSTRT,JVSTOP
  95. IVNBNC=IVNBNC+1
  96. LINBNC.IVAL(IVNBNC)=LIPNMC.IVAL(JVPNMC)
  97. 52 CONTINUE
  98. 5 CONTINUE
  99. SEGDES LIPNMC
  100. SEGDES JCPRIB
  101. SEGDES LINBNC
  102. SEGDES KRIPRI
  103. *
  104. * Normal termination
  105. *
  106. IRET=0
  107. RETURN
  108. *
  109. * Format handling
  110. *
  111. *
  112. * Error handling
  113. *
  114. 9999 CONTINUE
  115. IRET=1
  116. WRITE(IOIMP,*) 'An error was detected in subroutine mknbnc'
  117. RETURN
  118. *
  119. * End of subroutine MKNBNC
  120. *
  121. END
  122.  
  123.  
  124.  
  125.  
  126.  

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