Télécharger prdmcp.eso

Retour à la liste

Numérotation des lignes :

  1. C PRDMCP SOURCE PV 16/11/17 22:01:05 9180
  2. SUBROUTINE PRDMCP(MATELE,MCHPRI,MCHDUA)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C***********************************************************************
  6. C NOM : PRDMCP
  7. C DESCRIPTION : Produit matrices élémentaires * chpo. primal
  8. C -> chpo. dual.
  9. C
  10. C LANGAGE : ESOPE
  11. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  12. C mél : gounand@semt2.smts.cea.fr
  13. C***********************************************************************
  14. C APPELES : PRMCP2
  15. C APPELES (UTIL.) : FIXMEL, ADCHPO, DTCHPO, ERREUR
  16. C APPELE PAR : KOPS
  17. C***********************************************************************
  18. C ENTREES : MATELE, MCHPRI
  19. C ENTREES/SORTIES : -
  20. C SORTIES : MCHDUA
  21. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  22. C***********************************************************************
  23. C VERSION : v1, 18/04/2000, version initiale
  24. C HISTORIQUE : v1, 18/04/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 PPARAM
  33. -INC CCOPTIO
  34. POINTEUR MATELE.MATRIK
  35. POINTEUR MMATEL.IMATEL
  36. -INC SMCHPOI
  37. INTEGER NAT,NSOUPO
  38. POINTEUR MCHPRI.MCHPOI
  39. POINTEUR MSOPRI.MSOUPO
  40. POINTEUR MCHDUA.MCHPOI
  41. POINTEUR MCHTOT.MCHPOI
  42. POINTEUR MCHTMP.MCHPOI
  43. POINTEUR MSOTMP.MSOUPO
  44. -INC SMELEME
  45. POINTEUR MELPRI.MELEME
  46. POINTEUR MELPR2.MELEME
  47. POINTEUR MMLPRI.MELEME
  48. POINTEUR MELDUA.MELEME
  49. POINTEUR MELDU2.MELEME
  50. POINTEUR MMLDUA.MELEME
  51. *
  52. INTEGER IMPR,IRET
  53. INTEGER NMATE,NSOPRI
  54. INTEGER IMATE,ISOPRI
  55. *
  56. * Executable statements
  57. *
  58. IMPR=IIMPI
  59. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans prdmcp.eso'
  60. * Correction des maillages (à supprimer dès que possible)
  61. SEGACT MATELE*MOD
  62. NMATE=MATELE.IRIGEL(/2)
  63. DO 1 IMATE=1,NMATE
  64. MELPRI=MATELE.IRIGEL(1,IMATE)
  65. MELDUA=MATELE.IRIGEL(2,IMATE)
  66. CALL FIXMEL(MELPRI,MELDUA,
  67. $ MELPR2,MELDU2,
  68. $ IMPR,IRET)
  69. IF (IRET.NE.0) GOTO 9999
  70. MATELE.IRIGEL(1,IMATE)=MELPR2
  71. MATELE.IRIGEL(2,IMATE)=MELDU2
  72. 1 CONTINUE
  73. SEGDES MATELE
  74. * Initialisation du résultat avec un chpoint vide
  75. NAT=2
  76. NSOUPO=0
  77. SEGINI MCHDUA
  78. MCHDUA.IFOPOI=IFOUR
  79. MCHDUA.JATTRI(1)=2
  80. SEGDES MCHDUA
  81. *
  82. * Boucle sur les matrices et les msoupo du chpoint primal
  83. *
  84. SEGACT MATELE
  85. NMATE=MATELE.IRIGEL(/2)
  86. SEGACT MCHPRI
  87. NSOPRI=MCHPRI.IPCHP(/1)
  88. DO 3 IMATE=1,NMATE
  89. MMLPRI=MATELE.IRIGEL(1,IMATE)
  90. MMLDUA=MATELE.IRIGEL(2,IMATE)
  91. MMATEL=MATELE.IRIGEL(4,IMATE)
  92. DO 4 ISOPRI=1,NSOPRI
  93. MSOPRI=MCHPRI.IPCHP(ISOPRI)
  94. CALL PRMCP2(MMLPRI,MMLDUA,MMATEL,MSOPRI,
  95. $ MSOTMP,
  96. $ IMPR,IRET)
  97. IF (IRET.NE.0) GOTO 9999
  98. IF (MSOTMP.NE.0) THEN
  99. NAT=2
  100. NSOUPO=1
  101. SEGINI MCHTMP
  102. MCHTMP.IFOPOI=IFOUR
  103. MCHTMP.JATTRI(1)=2
  104. MCHTMP.IPCHP(1)=MSOTMP
  105. SEGDES MCHTMP
  106. CALL ADCHPO(MCHDUA,MCHTMP,MCHTOT,1.D0,1.D0)
  107. IF (MCHTOT.EQ.0) THEN
  108. WRITE(IOIMP,*) 'Pas pu faire le ET des chpoints...'
  109. GOTO 9999
  110. ENDIF
  111. CALL DTCHPO(MCHDUA)
  112. CALL DTCHPO(MCHTMP)
  113. MCHDUA=MCHTOT
  114. ENDIF
  115. 4 CONTINUE
  116. 3 CONTINUE
  117. segact mchdua*mod
  118. mchdua.mochde='créé par prdmcp'
  119. mchdua.mtypoi=' '
  120. SEGDES MCHPRI
  121. SEGDES MATELE
  122. *
  123. * Normal termination
  124. *
  125. IRET=0
  126. RETURN
  127. *
  128. * Format handling
  129. *
  130. *
  131. * Error handling
  132. *
  133. 9999 CONTINUE
  134. IRET=1
  135. WRITE(IOIMP,*) 'An error was detected in subroutine prdmcp'
  136. * 153 2
  137. * Opération illicite dans ce contexte
  138. CALL ERREUR(153)
  139. RETURN
  140. *
  141. * End of subroutine PRDMCP
  142. *
  143. END
  144.  
  145.  
  146.  
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  

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