Télécharger midcdb.eso

Retour à la liste

Numérotation des lignes :

  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. -INC CCOPTIO
  34. -INC SMLENTI
  35. POINTEUR ICPCDB.MLENTI
  36. POINTEUR JCDUAB.MLENTI
  37. POINTEUR JCDUAC.MLENTI
  38. INTEGER JG
  39. POINTEUR KRPCDB.MLENTI
  40. POINTEUR KRDCDB.MLENTI
  41. * Includes persos
  42. * Segment LSTIND (liste séquentielle indexée)
  43. INTEGER NBM,NBTVAL
  44. SEGMENT LSTIND
  45. INTEGER IDX(NBM+1)
  46. INTEGER IVAL(NBTVAL)
  47. ENDSEGMENT
  48. *-INC SLSTIND
  49. POINTEUR LINBNC.LSTIND
  50. POINTEUR LIPDNB.LSTIND
  51. POINTEUR ICDCDB.LSTIND
  52. *
  53. INTEGER IMPR,IRET
  54. *
  55. INTEGER LDG,NCPCDB,NIUNIQ
  56. INTEGER IDG,JCPCDB
  57. INTEGER IVDCDB
  58. INTEGER JVPDNB,JVSTRT,JVSTOP,KVNBNC,KVSTRT,KVSTOP
  59. INTEGER INBMEB,INBMEC,NUDUAC
  60. INTEGER LAST,PREC
  61. *
  62. * Executable statements
  63. *
  64. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans midcdb.eso'
  65. * On construit la liste de correspondance :
  66. * une inconnue de ICPCDB -> n°s(IBMEs) matrice B tels que
  67. * JCDUAB(IBME)=ICPCDB
  68. SEGACT ICPCDB
  69. NCPCDB=ICPCDB.LECT(/1)
  70. JG=NIUNIQ
  71. SEGINI KRPCDB
  72. CALL RSETEE(ICPCDB.LECT,NCPCDB,
  73. $ KRPCDB.LECT,NIUNIQ,
  74. $ IMPR,IRET)
  75. IF (IRET.NE.0) GOTO 9999
  76. * SEGPRT,KRPCDB
  77. SEGDES ICPCDB
  78. CALL RPENLE(JCDUAB,KRPCDB,NCPCDB,
  79. $ LIPDNB,
  80. $ IMPR,IRET)
  81. * SEGPRT,LIPDNB
  82. SEGSUP KRPCDB
  83. * Dimensionnement de ICDCDB
  84. * Pour l'instant ICDCDB.IDX(JCPCDB+1)=nombre d'inconnues
  85. * distinctes reliées à l'inconnue ICPCDB.LECT(JCPCDB)
  86. NBM=NCPCDB
  87. NBTVAL=0
  88. SEGINI ICDCDB
  89. JG=NIUNIQ
  90. SEGINI KRDCDB
  91. SEGACT LIPDNB
  92. SEGACT LINBNC
  93. SEGACT JCDUAC
  94. DO 1 JCPCDB=1,NCPCDB
  95. * Degré et fin de la liste chaînée
  96. LDG=0
  97. LAST=-1
  98. JVSTRT=LIPDNB.IDX(JCPCDB)
  99. JVSTOP=LIPDNB.IDX(JCPCDB+1)-1
  100. DO 12 JVPDNB=JVSTRT,JVSTOP
  101. INBMEB=LIPDNB.IVAL(JVPDNB)
  102. KVSTRT=LINBNC.IDX(INBMEB)
  103. KVSTOP=LINBNC.IDX(INBMEB+1)-1
  104. DO 122 KVNBNC=KVSTRT,KVSTOP
  105. INBMEC=LINBNC.IVAL(KVNBNC)
  106. NUDUAC=JCDUAC.LECT(INBMEC)
  107. IF (KRDCDB.LECT(NUDUAC).EQ.0) THEN
  108. LDG=LDG+1
  109. KRDCDB.LECT(NUDUAC)=LAST
  110. LAST=NUDUAC
  111. ENDIF
  112. 122 CONTINUE
  113. 12 CONTINUE
  114. ICDCDB.IDX(JCPCDB+1)=LDG
  115. * Remise à zéro de la liste chaînée
  116. DO 14 IDG=1,LDG
  117. PREC=KRDCDB.LECT(LAST)
  118. KRDCDB.LECT(LAST)=0
  119. LAST=PREC
  120. 14 CONTINUE
  121. 1 CONTINUE
  122. * ICDCDB.IDX est transformé en la liste d'indexation sur
  123. * ICDCDB.IVAL
  124. ICDCDB.IDX(1)=1
  125. DO 3 JCPCDB=1,NCPCDB
  126. ICDCDB.IDX(JCPCDB+1)=ICDCDB.IDX(JCPCDB+1)+ICDCDB.IDX(JCPCDB)
  127. 3 CONTINUE
  128. NBM=NCPCDB
  129. NBTVAL=ICDCDB.IDX(NCPCDB+1)-1
  130. SEGADJ,ICDCDB
  131. * Remplissage de ICDCDB
  132. IVDCDB=0
  133. DO 5 JCPCDB=1,NCPCDB
  134. * Degré et fin de la liste chaînée
  135. LDG=0
  136. LAST=-1
  137. JVSTRT=LIPDNB.IDX(JCPCDB)
  138. JVSTOP=LIPDNB.IDX(JCPCDB+1)-1
  139. DO 52 JVPDNB=JVSTRT,JVSTOP
  140. INBMEB=LIPDNB.IVAL(JVPDNB)
  141. KVSTRT=LINBNC.IDX(INBMEB)
  142. KVSTOP=LINBNC.IDX(INBMEB+1)-1
  143. DO 522 KVNBNC=KVSTRT,KVSTOP
  144. INBMEC=LINBNC.IVAL(KVNBNC)
  145. NUDUAC=JCDUAC.LECT(INBMEC)
  146. IF (KRDCDB.LECT(NUDUAC).EQ.0) THEN
  147. LDG=LDG+1
  148. KRDCDB.LECT(NUDUAC)=LAST
  149. LAST=NUDUAC
  150. ENDIF
  151. 522 CONTINUE
  152. 52 CONTINUE
  153. * Remise à zéro de la liste chaînée et vidage dans ICDCDB
  154. DO 54 IDG=1,LDG
  155. PREC=KRDCDB.LECT(LAST)
  156. IVDCDB=IVDCDB+1
  157. ICDCDB.IVAL(IVDCDB)=LAST
  158. KRDCDB.LECT(LAST)=0
  159. LAST=PREC
  160. 54 CONTINUE
  161. 5 CONTINUE
  162. SEGDES JCDUAC
  163. SEGDES LINBNC
  164. SEGSUP LIPDNB
  165. SEGSUP KRDCDB
  166. SEGDES ICDCDB
  167. *
  168. * Normal termination
  169. *
  170. IRET=0
  171. RETURN
  172. *
  173. * Format handling
  174. *
  175. *
  176. * Error handling
  177. *
  178. 9999 CONTINUE
  179. IRET=1
  180. WRITE(IOIMP,*) 'An error was detected in subroutine midcdb'
  181. RETURN
  182. *
  183. * End of subroutine MIDCDB
  184. *
  185. END
  186.  
  187.  
  188.  
  189.  

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