Esope source files

   1 : C PRDMCP    SOURCE    GOUNAND   12/12/10    21:15:09     7597           
   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 CCOPTIO
  33 : -INC SMMATRIK
  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)
  65 :          CALL FIXMEL(MELPRI,MELDUA,
  66 :      $        MELPR2,MELDU2,
  67 :      $        IMPR,IRET)
  68 :          IF (IRET.NE.0) GOTO 9999
  69 :          MATELE.IRIGEL(1,IMATE)=MELPR2
  70 :          MATELE.IRIGEL(2,IMATE)=MELDU2
  71 :  1    CONTINUE
  72 :       SEGDES MATELE
  73 : * Initialisation du résultat avec un chpoint vide
  74 :       NAT=2
  75 :       NSOUPO=0
  76 :       SEGINI MCHDUA
  77 :       MCHDUA.IFOPOI=IFOUR
  78 :       MCHDUA.JATTRI(1)=2
  79 :       SEGDES MCHDUA
  80 : *
  81 : * Boucle sur les matrices et les msoupo du chpoint primal
  82 : *
  83 :       SEGACT MATELE
  84 :       NMATE=MATELE.IRIGEL(/2)
  85 :       SEGACT MCHPRI
  86 :       NSOPRI=MCHPRI.IPCHP(/1)
  87 :       DO 3 IMATE=1,NMATE
  88 :          MMLPRI=MATELE.IRIGEL(1,IMATE)
  89 :          MMLDUA=MATELE.IRIGEL(2,IMATE)
  90 :          MMATEL=MATELE.IRIGEL(4,IMATE)
  91 :          DO 4 ISOPRI=1,NSOPRI
  92 :             MSOPRI=MCHPRI.IPCHP(ISOPRI)
  92 :             CALL PRMCP2(MMLPRI,MMLDUA,MMATEL,MSOPRI,
  93 :      $           MSOTMP,
  94 :      $           IMPR,IRET)
  95 :             IF (IRET.NE.0) GOTO 9999
  96 :             IF (MSOTMP.NE.0) THEN
  97 :                NAT=2
  98 :                NSOUPO=1
  99 :                SEGINI MCHTMP
 100 :                MCHTMP.IFOPOI=IFOUR
 101 :                MCHTMP.JATTRI(1)=2
 102 :                MCHTMP.IPCHP(1)=MSOTMP
 103 :                SEGDES MCHTMP
 103 :                CALL ADCHPO(MCHDUA,MCHTMP,MCHTOT,1.D0,1.D0)
 104 :                IF (MCHTOT.EQ.0) THEN
 105 :                   WRITE(IOIMP,*) 'Pas pu faire le ET des chpoints...'
 106 :                   GOTO 9999
 107 :                ENDIF
 107 :                CALL DTCHPO(MCHDUA)
 107 :                CALL DTCHPO(MCHTMP)
 108 :                MCHDUA=MCHTOT
 109 :             ENDIF
 110 :  4       CONTINUE
 111 :  3    CONTINUE
 112 :       segact mchdua*mod
 113 :       mchdua.mochde='créé par prdmcp'
 114 :       mchdua.mtypoi=' '
 115 :       SEGDES MCHPRI
 116 :       SEGDES MATELE
 117 : *
 118 : * Normal termination
 119 : *
 120 :       IRET=0
 121 :       RETURN
 122 : *
 123 : * Format handling
 124 : *
 125 : *
 126 : * Error handling
 127 : *
 128 :  9999 CONTINUE
 129 :       IRET=1
 130 :       WRITE(IOIMP,*) 'An error was detected in subroutine prdmcp'
 131 : *  153 2
 132 : * Opération illicite dans ce contexte
 132 :       CALL ERREUR(153)
 133 :       RETURN
 134 : *
 135 : * End of subroutine PRDMCP
 136 : *
 137 :       END
 138 :  
 139 :  
 140 :  
 141 :  
 142 :  
 143 :  
 144 :  
 145 :