Télécharger midcdb.eso

Retour à la liste

Numérotation des lignes :

midcdb
  1. C MIDCDB SOURCE CHAT 05/01/13 01:45:12 5004
  2. SUBROUTINE MIDCDB(ICPCDB,JCDUAB,LINBNC,JCDUAC,NIUNIQ,
  3. $ ICDCDB,
  4. $ IMPR,IRET)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM : MIDCDB
  9. C DESCRIPTION : On construit la liste indexée à la précédente des
  10. C inconnues duales de CD-1Bt.
  11. C
  12. C
  13. C LANGAGE : ESOPE
  14. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  15. C mél : gounand@semt2.smts.cea.fr
  16. C***********************************************************************
  17. C APPELES : RSETEE, RPENLE
  18. C APPELE PAR : PROMAT
  19. C***********************************************************************
  20. C ENTREES : ICPCDB, JCDUAB, LINBNC, JCDUAC, NIUNIQ
  21. C SORTIES : ICDCDB
  22. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  23. C***********************************************************************
  24. C VERSION : v1, 07/02/2000, version initiale
  25. C HISTORIQUE : v1, 07/02/2000, création
  26. C HISTORIQUE :
  27. C HISTORIQUE :
  28. C***********************************************************************
  29. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  30. C en cas de modification de ce sous-programme afin de faciliter
  31. C la maintenance !
  32. C***********************************************************************
  33.  
  34. -INC PPARAM
  35. -INC CCOPTIO
  36. -INC SMLENTI
  37. POINTEUR ICPCDB.MLENTI
  38. POINTEUR JCDUAB.MLENTI
  39. POINTEUR JCDUAC.MLENTI
  40. INTEGER JG
  41. POINTEUR KRPCDB.MLENTI
  42. POINTEUR KRDCDB.MLENTI
  43. * Includes persos
  44. * Segment LSTIND (liste séquentielle indexée)
  45. INTEGER NBM,NBTVAL
  46. SEGMENT LSTIND
  47. INTEGER IDX(NBM+1)
  48. INTEGER IVAL(NBTVAL)
  49. ENDSEGMENT
  50. *-INC SLSTIND
  51. POINTEUR LINBNC.LSTIND
  52. POINTEUR LIPDNB.LSTIND
  53. POINTEUR ICDCDB.LSTIND
  54. *
  55. INTEGER IMPR,IRET
  56. *
  57. INTEGER LDG,NCPCDB,NIUNIQ
  58. INTEGER IDG,JCPCDB
  59. INTEGER IVDCDB
  60. INTEGER JVPDNB,JVSTRT,JVSTOP,KVNBNC,KVSTRT,KVSTOP
  61. INTEGER INBMEB,INBMEC,NUDUAC
  62. INTEGER LAST,PREC
  63. *
  64. * Executable statements
  65. *
  66. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans midcdb.eso'
  67. * On construit la liste de correspondance :
  68. * une inconnue de ICPCDB -> n°s(IBMEs) matrice B tels que
  69. * JCDUAB(IBME)=ICPCDB
  70. SEGACT ICPCDB
  71. NCPCDB=ICPCDB.LECT(/1)
  72. JG=NIUNIQ
  73. SEGINI KRPCDB
  74. CALL RSETEE(ICPCDB.LECT,NCPCDB,
  75. $ KRPCDB.LECT,NIUNIQ,
  76. $ IMPR,IRET)
  77. IF (IRET.NE.0) GOTO 9999
  78. * SEGPRT,KRPCDB
  79. SEGDES ICPCDB
  80. CALL RPENLE(JCDUAB,KRPCDB,NCPCDB,
  81. $ LIPDNB,
  82. $ IMPR,IRET)
  83. * SEGPRT,LIPDNB
  84. SEGSUP KRPCDB
  85. * Dimensionnement de ICDCDB
  86. * Pour l'instant ICDCDB.IDX(JCPCDB+1)=nombre d'inconnues
  87. * distinctes reliées à l'inconnue ICPCDB.LECT(JCPCDB)
  88. NBM=NCPCDB
  89. NBTVAL=0
  90. SEGINI ICDCDB
  91. JG=NIUNIQ
  92. SEGINI KRDCDB
  93. SEGACT LIPDNB
  94. SEGACT LINBNC
  95. SEGACT JCDUAC
  96. DO 1 JCPCDB=1,NCPCDB
  97. * Degré et fin de la liste chaînée
  98. LDG=0
  99. LAST=-1
  100. JVSTRT=LIPDNB.IDX(JCPCDB)
  101. JVSTOP=LIPDNB.IDX(JCPCDB+1)-1
  102. DO 12 JVPDNB=JVSTRT,JVSTOP
  103. INBMEB=LIPDNB.IVAL(JVPDNB)
  104. KVSTRT=LINBNC.IDX(INBMEB)
  105. KVSTOP=LINBNC.IDX(INBMEB+1)-1
  106. DO 122 KVNBNC=KVSTRT,KVSTOP
  107. INBMEC=LINBNC.IVAL(KVNBNC)
  108. NUDUAC=JCDUAC.LECT(INBMEC)
  109. IF (KRDCDB.LECT(NUDUAC).EQ.0) THEN
  110. LDG=LDG+1
  111. KRDCDB.LECT(NUDUAC)=LAST
  112. LAST=NUDUAC
  113. ENDIF
  114. 122 CONTINUE
  115. 12 CONTINUE
  116. ICDCDB.IDX(JCPCDB+1)=LDG
  117. * Remise à zéro de la liste chaînée
  118. DO 14 IDG=1,LDG
  119. PREC=KRDCDB.LECT(LAST)
  120. KRDCDB.LECT(LAST)=0
  121. LAST=PREC
  122. 14 CONTINUE
  123. 1 CONTINUE
  124. * ICDCDB.IDX est transformé en la liste d'indexation sur
  125. * ICDCDB.IVAL
  126. ICDCDB.IDX(1)=1
  127. DO 3 JCPCDB=1,NCPCDB
  128. ICDCDB.IDX(JCPCDB+1)=ICDCDB.IDX(JCPCDB+1)+ICDCDB.IDX(JCPCDB)
  129. 3 CONTINUE
  130. NBM=NCPCDB
  131. NBTVAL=ICDCDB.IDX(NCPCDB+1)-1
  132. SEGADJ,ICDCDB
  133. * Remplissage de ICDCDB
  134. IVDCDB=0
  135. DO 5 JCPCDB=1,NCPCDB
  136. * Degré et fin de la liste chaînée
  137. LDG=0
  138. LAST=-1
  139. JVSTRT=LIPDNB.IDX(JCPCDB)
  140. JVSTOP=LIPDNB.IDX(JCPCDB+1)-1
  141. DO 52 JVPDNB=JVSTRT,JVSTOP
  142. INBMEB=LIPDNB.IVAL(JVPDNB)
  143. KVSTRT=LINBNC.IDX(INBMEB)
  144. KVSTOP=LINBNC.IDX(INBMEB+1)-1
  145. DO 522 KVNBNC=KVSTRT,KVSTOP
  146. INBMEC=LINBNC.IVAL(KVNBNC)
  147. NUDUAC=JCDUAC.LECT(INBMEC)
  148. IF (KRDCDB.LECT(NUDUAC).EQ.0) THEN
  149. LDG=LDG+1
  150. KRDCDB.LECT(NUDUAC)=LAST
  151. LAST=NUDUAC
  152. ENDIF
  153. 522 CONTINUE
  154. 52 CONTINUE
  155. * Remise à zéro de la liste chaînée et vidage dans ICDCDB
  156. DO 54 IDG=1,LDG
  157. PREC=KRDCDB.LECT(LAST)
  158. IVDCDB=IVDCDB+1
  159. ICDCDB.IVAL(IVDCDB)=LAST
  160. KRDCDB.LECT(LAST)=0
  161. LAST=PREC
  162. 54 CONTINUE
  163. 5 CONTINUE
  164. SEGDES JCDUAC
  165. SEGDES LINBNC
  166. SEGSUP LIPDNB
  167. SEGSUP KRDCDB
  168. SEGDES ICDCDB
  169. *
  170. * Normal termination
  171. *
  172. IRET=0
  173. RETURN
  174. *
  175. * Format handling
  176. *
  177. *
  178. * Error handling
  179. *
  180. 9999 CONTINUE
  181. IRET=1
  182. WRITE(IOIMP,*) 'An error was detected in subroutine midcdb'
  183. RETURN
  184. *
  185. * End of subroutine MIDCDB
  186. *
  187. END
  188.  
  189.  
  190.  
  191.  

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