Télécharger inlmap.eso

Retour à la liste

Numérotation des lignes :

  1. C INLMAP SOURCE CHAT 05/01/13 00:38:26 5004
  2. SUBROUTINE INLMAP(ICDCDB,LMPCDB,LMDCDB,
  3. $ LMACDB,
  4. $ IMPR,IRET)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM : INLMAP
  9. C DESCRIPTION : Initialisation de la matrice produit.
  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 : PROLIS
  18. C***********************************************************************
  19. C ENTREES : ICDCDB, LMPCDB, LMDCDB
  20. C SORTIES : LMACDB
  21. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  22. C***********************************************************************
  23. C VERSION : v1, 10/02/2000, version initiale
  24. C HISTORIQUE : v1, 10/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. * Includes persos
  34. * Segment LSTIND (liste séquentielle indexée)
  35. SEGMENT LSTIND
  36. INTEGER IDX(NBM+1)
  37. INTEGER IVAL(NBTVAL)
  38. ENDSEGMENT
  39. POINTEUR ICDCDB.LSTIND
  40. POINTEUR LMPCDB.LSTIND
  41. POINTEUR LMDCDB.LSTIND
  42. SEGMENT LSRIND
  43. INTEGER IDXX(NBM+1)
  44. REAL*8 XVAL(NBTVAL)
  45. ENDSEGMENT
  46. SEGMENT LLI
  47. POINTEUR LISLI(NBME).LSRIND
  48. ENDSEGMENT
  49. INTEGER NBM,NBTVAL,NBME
  50. POINTEUR LMACDB.LLI
  51. POINTEUR SLMCDB.LSRIND
  52. POINTEUR SLMPIX.LSRIND
  53. *
  54. INTEGER IMPR,IRET
  55. *
  56. INTEGER IBME,ILCDB
  57. INTEGER NCPL,NLCDB
  58. INTEGER NUVP,NUVD,NUVPD
  59. *
  60. * Executable statements
  61. *
  62. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inlmap.eso'
  63. * - nombre d'inconnues :
  64. SEGACT ICDCDB
  65. NCPL=ICDCDB.IVAL(/1)
  66. NBME=NCPL
  67. SEGINI LMACDB
  68. SEGACT LMPCDB
  69. SEGACT LMDCDB
  70. NLCDB=LMPCDB.IDX(/1)-1
  71. NBM=NLCDB
  72. NBTVAL=0
  73. SEGINI SLMPIX
  74. DO 1 ILCDB=1,NLCDB
  75. NUVP=LMPCDB.IDX(ILCDB+1)-LMPCDB.IDX(ILCDB)
  76. NUVD=LMDCDB.IDX(ILCDB+1)-LMDCDB.IDX(ILCDB)
  77. NUVPD=NUVP*NUVD
  78. SLMPIX.IDXX(ILCDB+1)=NUVPD
  79. 1 CONTINUE
  80. * SLMPIX.IDXX est transformé en liste d'indexation
  81. SLMPIX.IDXX(1)=1
  82. DO 3 ILCDB=1,NLCDB
  83. SLMPIX.IDXX(ILCDB+1)=SLMPIX.IDXX(ILCDB+1)+SLMPIX.IDXX(ILCDB)
  84. 3 CONTINUE
  85. * Initialisation des segments de LMACDB
  86. DO 5 IBME=1,NBME
  87. NBM=NLCDB
  88. NBTVAL=SLMPIX.IDXX(NLCDB+1)-1
  89. SEGINI SLMCDB
  90. DO 52 ILCDB=1,NLCDB+1
  91. SLMCDB.IDXX(ILCDB)=SLMPIX.IDXX(ILCDB)
  92. 52 CONTINUE
  93. SEGDES SLMCDB
  94. LMACDB.LISLI(IBME)=SLMCDB
  95. 5 CONTINUE
  96. SEGSUP SLMPIX
  97. SEGDES LMDCDB
  98. SEGDES LMPCDB
  99. SEGDES LMACDB
  100. SEGDES ICDCDB
  101. *
  102. * Normal termination
  103. *
  104. IRET=0
  105. RETURN
  106. *
  107. * Format handling
  108. *
  109. *
  110. * Error handling
  111. *
  112. 9999 CONTINUE
  113. IRET=1
  114. WRITE(IOIMP,*) 'An error was detected in subroutine inlmap'
  115. RETURN
  116. *
  117. * End of subroutine INLMAP
  118. *
  119. END
  120.  
  121.  
  122.  
  123.  

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