Esope source files

   1 : C PF500     SOURCE    PV        09/03/12    21:30:05     6325           
   2 :       SUBROUTINE PF500(IZDD,IPHI,IZSS,IZGG,IPHR,DT,MTABD,NUMCOM)
   3 : C************************************************************************
   4 : C
   5 : C Pointeurs :
   6 : C ---------
   7 : C    IZDD  : Diagonale
   8 : C    IPHI  : Resultat a l'instant precedent
   9 : C    IZSS  : densité de source
  10 : C    IZGG  : Champ point de type FACE representant les flux(l'increment)
  11 : C    IPHR  : Resultat
  12 : C    MTABD : table du maillage
  13 : C
  14 : C    MELEMA : Connectivites elements/faces 'ELTFA'
  15 : C    MCHELM : Sens des normales
  16 : C    MELEMF : Maillage de type face
  17 : C
  18 : C Variables :
  19 : C ---------
  20 : C    DT     : Pas de Temps
  21 : C    NUMCOM : Numero de Composante
  22 : C
  23 : C************************************************************************
  24 : C
  25 : C Objet : Fait le bilan par element pour un schema volume fini
  26 : C -----
  27 : C                   IPHR=IPHI + DT*(SOURCE) - DT*(FLUX)/DIAGONALE
  28 : C  ou encore        IPHR=IPHI + DT*IZSS - DT*IZGG/IZDD
  29 : C
  30 : C************************************************************************  
  31 : C  Modifications pour prendre en compte les champs a plusieurs
  32 : C  composantes et rajout de Messages d'erreurs : P.G   Aout 96
  33 : C************************************************************************
  34 : C
  35 :       IMPLICIT INTEGER(I-N)
  36 :       IMPLICIT REAL*8 (A-H,O-Z)
  37 : C
  38 : -INC CCOPTIO
  39 : -INC SMLENTI
  40 : C
  41 : -INC SMTABLE
  42 :       POINTEUR MTABD.MTABLE
  43 : C
  44 : -INC SMELEME
  45 :       POINTEUR MELEMA.MELEME,MELEMC.MELEME,MELEMF.MELEME
  46 : C
  47 : -INC SMCHPOI
  48 :       POINTEUR IPHI.MPOVAL,IPHR.MPOVAL
  49 :       POINTEUR IZDD.MPOVAL,IZGG.MPOVAL,IZSS.MPOVAL
  50 : C
  51 : -INC SMCHAML
  52 : C
  53 :       REAL*8 PHI
  54 : C
  55 : C
  56 : C - Lecture du tableau des sens des normales : chamelem
  57 : C   ---------------------------------------------------
  57 :       CALL LEKTAB(MTABD,'XXNORMAE',MCHELM)
  58 :       IF(MCHELM.EQ.0)THEN
  59 :               MOTERR(1:40)='Pas de CHAMELEM des Normales            '
  59 :               CALL ERREUR(-301)
  60 :       GO TO 99
  61 :       ENDIF
  62 :       SEGACT MCHELM
  63 : C
  64 : C - Lecture des connexions Faces/Elements
  65 : C   -------------------------------------
  65 :       CALL LEKTAB(MTABD,'ELTFA',MELEMA)
  66 :       IF(MELEMA.EQ.0)THEN
  67 :               MOTERR(1:40)='Pas de Meleme connexions Faces/Elements '
  67 :               CALL ERREUR(-301)
  68 :       GO TO 99
  69 :       ENDIF
  70 :       SEGACT MELEMA
  71 : C
  71 :       CALL LEKTAB(MTABD,'FACE',MELEMF)
  72 :       IF(MELEMF.EQ.0)THEN
  73 :               MOTERR(1:40)='Pas de Meleme des FACES                 '
  73 :               CALL ERREUR(-301)
  74 :       GO TO 99
  75 :       ENDIF
  76 :       SEGACT MELEMF
  77 : C
  78 : C
  79 :       NBSOUS = MELEMA.LISOUS(/1)
  80 : C
  81 :       IF(NBSOUS.EQ.0)NBSOUS = 1
  82 :       II = 0
  83 : C
  84 :       NBF = MELEMF.NUM(/2)
  85 :       MELEMC = MELEMF
  85 :       CALL KRIPAD(MELEMC,MLENTI)
  85 : C     CALL RSETXI(LECT,MELEMF.NUM,NBF)
  86 :       SEGACT MELEMC
  87 : C
  88 : C - Boucle sur les sous Objets
  89 : C   ==========================
  90 :       DO 1 L=1,NBSOUS
  91 :       IPT1 = MELEMA
  92 :       IF(NBSOUS.NE.1)IPT1 = MELEMA.LISOUS(L)
  93 :       SEGACT IPT1
  94 :       NP = IPT1.NUM(/1)
  95 :       NEL = IPT1.NUM(/2)
  96 :       MCHAML = ICHAML(L)
  97 :       SEGACT MCHAML
  98 :       MELVAL = IELVAL(1)
  99 :       SEGACT MELVAL
 100 : C
 101 : C - Cas ou il n'y a pas de terme Source
 102 : C   -----------------------------------
 103 : C
 104 :       IF(IZSS.EQ.0)THEN
 105 : C
 106 :       DO 10 K=1,NEL
 107 :       II = II+1
 108 :       PHI = 0.D0
 109 : C
 110 : C                     bilan sur chaque element
 111 : C                     -----------------------
 112 :       DO 11 I=1,NP
 113 :          NF = IPT1.NUM(I,K)
 114 :          NF = LECT(NF)
 115 :          PHI = PHI + IZGG.VPOCHA(nf,numcom)*MELVAL.VELCHE(I,K)
 116 :  11   CONTINUE
 117 : C
 118 :       IPHR.VPOCHA(II,numcom) = IPHI.VPOCHA(II,numcom)
 119 :      &                   -DT*PHI/IZDD.VPOCHA(II,numcom)
 120 : C
 121 :  10   CONTINUE
 122 : C
 123 :       ELSE
 124 : C
 125 : C - Cas ou il n'y a un terme Source
 126 : C   -------------------------------
 127 : C
 128 :       DO 20 K=1,NEL
 129 :       II = II+1
 130 :       PHI = 0.D0
 131 : C
 132 : C                     bilan sur chaque element
 133 : C                     -----------------------
 134 :       DO 21 I=1,NP
 135 :          NF = IPT1.NUM(I,K)
 136 :          NF = LECT(NF)
 137 :          PHI = PHI + IZGG.VPOCHA(nf,numcom)*MELVAL.VELCHE(I,K)
 138 :  21   CONTINUE
 139 : C
 140 :       IPHR.VPOCHA(II,numcom)= IPHI.VPOCHA(II,numcom)
 141 :      1                 -DT*PHI/IZDD.VPOCHA(II,numcom)
 142 :      2                 +DT*IZSS.VPOCHA(II,numcom)
 143 : C
 144 :  20   CONTINUE
 145 :       ENDIF
 146 :       SEGDES IPT1,MELVAL,MCHAML
 147 :  1    CONTINUE
 148 : C
 149 : C - Fin de Boucle sur les Sous-Objets
 150 : C   =================================
 151 : C
 152 :       SEGSUP MLENTI
 153 :       SEGDES MELEMC,MELEMA,MELEMF,MCHELM
 154 : C
 155 :       RETURN
 156 : C
 157 :  99   CONTINUE
 158 :       MOTERR(1:40)='     Interruption anormale de PF500     '
 158 :       CALL ERREUR(-301)
 159 : C
 160 :       RETURN
 161 :       END
 162 :  
 163 :  
 164 :  
 165 :