Télécharger la plaquette Cast3M


fr en

Télécharger prdmcp.eso

Retour à la liste

Numérotation des lignes : 

prdmcp

  1. C PRDMCP    SOURCE    CB215821  20/11/25    13:36:04     10792          
  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
  35.       POINTEUR MATELE.MATRIK
  36.       POINTEUR MMATEL.IMATEL
  37. -INC SMCHPOI
  38.       INTEGER NAT,NSOUPO
  39.       POINTEUR MCHPRI.MCHPOI
  40.       POINTEUR MSOPRI.MSOUPO
  41.       POINTEUR MCHDUA.MCHPOI
  42.       POINTEUR MCHTOT.MCHPOI
  43.       POINTEUR MCHTMP.MCHPOI
  44.       POINTEUR MSOTMP.MSOUPO
  45. -INC SMELEME
  46.       POINTEUR MELPRI.MELEME
  47.       POINTEUR MELPR2.MELEME
  48.       POINTEUR MMLPRI.MELEME
  49.       POINTEUR MELDUA.MELEME
  50.       POINTEUR MELDU2.MELEME
  51.       POINTEUR MMLDUA.MELEME
  52. *
  53.       INTEGER IMPR,IRET
  54.       INTEGER NMATE,NSOPRI
  55.       INTEGER IMATE,ISOPRI
  56. *
  57. * Executable statements
  58. *
  59.       IMPR=IIMPI
  60.       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans prdmcp.eso'
  61. * Correction des maillages (à supprimer dès que possible)
  62.       SEGACT MATELE*MOD
  63.       NMATE=MATELE.IRIGEL(/2)
  64.       DO 1 IMATE=1,NMATE
  65.          MELPRI=MATELE.IRIGEL(1,IMATE)
  66.          MELDUA=MATELE.IRIGEL(2,IMATE)
  67.          CALL FIXMEL(MELPRI,MELDUA,
  68.      $        MELPR2,MELDU2,
  69.      $        IMPR,IRET)
  70.          IF (IRET.NE.0) GOTO 9999
  71.          MATELE.IRIGEL(1,IMATE)=MELPR2
  72.          MATELE.IRIGEL(2,IMATE)=MELDU2
  73.  1    CONTINUE
  74.       SEGDES MATELE
  75. * Initialisation du résultat avec un chpoint vide
  76.       NAT=2
  77.       NSOUPO=0
  78.       SEGINI MCHDUA
  79.       MCHDUA.IFOPOI=IFOUR
  80.       MCHDUA.JATTRI(1)=2
  81.       SEGDES MCHDUA
  82. *
  83. * Boucle sur les matrices et les msoupo du chpoint primal
  84. *
  85.       SEGACT MATELE
  86.       NMATE=MATELE.IRIGEL(/2)
  87.       SEGACT MCHPRI
  88.       NSOPRI=MCHPRI.IPCHP(/1)
  89.       DO 3 IMATE=1,NMATE
  90.          MMLPRI=MATELE.IRIGEL(1,IMATE)
  91.          MMLDUA=MATELE.IRIGEL(2,IMATE)
  92.          MMATEL=MATELE.IRIGEL(4,IMATE)
  93.          DO 4 ISOPRI=1,NSOPRI
  94.             MSOPRI=MCHPRI.IPCHP(ISOPRI)
  95.             CALL PRMCP2(MMLPRI,MMLDUA,MMATEL,MSOPRI,
  96.      $           MSOTMP,
  97.      $           IMPR,IRET)
  98.             IF (IRET.NE.0) GOTO 9999
  99.             IF (MSOTMP.NE.0) THEN
  100.                NAT=2
  101.                NSOUPO=1
  102.                SEGINI MCHTMP
  103.                MCHTMP.IFOPOI=IFOUR
  104.                MCHTMP.JATTRI(1)=2
  105.                MCHTMP.IPCHP(1)=MSOTMP
  106.                SEGDES MCHTMP
  107.                CALL ADCHPO(MCHDUA,MCHTMP,MCHTOT,1.D0,1.D0)
  108.                IF (MCHTOT.EQ.0) THEN
  109.                   WRITE(IOIMP,*) 'Pas pu faire le ET des chpoints...'
  110.                   GOTO 9999
  111.                ENDIF
  112.                CALL DTCHPO(MCHDUA)
  113.                CALL DTCHPO(MCHTMP)
  114.                MCHDUA=MCHTOT
  115.             ENDIF
  116.  4       CONTINUE
  117.  3    CONTINUE
  118.       segact mchdua*mod
  119.       mchdua.mochde='créé par prdmcp'
  120.       mchdua.mtypoi=' '
  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.  
  155.  
  156.  
  157.  

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