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  25/04/23    21:15:33     12247          
  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. -INC SMCOORD
  39.       INTEGER NAT,NSOUPO
  40.       POINTEUR MCHPRI.MCHPOI
  41.       POINTEUR MSOPRI.MSOUPO
  42.       POINTEUR MCHDUA.MCHPOI
  43.       POINTEUR MCHTOT.MCHPOI
  44.       POINTEUR MCHTMP.MCHPOI
  45.       POINTEUR MSOTMP.MSOUPO
  46. -INC SMELEME
  47.       POINTEUR MELPRI.MELEME
  48.       POINTEUR MELPR2.MELEME
  49.       POINTEUR MMLPRI.MELEME
  50.       POINTEUR MELDUA.MELEME
  51.       POINTEUR MELDU2.MELEME
  52.       POINTEUR MMLDUA.MELEME
  53. *
  54.       INTEGER IMPR,IRET
  55.       INTEGER NMATE,NSOPRI
  56.       INTEGER IMATE,ISOPRI
  57. *
  58. * Executable statements
  59. *
  60.       IMPR=IIMPI
  61.       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans prdmcp.eso'
  62. * Correction des maillages (à supprimer dès que possible)
  63.       SEGACT MATELE*MOD
  64.       NMATE=MATELE.IRIGEL(/2)
  65.       DO 1 IMATE=1,NMATE
  66.          MELPRI=MATELE.IRIGEL(1,IMATE)
  67.          MELDUA=MATELE.IRIGEL(2,IMATE)
  68.          CALL FIXMEL(MELPRI,MELDUA,
  69.      $        MELPR2,MELDU2,
  70.      $        IMPR,IRET)
  71.          IF (IRET.NE.0) GOTO 9999
  72.          MATELE.IRIGEL(1,IMATE)=MELPR2
  73.          MATELE.IRIGEL(2,IMATE)=MELDU2
  74.  1    CONTINUE
  75.       SEGDES MATELE
  76. * Initialisation du résultat avec un chpoint vide
  77.       NAT=2
  78.       NSOUPO=0
  79.       SEGINI MCHDUA
  80.       MCHDUA.IFOPOI=IFOUR
  81.       MCHDUA.JATTRI(1)=2
  82.       SEGDES MCHDUA
  83. *
  84. * Boucle sur les matrices et les msoupo du chpoint primal
  85. *
  86.       SEGACT MATELE
  87.       NMATE=MATELE.IRIGEL(/2)
  88.       SEGACT MCHPRI
  89.       NSOPRI=MCHPRI.IPCHP(/1)
  90.       DO 3 IMATE=1,NMATE
  91.          MMLPRI=MATELE.IRIGEL(1,IMATE)
  92.          MMLDUA=MATELE.IRIGEL(2,IMATE)
  93.          MMATEL=MATELE.IRIGEL(4,IMATE)
  94.          DO 4 ISOPRI=1,NSOPRI
  95.             MSOPRI=MCHPRI.IPCHP(ISOPRI)
  96.             CALL PRMCP2(MMLPRI,MMLDUA,MMATEL,MSOPRI,
  97.      $           MSOTMP,
  98.      $           IMPR,IRET)
  99.             IF (IRET.NE.0) GOTO 9999
  100.             IF (MSOTMP.NE.0) THEN
  101.                NAT=2
  102.                NSOUPO=1
  103.                SEGINI MCHTMP
  104.                MCHTMP.IFOPOI=IFOUR
  105.                MCHTMP.JATTRI(1)=2
  106.                MCHTMP.IPCHP(1)=MSOTMP
  107.                SEGDES MCHTMP
  108.                CALL ADCHPO(MCHDUA,MCHTMP,MCHTOT,1.D0,1.D0)
  109.                IF (MCHTOT.EQ.0) THEN
  110.                   WRITE(IOIMP,*) 'Pas pu faire le ET des chpoints...'
  111.                   GOTO 9999
  112.                ENDIF
  113.                CALL DTCHPO(MCHDUA)
  114.                CALL DTCHPO(MCHTMP)
  115.                MCHDUA=MCHTOT
  116.             ENDIF
  117.  4       CONTINUE
  118.  3    CONTINUE
  119.       segact mchdua*mod
  120.       mchdua.mochde='créé par prdmcp'
  121.       mchdua.mtypoi=' '
  122.       SEGDES MATELE
  123. *
  124. * Normal termination
  125. *
  126.       IRET=0
  127.       RETURN
  128. *
  129. * Format handling
  130. *
  131. *
  132. * Error handling
  133. *
  134.  9999 CONTINUE
  135.       IRET=1
  136.       WRITE(IOIMP,*) 'An error was detected in subroutine prdmcp'
  137. *  153 2
  138. * Opération illicite dans ce contexte
  139.       CALL ERREUR(153)
  140.       RETURN
  141. *
  142. * End of subroutine PRDMCP
  143. *
  144.       END
  145.  
  146.  
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  
  155.  
  156.  
  157.  
  158.  
  159.  

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