Télécharger prcmck.eso

Retour à la liste

Numérotation des lignes :

  1. C PRCMCK SOURCE PV 16/11/17 22:01:04 9180
  2. SUBROUTINE PRCMCK(MATC,MATB,CHPOD,MATCDB,IMPR,IRET)
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : PRCMCK
  7. C DESCRIPTION : Préparation du calcul de CD-1Bt, on effectue les boucles
  8. C sur les matrices élémentaires.
  9. C
  10. C
  11. C
  12. C LANGAGE : ESOPE
  13. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  14. C mél : gounand@semt2.smts.cea.fr
  15. C***********************************************************************
  16. C APPELES : PROMAT
  17. C APPELES (E/S) : LIROBJ, ECROBJ
  18. C APPELES (STAT) : INMSTA, PRMSTA, SUMSTA
  19. C APPELE PAR : RYO2V
  20. C***********************************************************************
  21. C SYNTAXE GIBIANE : MATCDB = 'KOPS' 'CMCT' MATC MATB CHPOD
  22. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  23. C***********************************************************************
  24. C VERSION : v1, 28/01/2000, version initiale réécrite
  25. C HISTORIQUE : v1, 28/01/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. *
  35. * MATC, MATB, MATCDB : les deux matrices à multiplier et leur produit
  36. *
  37. INTEGER NRIGE,NMATRI,NKID,NKMT
  38. POINTEUR MATC.MATRIK
  39. POINTEUR MATB.MATRIK
  40. POINTEUR MATCDB.MATRIK
  41. POINTEUR IMATC.IMATRI
  42. POINTEUR IMATB.IMATRI
  43. POINTEUR IMTCDB.IMATRI
  44. -INC SMELEME
  45. POINTEUR MPRIC.MELEME,MDUAC.MELEME
  46. POINTEUR MPRIB.MELEME,MDUAB.MELEME
  47. POINTEUR MPCDB.MELEME,MDCDB.MELEME
  48. C POINTEUR MPCDB1.MELEME,MDCDB1.MELEME
  49. *
  50. * Les segments relatifs à la matrice diagonale D
  51. *
  52. -INC SMCHPOI
  53. POINTEUR CHPOD.MCHPOI
  54. *
  55. * Includes persos
  56. *
  57. C SEGMENT MELS
  58. C POINTEUR LISMEL(NBMEL).MELEME
  59. C ENDSEGMENT
  60. C INTEGER NBMEL
  61. C POINTEUR GPMELS.MELS
  62. *STAT-INC SMSTAT
  63. *STAT POINTEUR MSTOT.MSTAT
  64. *STAT POINTEUR MSMAT.MSTAT
  65. *
  66. INTEGER IMPR,IRET
  67. *
  68. INTEGER NMEB,NMEC
  69. INTEGER IMEB,IMEC
  70. *
  71. * Executable statements
  72. *
  73. *STAT CALL INMSTA(MSTOT,0)
  74. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans prcmck.eso'
  75. SEGACT MATB
  76. NMEB=MATB.IRIGEL(/2)
  77. SEGACT MATC
  78. NMEC=MATC.IRIGEL(/2)
  79. NRIGE=7
  80. NMATRI=0
  81. NKID=9
  82. NKMT=7
  83. SEGINI MATCDB
  84. DO 1 IMEB=1,NMEB
  85. MPRIB=MATB.IRIGEL(1,IMEB)
  86. MDUAB=MATB.IRIGEL(2,IMEB)
  87. IMATB=MATB.IRIGEL(4,IMEB)
  88. DO 12 IMEC=1,NMEC
  89. * Vérification des noms d'inconnues
  90. MPRIC=MATC.IRIGEL(1,IMEC)
  91. MDUAC=MATC.IRIGEL(2,IMEC)
  92. IMATC=MATC.IRIGEL(4,IMEC)
  93. *STAT CALL INMSTA(MSMAT,0)
  94. CALL PROMAT(MPRIB,MDUAB,IMATB,
  95. $ MPRIC,MDUAC,IMATC,
  96. $ CHPOD,
  97. $ MPCDB,MDCDB,IMTCDB,
  98. $ IMPR,IRET)
  99. IF (IRET.NE.0) GOTO 9999
  100. *STAT CALL PRMSTA(' Création matrice produit',MSMAT,1)
  101. *STAT CALL SUMSTA(MSMAT,0)
  102. IF (IMTCDB.NE.0) THEN
  103. NMATRI=MATCDB.IRIGEL(/2)+1
  104. SEGADJ,MATCDB
  105. MATCDB.IRIGEL(1,NMATRI)=MPCDB
  106. MATCDB.IRIGEL(2,NMATRI)=MDCDB
  107. MATCDB.IRIGEL(4,NMATRI)=IMTCDB
  108. IF (MATB.EQ.MATC) THEN
  109. MATCDB.IRIGEL(7,NMATRI)=0
  110. ELSE
  111. MATCDB.IRIGEL(7,NMATRI)=2
  112. ENDIF
  113. * Inutile avec le nouvel assemblage
  114. C SEGACT IMTCDB*MOD
  115. C NBMEL=1
  116. C SEGINI GPMELS
  117. C GPMELS.LISMEL(1)=MPCDB
  118. C CALL MLUNIQ(GPMELS,
  119. C $ MPCDB1,IMPR,IRET)
  120. C IF (IRET.NE.0) GOTO 9999
  121. C IMTCDB.KSPGP=MPCDB1
  122. C SEGACT GPMELS*MOD
  123. C GPMELS.LISMEL(1)=MDCDB
  124. C SEGDES GPMELS
  125. C CALL MLUNIQ(GPMELS,
  126. C $ MDCDB1,IMPR,IRET)
  127. C IF (IRET.NE.0) GOTO 9999
  128. C IMTCDB.KSPGD=MDCDB1
  129. C SEGSUP GPMELS
  130. C SEGDES IMTCDB
  131. ENDIF
  132. 12 CONTINUE
  133. 1 CONTINUE
  134. IF (MATCDB.IRIGEL(/2).EQ.0) THEN
  135. WRITE(IOIMP,*) 'Opérateur CMCT : la matrice produit est vide'
  136. ENDIF
  137. SEGDES MATCDB
  138. SEGDES MATC
  139. SEGDES MATB
  140. *STAT CALL PRMSTA('Total de CMCT',MSTOT,1)
  141. *STAT CALL SUMSTA(MSTOT,0)
  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 prcmck'
  156. RETURN
  157. *
  158. * End of subroutine PRCMCK
  159. *
  160. END
  161.  
  162.  
  163.  
  164.  
  165.  

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