Télécharger lekmod.eso

Retour à la liste

lekmod
C LEKMOD    SOURCE    CB215821  24/04/12    21:16:34     11897          
      SUBROUTINE LEKMOD(MMODEL,IPOINT,INEFMD)
C---------------------------------------------------------------------
C Ce sous-programme vérifie que le modèle est bien Navier_Stokes
C                                                ou DARCY
C ensuite il recherche dans le modele MMODEL
C la table domaine et la cree si elle n'existe pas déja
C---------------------------
C Paramètres Entrée/Sortie :
C---------------------------
C
C E/S MMODEL : Pointeur du modèle contenant l'information cherchée
C              (rendu ACTIF)
C  /S IPOINT : Pointeur sur la table DOMAINE
C  /S INEFMD : Type formulation (non utilisé par DARCY)
C              INEFMD = 1 LINE,
C                     = 2 MACRO,
C                     = 3 QUADRATIQUE,
C                     = 4 LINB.
C
C---------------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
-INC PPARAM
-INC SMELEME
-INC SMMODEL
      CHARACTER*8  NOMDOM
      CHARACTER*16 NOMFOR
 
C     Table des partitions concernées par la table domaine
      SEGMENT TPART
        LOGICAL  LPART(NBPART)
      ENDSEGMENT
 
C***
 
      MTABI=0
 
*     Identification des formulations des partitions du modèle
*     de méca-flux :
      SEGACT MMODEL
      N1     = KMODEL(/1)
      NBPART = N1
      SEGINI TPART
      NBMECF = 0
      DO 1 L=1,N1
        IMODEL=KMODEL(L)
        SEGACT IMODEL
        NOMFOR = FORMOD(1)
        LPART(L) = ((NOMFOR.EQ.'NAVIER_STOKES').OR.(NOMFOR.EQ.'DARCY')
     &               .OR.(NOMFOR.EQ.'EULER'))
        IF (LPART(L)) THEN
          L0 = L
          NBMECF = NBMECF + 1
        ENDIF
 1    CONTINUE
C     write(6,*)' SUB LEKMOD : NEFMOD=',NEFMOD
 
      IF (NBMECF.EQ.0) THEN
C       Données incompatibles
        CALL ERREUR(21)
        RETURN
      ENDIF
*
*     Voyons l'une des partitions de type méca-flux :
*
      IMODEL = KMODEL(L0)
      IPTR   = INFMOD(2)
 
      IF(IPTR.NE.0)THEN
*       la table domaine existe déjà pour cette partition
*       (donc pour toutes les autres partitions de type méca-flux)
 
*       On renvoie le pointeur de la table
        IPOINT=IPTR
 
*       Détermination de MACRO et INEFMD
        IMODEL = KMODEL(1)
        IF((FORMOD(1).EQ.'DARCY').OR.(NOMFOR.EQ.'EULER'))THEN
          INEFMD=0
          MACRO=0
        ELSEIF(NEFMOD.GE.129.AND.NEFMOD.LE.135)THEN
          INEFMD=1
          MACRO=0
        ELSEIF(NEFMOD.GE.136.AND.NEFMOD.LE.142)THEN
          INEFMD=2
          MACRO=1
        ELSEIF(NEFMOD.GE.143.AND.NEFMOD.LE.149)THEN
          INEFMD=3
          MACRO=0
        ELSEIF(NEFMOD.GE.158.AND.NEFMOD.LE.164)THEN
          INEFMD=4
          MACRO=0
        ELSEIF(NEFMOD.GE.195.AND.NEFMOD.LE.208)THEN
          INEFMD=1
          MACRO=0
        ELSEIF(NEFMOD.GE.209.AND.NEFMOD.LE.215)THEN
          INEFMD=4
          MACRO=0
        ELSEIF(NEFMOD.GE.216.AND.NEFMOD.LE.236)THEN
          INEFMD=2
          MACRO=1
        ELSEIF(NEFMOD.GE.237.AND.NEFMOD.LE.257)THEN
          INEFMD=3
          MACRO=0
        ELSE
*         Le type d'élément fini ne convient pas
C         Données incompatibles
          CALL ERREUR(21)
          IPOINT=0
          RETURN
        ENDIF
      ELSE
*       la table domaine n'existe pas pour cette partition
*       (donc pour aucune des autres). On va la créer.
*       La discrétisation est la supposée la même pour toutes les
*       partitions.
 
*       Création du maillage, concaténation des sous-maillages pertinents
        NBSOUS = NBMECF
        IF (NBSOUS.EQ.1) THEN
          DO 2 L=1,N1
            IF (LPART(L)) THEN
              IMODEL = KMODEL(L)
              MELEME = IMODEL.IMAMOD
            ENDIF
 2        CONTINUE
        ELSE
          NBREF  = 0
          NBNN   = 0
          NBELEM = 0
          SEGINI MELEME
          K = 0
          DO 3 L=1,N1
            IF (LPART(L)) THEN
              K = K + 1
              IMODEL    = KMODEL(L)
              LISOUS(K) = IMODEL.IMAMOD
            ENDIF
 3        CONTINUE
          SEGDES MELEME
        ENDIF
 
        IMODEL=KMODEL(1)
        IF((FORMOD(1).EQ.'DARCY').OR.(NOMFOR.EQ.'EULER'))THEN
          MACRO=0
          INEFMD=1
        ELSEIF(NEFMOD.GE.129.AND.NEFMOD.LE.135)THEN
          INEFMD=1
          MACRO=0
        ELSEIF(NEFMOD.GE.136.AND.NEFMOD.LE.142)THEN
          INEFMD=2
          MACRO=1
        ELSEIF(NEFMOD.GE.143.AND.NEFMOD.LE.149)THEN
          INEFMD=3
          MACRO=0
        ELSEIF(NEFMOD.GE.158.AND.NEFMOD.LE.164)THEN
          INEFMD=4
          MACRO=0
        ELSEIF(NEFMOD.GE.195.AND.NEFMOD.LE.208)THEN
          INEFMD=1
          MACRO=0
        ELSEIF(NEFMOD.GE.209.AND.NEFMOD.LE.215)THEN
          INEFMD=4
          MACRO=0
        ELSEIF(NEFMOD.GE.216.AND.NEFMOD.LE.236)THEN
          INEFMD=2
          MACRO=1
        ELSEIF(NEFMOD.GE.237.AND.NEFMOD.LE.257)THEN
          INEFMD=3
          MACRO=0
        ELSE
C         Données incompatibles
          CALL ERREUR(21)
          IPOINT=0
          MACRO=0
          RETURN
        ENDIF
 
        TOLER=0.D0
        NOMDOM=' '
 
*       Création table domaine
        IF ((FORMOD(1).EQ.'EULER').OR.(FORMOD(1).EQ.'DARCY'))THEN
        CALL KKDOM2(MELEME,TOLER,NOMDOM,MTABI,MTABD,INEFMD)
        ELSE
        CALL KKDOM(MELEME,MACRO,TOLER,NOMDOM,MTABI,MTABD,INEFMD)
        ENDIF
 
*       On fait pointer toutes les partitions du modèle sur la même
*       table domaine globale.
        DO 1235 L=1,N1
          IF (LPART(L)) THEN
            IMODEL = KMODEL(L)
            SEGACT IMODEL*MOD
            INFMOD(2)=MTABD
          ENDIF
 1235   CONTINUE
 
*       On renvoie le pointeur de la table
        IPOINT=MTABD
      ENDIF
 
*     Fermeture des segments (on laisse tous les segments du modèle
*     ouverts).
      SEGDES TPART
 
      RETURN
C
      END
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales