Esope source files

   1 : C KONRE1    SOURCE    CHAT      05/01/13    01:03:06     5004           
   2 :       SUBROUTINE KONRE1(MELEMC,MELEMF,MELEFE,ICHPVO,
   3 :      &          ICHFLU, ICHRES,
   4 :      &          LOGAN,MESERR)
   5 : C
   6 : C************************************************************************
   7 : C
   8 : C PROJET            :  CASTEM 2000
   9 : C
  10 : C NOM               :  KONRE1
  11 : C
  12 : C DESCRIPTION       :  Voir KONV1, YLAP11
  13 : C                      Restitution des residus
  14 : C                      Destruction des flux
  15 : C     
  16 : C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  17 : C      
  18 : C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/TTMF                        
  19 : C
  20 : C************************************************************************
  21 : C
  22 : C
  23 : C APPELES 
  24 : C
  25 : C************************************************************************
  26 : C
  27 : C ENTREES
  28 : C
  29 : C
  30 : C     MELEMC  : MELEME 'CENTRE' du SPG des CENTRES
  31 : C
  32 : C     MELEFE  : MELEME 'FACEL' du connectivité FACES -> ELEM
  33 : C
  34 : C     ICHPVO  : CHPOINT "CENTRE" contenant le volume
  35 : C               de chaque element
  36 : C
  37 : C E/S
  38 : C
  39 : C     ICHFLU.   : pointeurs de CHPOINTs "FACE" des flux aux interfaces:
  40 : C
  41 : C     ICHRES    : pointeurs de CHPOINTs "CENTRE" des résidus
  42 : C
  43 : C     LOGAN   : (LOGICAL): si .TRUE. une anomalie à été detectée
  44 : C
  45 : C     MESERR  : pour l'ecriture des messages d'erreurs
  46 : 
  47 : C
  48 : C************************************************************************
  49 : C
  50 : C HISTORIQUE (Anomalies et modifications éventuelles)
  51 : C
  52 : C HISTORIQUE :
  53 : C      
  54 : C************************************************************************
  55 : C
  56 : C
  57 : C************************************************************************
  58 : C               
  59 :       IMPLICIT INTEGER(I-N)
  60 :       INTEGER IGEOMC, IGEOMF, NFAC, MELEMC,MELEFE, MELEMF, ICHPVO
  61 :      &       ,ICHFLU, ICHRES
  62 :      &       , NLCF , NGCF , NLCF1 , NGCEG , NLCEG, NGCED, NLCED
  63 :      &       , ICOMP, NCOMP
  64 :       REAL*8 VOLUG, VOLUD, CELLF
  65 :       CHARACTER*8 TYPE
  66 :       CHARACTER*40 MESERR
  67 :       LOGICAL LOGAN
  68 : C
  69 : C**** LES INCLUDES
  70 : C
  71 : -INC SMCHPOI
  72 :       POINTEUR MPOVVO.MPOVAL
  73 :      &        , MPOFLU.MPOVAL, MPORES.MPOVAL
  74 : -INC SMELEME
  75 : -INC SMLENTI
  76 : C
  77 : C**** Initialisation des MELEMEs
  78 : C
  79 : C     'CENTRE', 'FACEL'
  80 :       IPT2 = MELEFE
  81 :       SEGACT IPT2
  82 :       NFAC = IPT2.NUM(/2)
  83 : C
  83 :       CALL LICHT(ICHPVO,MPOVVO,TYPE,IGEOMC)
  84 : C     SEGACT MPOVVO*MOD
  85 :       IF(IGEOMC .NE. MELEMC)THEN
  86 :          MESERR = 'Il ne faut pas jouer avec la console.   '
  87 :          LOGAN = .TRUE.
  88 :          GOTO 9999
  89 :       ENDIF 
  90 : C
  91 : C**** KRIPAD pour la correspondance global/local de centre
  92 : C
  92 :       CALL KRIPAD(MELEMC,MLENT1)
  92 :       CALL KRIPAD(MELEMF,MLENT2)      
  93 : C      
  93 :       CALL LICHT(ICHFLU,MPOFLU,TYPE,IGEOMF)
  93 :       CALL LICHT(ICHRES,MPORES,TYPE,IGEOMC)
  94 : C
  95 : C     SEGACT MPOFLU*MOD
  96 : C     SEGACT MPORES*MOD
  97 : C
  98 :       IF(IGEOMF .NE. MELEMF)THEN
  99 :          MESERR = 'Il ne faut pas jouer avec la console.   '
 100 :          LOGAN = .TRUE.
 101 :          GOTO 9999
 102 :       ENDIF 
 103 :       IF(IGEOMC .NE. MELEMC)THEN
 104 :          MESERR = 'Il ne faut pas jouer avec la console.   '
 105 :          LOGAN = .TRUE.
 106 :          GOTO 9999
 107 :       ENDIF 
 108 :       NCOMP = MPOFLU.VPOCHA(/2)
 109 : C
 110 : C**** BOUCLE SUR FACEL pour le calcul du FLUX
 111 : C
 112 :       DO NLCF = 1, NFAC
 113 : C
 114 : C******* NLCF  = numero local du centre de facel
 115 : C        NGCF  = numero global du centre de facel
 116 : C        NLCF1 = numero local du centre de face         
 117 : C        NGCEG = numero global du centre ELT "gauche"
 118 : C        NLCEG = numero local du centre ELT "gauche"
 119 : C        NGCED = numero global du centre ELT "droite"
 120 : C        NLCED = numero local du centre ELT "droite"
 121 : C
 122 :          NGCEG = IPT2.NUM(1,NLCF)
 123 :          NGCED = IPT2.NUM(3,NLCF)
 124 :          NGCF  = IPT2.NUM(2,NLCF)
 125 :          NLCF1 = MLENT2.LECT(NGCF)
 126 :          NLCEG = MLENT1.LECT(NGCEG)
 127 :          NLCED = MLENT1.LECT(NGCED)
 128 : C
 129 : C******* NLCF != NLCF1 -> l'auteur (MOI) n'a rien compris.
 130 : C
 131 :          IF(NLCF .NE. NLCF1)THEN
 132 :             MESERR = 'Il ne faut pas jouer avec la console.   '
 133 :             LOGAN = .TRUE.
 134 :             GOTO 9999
 135 :          ENDIF 
 136 : C
 137 :          VOLUG = MPOVVO.VPOCHA(NLCEG,1)
 138 :          VOLUD = MPOVVO.VPOCHA(NLCED,1)
 139 : C
 140 :          IF(NLCEG .NE. NLCED)THEN 
 141 : C
 142 :             DO ICOMP = 1, NCOMP, 1
 143 :                CELLF = MPOFLU.VPOCHA(NLCF,ICOMP)
 144 :                MPORES.VPOCHA(NLCEG,ICOMP) = MPORES.VPOCHA(NLCEG,ICOMP) 
 145 :      &             - (CELLF / VOLUG)
 146 :                MPORES.VPOCHA(NLCED,ICOMP) = MPORES.VPOCHA(NLCED,ICOMP)
 147 :      $              + (CELLF / VOLUD)
 148 :             ENDDO
 149 : C
 150 :          ELSE
 151 : C
 152 : C*********** Murs
 153 : C
 154 :             DO ICOMP = 1, NCOMP, 1
 155 :                CELLF = MPOFLU.VPOCHA(NLCF,ICOMP)
 156 :                MPORES.VPOCHA(NLCEG,ICOMP) = MPORES.VPOCHA(NLCEG,ICOMP) -
 157 :      &              (CELLF / VOLUG)
 158 :             ENDDO
 159 :          ENDIF
 160 : C     
 161 : C**** Fin boucle sur FACEL
 162 : C         
 163 :       ENDDO
 164 : C
 165 :       SEGSUP MLENT1
 166 :       SEGDES MLENT2
 167 :       SEGDES IPT2
 168 : C
 169 :       SEGDES MPOVVO
 170 : C
 171 : C**** On detrui les CHPOINTs des FLUX
 172 : C
 173 :       MCHPOI = ICHFLU
 174 :       SEGACT MCHPOI*MOD
 175 :       MSOUPO = MCHPOI.IPCHP(1)
 176 :       SEGSUP MSOUPO
 177 :       SEGSUP MPOFLU
 178 :       ICHFLU = 0
 179 : C
 180 : C**** On desactive les CHPOINTs des RESIDU
 181 : C
 182 :       SEGDES MPORES
 183 : C
 184 :  9999 RETURN
 185 :       END
 186 : C
 187 : 
 188 :          
 189 : 
 190 : 
 191 : 
 192 :  
 193 :  
 194 :