Sources Esope | Cast3M

konre8
C KONRE8    SOURCE    CB215821  20/11/25    13:32:38     10792          
      SUBROUTINE KONRE8(MELEMC,MELEMF,MELEFE,ICHPVO,
     &          ICHFLU, ICHRES,
     &          LOGAN,MESERR)
C
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  KONRE8
C
C DESCRIPTION       :  Voir KONV1, YLAP11
C                      Restitution des residus
C                      Destruction des flux
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/TTMF,
C                      exactly the same that konre1
C
C************************************************************************
C
C
C APPELES
C
C************************************************************************
C
C ENTREES
C
C
C     MELEMC  : MELEME 'CENTRE' du SPG des CENTRES
C
C     MELEFE  : MELEME 'FACEL' du connectivité FACES -> ELEM
C
C     ICHPVO  : CHPOINT "CENTRE" contenant le volume
C               de chaque element
C
C E/S
C
C     ICHFLU.   : pointeurs de CHPOINTs "FACE" des flux aux interfaces:
C
C     ICHRES    : pointeurs de CHPOINTs "CENTRE" des résidus
C
C     LOGAN   : (LOGICAL): si .TRUE. une anomalie à été detectée
C
C     MESERR  : pour l'ecriture des messages d'erreurs
 
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE :
C
C************************************************************************
C
C
C************************************************************************
C
      INTEGER IGEOMC, IGEOMF, NFAC, MELEMC,MELEFE, MELEMF, ICHPVO
     &       ,ICHFLU, ICHRES
     &       , NLCF , NGCF , NLCF1 , NGCEG , NLCEG, NGCED, NLCED
     &       , ICOMP, NCOMP
      REAL*8 VOLUG, VOLUD, CELLF
      CHARACTER*8 TYPE
      CHARACTER*40 MESERR
      LOGICAL LOGAN
C
C**** LES INCLUDES
C
-INC SMCHPOI
      POINTEUR MPOVVO.MPOVAL
     &        , MPOFLU.MPOVAL, MPORES.MPOVAL
-INC SMELEME
-INC SMLENTI
C
C**** Initialisation des MELEMEs
C
C     'CENTRE', 'FACEL'
      IPT2 = MELEFE
      SEGACT IPT2
      NFAC = IPT2.NUM(/2)
C
      CALL LICHT(ICHPVO,MPOVVO,TYPE,IGEOMC)
C     SEGACT MPOVVO*MOD
      IF(IGEOMC .NE. MELEMC)THEN
         MESERR = 'Il ne faut pas jouer avec la console.   '
         LOGAN = .TRUE.
         GOTO 9999
      ENDIF
C
C**** KRIPAD pour la correspondance global/local de centre
C
      CALL KRIPAD(MELEMC,MLENT1)
      CALL KRIPAD(MELEMF,MLENT2)
C
      CALL LICHT(ICHFLU,MPOFLU,TYPE,IGEOMF)
      CALL LICHT(ICHRES,MPORES,TYPE,IGEOMC)
C
C     SEGACT MPOFLU*MOD
C     SEGACT MPORES*MOD
C
      IF(IGEOMF .NE. MELEMF)THEN
         MESERR = 'Il ne faut pas jouer avec la console.   '
         LOGAN = .TRUE.
         GOTO 9999
      ENDIF
      IF(IGEOMC .NE. MELEMC)THEN
         MESERR = 'Il ne faut pas jouer avec la console.   '
         LOGAN = .TRUE.
         GOTO 9999
      ENDIF
      NCOMP = MPOFLU.VPOCHA(/2)
C
C**** BOUCLE SUR FACEL pour le calcul du FLUX
C
      DO NLCF = 1, NFAC
C
C******* NLCF  = numero local du centre de facel
C        NGCF  = numero global du centre de facel
C        NLCF1 = numero local du centre de face
C        NGCEG = numero global du centre ELT "gauche"
C        NLCEG = numero local du centre ELT "gauche"
C        NGCED = numero global du centre ELT "droite"
C        NLCED = numero local du centre ELT "droite"
C
         NGCEG = IPT2.NUM(1,NLCF)
         NGCED = IPT2.NUM(3,NLCF)
         NGCF  = IPT2.NUM(2,NLCF)
         NLCF1 = MLENT2.LECT(NGCF)
         NLCEG = MLENT1.LECT(NGCEG)
         NLCED = MLENT1.LECT(NGCED)
C
C******* NLCF != NLCF1 -> l'auteur (MOI) n'a rien compris.
C
         IF(NLCF .NE. NLCF1)THEN
            MESERR = 'Il ne faut pas jouer avec la console.   '
            LOGAN = .TRUE.
            GOTO 9999
         ENDIF
C
         VOLUG = MPOVVO.VPOCHA(NLCEG,1)
         VOLUD = MPOVVO.VPOCHA(NLCED,1)
C
         IF(NLCEG .NE. NLCED)THEN
C
            DO ICOMP = 1, NCOMP, 1
               CELLF = MPOFLU.VPOCHA(NLCF,ICOMP)
               MPORES.VPOCHA(NLCEG,ICOMP) = MPORES.VPOCHA(NLCEG,ICOMP)
     &             - (CELLF / VOLUG)
               MPORES.VPOCHA(NLCED,ICOMP) = MPORES.VPOCHA(NLCED,ICOMP)
     $              + (CELLF / VOLUD)
            ENDDO
C
         ELSE
C
C*********** Murs
C
            DO ICOMP = 1, NCOMP, 1
               CELLF = MPOFLU.VPOCHA(NLCF,ICOMP)
               MPORES.VPOCHA(NLCEG,ICOMP) = MPORES.VPOCHA(NLCEG,ICOMP) -
     &              (CELLF / VOLUG)
            ENDDO
         ENDIF
C
C**** Fin boucle sur FACEL
C
      ENDDO
C
      SEGSUP MLENT1
      SEGDES MLENT2
      SEGDES IPT2
C
      SEGDES MPOVVO
C
C**** On detrui les CHPOINTs des FLUX
C
      MCHPOI = ICHFLU
      SEGACT MCHPOI*MOD
      MSOUPO = MCHPOI.IPCHP(1)
      SEGSUP MSOUPO
      SEGSUP MPOFLU
      ICHFLU = 0
C
C**** On desactive les CHPOINTs des RESIDU
C
      SEGDES MPORES
C
 9999 RETURN
      END
C