Esope source files

   1 : C PRMCP5    SOURCE    MAGN      09/07/30    21:20:41     6458           
   2 :       SUBROUTINE PRMCP5(MMLPRI,MMLDUA,MMATEL,ICMPRI,ICMDUA,LNBME,
   3 :      $     MPOPRI,KICPRI,KMCPRI,
   4 :      $            KICDUA,KMCDUA,
   5 :      $     MPODUA,
   6 :      $     IMPR,IRET)
   7 :       IMPLICIT INTEGER(I-N)
   8 :       IMPLICIT REAL*8 (A-H,O-Z)
   9 : C***********************************************************************
  10 : C NOM         : PRMCP5
  11 : C DESCRIPTION : Produit matrices élémentaires * mpoval primal 
  12 : C                       -> mpoval dual.
  13 : C
  14 : C
  15 : C LANGAGE     : ESOPE
  16 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  17 : C               mél : gounand@semt2.smts.cea.fr
  18 : C***********************************************************************
  19 : C APPELES          : REGMAI, INIRPM, RPELEM
  20 : C APPELE PAR       : PRMCP2
  21 : C***********************************************************************
  22 : C ENTREES            : MLPRI, MMLDUA, MMATEL, ICMPRI, ICMDUA, LNBME,
  23 : C                      MPOPRI, KICPRI, KMCPRI, KICDUA, KMCDUA
  24 : C ENTREES/SORTIES    : -
  25 : C SORTIES            : MPODUA
  26 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  27 : C***********************************************************************
  28 : C VERSION    : v1, 18/04/2000, version initiale
  29 : C HISTORIQUE : v1, 18/04/2000, création
  30 : C HISTORIQUE :
  31 : C HISTORIQUE :
  32 : C***********************************************************************
  33 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  34 : C en cas de modification de ce sous-programme afin de faciliter
  35 : C la maintenance !
  36 : C***********************************************************************
  37 : -INC CCOPTIO
  38 : -INC SMELEME
  39 :       POINTEUR MMLPRI.MELEME
  40 :       POINTEUR MMLDUA.MELEME
  41 :       POINTEUR ML2PRI.MELEME
  42 :       POINTEUR ML2DUA.MELEME
  43 :       POINTEUR SMLPRI.MELEME
  44 :       POINTEUR SMLDUA.MELEME
  45 : -INC SMMATRIK
  46 :       POINTEUR MMATEL.IMATRI
  47 :       POINTEUR VMATEL.IZAFM
  48 : -INC SMLENTI
  49 :       POINTEUR RPMAT.MLENTI
  50 :       POINTEUR ICMPRI.MLENTI
  51 :       POINTEUR ICMDUA.MLENTI
  52 :       POINTEUR LNBME.MLENTI
  53 :       POINTEUR KICPRI.MLENTI
  54 :       POINTEUR KICDUA.MLENTI
  55 :       POINTEUR KMCPRI.MLENTI
  56 :       POINTEUR KMCDUA.MLENTI
  57 : -INC SMCHPOI
  58 :       POINTEUR MPOPRI.MPOVAL
  59 :       POINTEUR MPODUA.MPOVAL
  60 : *
  61 :       INTEGER IMPR,IRET
  62 : *
  63 :       INTEGER ICCPRI,ICCDUA,ILMAT,NUELG,NUELOC,ITPOPR,ITPODU
  64 :       INTEGER IELEM ,IMATL ,IPMAT,JDMAT, ISOUM,ISOUMA,OLDISM
  65 :       INTEGER NELPRI,NMATL ,NPMAT,NDMAT,NBSOUM,NBSOUP,NBSOUD
  66 :       LOGICAL LPARTP,LPARTD
  67 : *     
  68 : * Executable statements
  69 : *
  70 :       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans prmcp5.eso' 
  71 : * On régularise les maillage pour plus se faire chier si LISOUS(/1).EQ.0 
  72 : * In REGMAI : IF (.NOT.LPARTD) SEGINI ML2DUA
  72 :       CALL REGMAI(MMLDUA,ML2DUA,LPARTD,IMPR,IRET)
  73 :       IF (IRET.NE.0) GOTO 9999
  74 : * In REGMAI : IF (.NOT.LPARTP) SEGINI ML2PRI
  74 :       CALL REGMAI(MMLPRI,ML2PRI,LPARTP,IMPR,IRET)
  75 :       IF (IRET.NE.0) GOTO 9999
  76 : *
  77 : * Activons les chapeaux (Matrices et supports)
  78 : *
  79 :       SEGACT ML2DUA
  80 :       NBSOUD=ML2DUA.LISOUS(/1)
  81 :       SEGACT ML2PRI
  82 :       NBSOUP=ML2PRI.LISOUS(/1)
  83 :       SEGACT MMATEL
  84 :       NBSOUM=NBSOUP
  85 :       IF (NBSOUD.NE.NBSOUP) THEN
  86 :          WRITE(IOIMP,*) 'Maillage primal, dual :'
  87 :          WRITE(IOIMP,*) 'partitionnment différent...'
  88 :          WRITE(IOIMP,*) 'NBSOUD=',NBSOUD
  89 :          WRITE(IOIMP,*) 'NBSOUP=',NBSOUP
  90 :          GOTO 9999
  91 :       ENDIF
  92 : *
  93 : * Tableau de repérage dans la matrice
  94 : *
  95 : * In INIRPM : SEGINI RPMAT
  95 :       CALL INIRPM(MMATEL,RPMAT,IMPR,IRET)
  96 :       IF (IRET.NE.0) GOTO 9999
  97 : *
  98 : * Activons les tableaux de repérage
  99 : *
 100 : * Matrices
 101 : *  Inconnues
 102 :       SEGACT ICMPRI
 103 :       SEGACT ICMDUA
 104 : *  Matrices élémentaires à parcourir
 105 :       SEGACT LNBME
 106 : * Chpoints
 107 :       SEGACT MPOPRI
 108 :       SEGACT MPODUA*MOD
 109 : *  Inconnues
 110 :       SEGACT KICPRI
 111 :       SEGACT KICDUA
 112 : *  Maillages
 113 :       SEGACT KMCPRI
 114 :       SEGACT KMCDUA
 115 : *
 116 : * Parcourons les matrices élémentaires par sous-domaine et
 117 : * remplissons les valeurs de MPODUA.
 118 : *
 119 :       NMATL=LNBME.LECT(/1)
 120 :       DO 1 IMATL=1,NMATL
 121 : * Numéros d'inconnues dans les chpo. primaux et duaux 
 122 : * pour la LNBME.LECT(IMATL)ième matrice
 123 :          ICCPRI=KICPRI.LECT(ICMPRI.LECT(LNBME.LECT(IMATL)))
 124 :          ICCDUA=KICDUA.LECT(ICMDUA.LECT(LNBME.LECT(IMATL)))
 125 :          NUELG=0
 126 :          OLDISM=1
 127 :          VMATEL=MMATEL.LIZAFM(OLDISM,LNBME.LECT(IMATL))
 128 :          SEGACT VMATEL
 129 :          DO 12 ISOUM=1,NBSOUM
 130 :             SMLDUA=ML2DUA.LISOUS(ISOUM)
 131 :             SEGACT SMLDUA
 132 :             SMLPRI=ML2PRI.LISOUS(ISOUM)
 133 :             SEGACT SMLPRI
 134 :             NELPRI=SMLPRI.NUM(/2)
 135 :             DO 122 IELEM=1,NELPRI
 136 :                NUELG=NUELG+1
 136 :                CALL RPELEM(NUELG,RPMAT,ISOUMA,NUELOC,IMPR,IRET)
 137 :                IF (IRET.NE.0) GOTO 9999
 138 :                ISOUMA=MAX(ISOUMA,1)
 139 :                IF (ISOUMA.NE.OLDISM) THEN
 140 :                   SEGDES VMATEL
 141 :                   VMATEL=MMATEL.LIZAFM(ISOUMA,LNBME.LECT(IMATL))
 142 :                   SEGACT VMATEL
 143 :                   OLDISM=ISOUMA
 144 :                ENDIF
 145 :                ILMAT=NUELOC
 146 :                NPMAT=VMATEL.AM(/2)
 147 :                NDMAT=VMATEL.AM(/3)
 148 :                DO 1222 JDMAT=1,NDMAT
 149 :                   ITPODU=KMCDUA.LECT(SMLDUA.NUM(JDMAT,IELEM))
 150 :                   IF (ITPODU.EQ.0) THEN
 151 :                      WRITE(IOIMP,*) 'Point dual ????'
 152 :                      GOTO 9999
 153 :                   ENDIF
 154 :                   DO 12222 IPMAT=1,NPMAT
 155 :                      ITPOPR=KMCPRI.LECT(SMLPRI.NUM(IPMAT,IELEM))
 156 : *                     IF (ITPOPR.EQ.0) THEN
 157 : *                        WRITE(IOIMP,*) 'Un point du chpo. primal ',
 158 : *     $                       'n''est pas dans le spg primal de la  ',
 159 : *     $                       'matrice..'
 160 : *                        GOTO 9999
 161 : *                     ENDIF
 162 :                      IF (ITPOPR.NE.0) THEN
 163 :                         MPODUA.VPOCHA(ITPODU,ICCDUA)=
 164 :      $                       MPODUA.VPOCHA(ITPODU,ICCDUA)+
 165 :      $                       (VMATEL.AM(ILMAT,IPMAT,JDMAT)
 166 :      $                       *MPOPRI.VPOCHA(ITPOPR,ICCPRI))
 167 :                      ENDIF
 168 : 12222             CONTINUE
 169 :  1222          CONTINUE
 170 :  122        CONTINUE
 171 :             SEGDES SMLPRI
 172 :             SEGDES SMLDUA
 173 :   12      CONTINUE
 174 :           SEGDES VMATEL
 175 :  1    CONTINUE
 176 : *
 177 : * Désactivons les tableaux de repérage
 178 : *
 179 :       SEGDES KMCDUA
 180 :       SEGDES KMCPRI
 181 :       SEGDES KICDUA
 182 :       SEGDES KICPRI
 183 :       SEGDES MPODUA
 184 :       SEGDES MPOPRI
 185 :       SEGDES LNBME
 186 :       SEGDES ICMDUA
 187 :       SEGDES ICMPRI
 188 :       SEGDES RPMAT
 189 :       SEGDES MMATEL
 190 :       SEGDES ML2PRI
 191 :       SEGDES ML2DUA
 192 :       IF (.NOT.LPARTP) SEGSUP ML2PRI
 193 :       IF (.NOT.LPARTD) SEGSUP ML2DUA
 194 : *
 195 : * Normal termination
 196 : *
 197 :       IRET=0
 198 :       RETURN
 199 : *
 200 : * Format handling
 201 : *
 202 : *
 203 : * Error handling
 204 : *
 205 :  9999 CONTINUE
 206 :       IRET=1
 207 :       WRITE(IOIMP,*) 'An error was detected in subroutine prmcp5'
 208 :       RETURN
 209 : *
 210 : * End of subroutine PRMCP5
 211 : *
 212 :       END
 213 : 
 214 :  
 215 :  
 216 :  
 217 :