Télécharger mldcdb.eso

Retour à la liste

Numérotation des lignes :

  1. C MLDCDB SOURCE CHAT 05/01/13 01:46:38 5004
  2. SUBROUTINE MLDCDB(LILBLC,LMDUAC,NTOTPO,
  3. $ LMDCDB,
  4. $ IMPR,IRET)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM : MLDCDB
  9. C DESCRIPTION : On construit la liste des éléments duaux de CD-1Bt.
  10. C
  11. C
  12. C LANGAGE : ESOPE
  13. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  14. C mél : gounand@semt2.smts.cea.fr
  15. C***********************************************************************
  16. C APPELES : -
  17. C APPELE PAR : PROMAT
  18. C***********************************************************************
  19. C ENTREES : LILBLC, LMDUAC, NTOTPO
  20. C SORTIES : LMDCDB
  21. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  22. C***********************************************************************
  23. C VERSION : v1, 09/02/2000, version initiale
  24. C HISTORIQUE : v1, 09/02/2000, création
  25. C HISTORIQUE :
  26. C HISTORIQUE :
  27. C***********************************************************************
  28. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  29. C en cas de modification de ce sous-programme afin de faciliter
  30. C la maintenance !
  31. C***********************************************************************
  32. -INC CCOPTIO
  33. -INC SMLENTI
  34. INTEGER JG
  35. POINTEUR KPDCDB.MLENTI
  36. * Includes persos
  37. * Segment LSTIND (liste séquentielle indexée)
  38. INTEGER NBM,NBTVAL
  39. SEGMENT LSTIND
  40. INTEGER IDX(NBM+1)
  41. INTEGER IVAL(NBTVAL)
  42. ENDSEGMENT
  43. *-INC SLSTIND
  44. POINTEUR LILBLC.LSTIND
  45. POINTEUR LMDUAC.LSTIND
  46. POINTEUR LMDCDB.LSTIND
  47. *
  48. INTEGER NTOTPO
  49. INTEGER IMPR,IRET
  50. *
  51. INTEGER LDG,NEL
  52. INTEGER IDG,IEL,IVDCDB
  53. INTEGER IVLBLC,IVSTRT,IVSTOP
  54. INTEGER JVDUAC,JVSTRT,JVSTOP
  55. INTEGER LAST,PREC
  56. INTEGER NUELC,NUPODC
  57. *
  58. * Executable statements
  59. *
  60. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mldcdb.eso'
  61. * Dimensionnement de LMDCDB
  62. * Pour l'instant LMDCDB.IDX(IEL+1)=nombre de points du IELeme élément de
  63. * LMDCDB
  64. SEGACT LILBLC
  65. NEL=LILBLC.IDX(/1)-1
  66. NBM=NEL
  67. NBTVAL=0
  68. SEGINI LMDCDB
  69. SEGACT LMDUAC
  70. JG=NTOTPO
  71. SEGINI KPDCDB
  72. DO 1 IEL=1,NEL
  73. * Degré et fin de la liste chaînée
  74. LDG=0
  75. LAST=-1
  76. IVSTRT=LILBLC.IDX(IEL)
  77. IVSTOP=LILBLC.IDX(IEL+1)-1
  78. DO 12 IVLBLC=IVSTRT,IVSTOP
  79. NUELC=LILBLC.IVAL(IVLBLC)
  80. JVSTRT=LMDUAC.IDX(NUELC)
  81. JVSTOP=LMDUAC.IDX(NUELC+1)-1
  82. DO 122 JVDUAC=JVSTRT,JVSTOP
  83. NUPODC=LMDUAC.IVAL(JVDUAC)
  84. IF (KPDCDB.LECT(NUPODC).EQ.0) THEN
  85. LDG=LDG+1
  86. KPDCDB.LECT(NUPODC)=LAST
  87. LAST=NUPODC
  88. ENDIF
  89. 122 CONTINUE
  90. 12 CONTINUE
  91. LMDCDB.IDX(IEL+1)=LDG
  92. * Remise à zéro de la liste chaînée
  93. DO 14 IDG=1,LDG
  94. PREC=KPDCDB.LECT(LAST)
  95. KPDCDB.LECT(LAST)=0
  96. LAST=PREC
  97. 14 CONTINUE
  98. 1 CONTINUE
  99. * LMDCDB.IDX est transformé en la liste d'indexation sur
  100. * LMDCDB.IVAL
  101. LMDCDB.IDX(1)=1
  102. DO 3 IEL=1,NEL
  103. LMDCDB.IDX(IEL+1)=LMDCDB.IDX(IEL+1)+LMDCDB.IDX(IEL)
  104. 3 CONTINUE
  105. NBM=NEL
  106. NBTVAL=LMDCDB.IDX(NEL+1)-1
  107. SEGADJ,LMDCDB
  108. * Remplissage de LMDCDB
  109. IVDCDB=0
  110. DO 5 IEL=1,NEL
  111. * Degré et fin de la liste chaînée
  112. LDG=0
  113. LAST=-1
  114. IVSTRT=LILBLC.IDX(IEL)
  115. IVSTOP=LILBLC.IDX(IEL+1)-1
  116. DO 52 IVLBLC=IVSTRT,IVSTOP
  117. NUELC=LILBLC.IVAL(IVLBLC)
  118. JVSTRT=LMDUAC.IDX(NUELC)
  119. JVSTOP=LMDUAC.IDX(NUELC+1)-1
  120. DO 522 JVDUAC=JVSTRT,JVSTOP
  121. NUPODC=LMDUAC.IVAL(JVDUAC)
  122. IF (KPDCDB.LECT(NUPODC).EQ.0) THEN
  123. LDG=LDG+1
  124. KPDCDB.LECT(NUPODC)=LAST
  125. LAST=NUPODC
  126. ENDIF
  127. 522 CONTINUE
  128. 52 CONTINUE
  129. * Remise à zéro de la liste chaînée et vidage dans LMDCDB
  130. DO 54 IDG=1,LDG
  131. PREC=KPDCDB.LECT(LAST)
  132. IVDCDB=IVDCDB+1
  133. LMDCDB.IVAL(IVDCDB)=LAST
  134. KPDCDB.LECT(LAST)=0
  135. LAST=PREC
  136. 54 CONTINUE
  137. 5 CONTINUE
  138. SEGSUP KPDCDB
  139. SEGDES LMDUAC
  140. SEGDES LMDCDB
  141. SEGDES LILBLC
  142. *
  143. * Normal termination
  144. *
  145. IRET=0
  146. RETURN
  147. *
  148. * Format handling
  149. *
  150. *
  151. * Error handling
  152. *
  153. 9999 CONTINUE
  154. IRET=1
  155. WRITE(IOIMP,*) 'An error was detected in subroutine mldcdb'
  156. RETURN
  157. *
  158. * End of subroutine MLDCDB
  159. *
  160. END
  161.  
  162.  
  163.  
  164.  

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