Télécharger laplvf.eso

Retour à la liste

laplvf
C LAPLVF    SOURCE    CB215821  20/11/25    13:33:25     10792          
      SUBROUTINE LAPLVF(PKIZX)
C------------------------------------------------------------
C------------------------------------------------------------
C
C--------------------------
C Paramètre Entrée/Sortie :
C--------------------------
C E/  PDOMA  : TABLE de sous-type DOMAINE
C E/  PKIZX  : TABLE de sous-type KIZX
C E/  KIMPL  : Indicateur précisant l'intégration en temps
C
C------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C
 
-INC PPARAM
-INC CCOPTIO
-INC SMLMOTS
-INC SMLENTI
-INC SMCHPOI
-INC SMCHAML
-INC SMELEME
-INC SMMATRIK
-INC SMTABLE
C
      POINTEUR MELEMC.MELEME, MELEMF.MELEME, MELEFE.MELEME
      POINTEUR MELEMA.MELEME, MELEMP.MELEME
      POINTEUR PKIZX.MTABLE , PINCO.TABLE  , PDOMA.MTABLE, PEQEX.TABLE
      POINTEUR IPADC.MLENTI,IPADF.MLENTI
      CHARACTER*8 NOMI, NOMA, NOM
      CHARACTER*8 TYPE, TYPC
      DIMENSION IXV(3)
C
C- Récupération de la table EQEX
C
      CALL LEKTAB(PKIZX,'EQEX',PEQEX)
      IF (PEQEX.EQ.0) THEN
C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24
         MOTERR( 1: 8) = '  EQEX  '
         MOTERR( 9:16) = '  EQEX  '
         MOTERR(17:24) = '  KIZX  '
         CALL ERREUR(786)
         RETURN
      ENDIF
C
C- Récupération de la table INCO
C
      CALL LEKTAB(PEQEX,'INCO',PINCO)
      IF (PINCO.EQ.0) THEN
C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24
         MOTERR( 1: 8) = '  INCO  '
         MOTERR( 9:16) = '  INCO  '
         MOTERR(17:24) = '  KIZX  '
         CALL ERREUR(786)
         RETURN
      ENDIF
C
C- Récupération de la table DOMAINE
C
      CALL LEKTAB(PKIZX,'DOMZ',PDOMA)
      IF(PDOMA.EQ.0)  THEN
C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24
         MOTERR( 1: 8) = '  DOMZ  '
         MOTERR( 9:16) = '  DOMZ  '
         MOTERR(17:24) = '  KIZX  '
         CALL ERREUR(786)
         RETURN
      ENDIF
C
C- Récupération de la table KOPT
C
      CALL LEKTAB(PKIZX,'KOPT',KOPTI)
      IF (KOPTI.EQ.0) THEN
C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24
         MOTERR( 1: 8) = '  EQEX  '
         MOTERR( 9:16) = '  EQEX  '
         MOTERR(17:24) = '  KIZX  '
         CALL ERREUR(786)
         RETURN
      ELSE
         CALL ACME(KOPTI,'KIMPL',KIMPL)
         IF (IERR.NE.0) RETURN
         CALL ACME(KOPTI,'KFORM',KFORM)
         IF (IERR.NE.0) RETURN
      ENDIF
      IF (KIMPL.NE.1) THEN
C        Tentative d'utilisation d'une option non implémentée
         CALL ERREUR(251)
         RETURN
      ENDIF
C
C- Récupérations des informations de la table DOMAINE
C
      CALL LEKTAB(PDOMA,'CENTRE'  ,MELEMC)
      CALL LEKTAB(PDOMA,'FACE'    ,MELEMF)
      CALL LEKTAB(PDOMA,'XXSURFAC',MCHPO1)
      CALL LEKTAB(PDOMA,'XXNORMAF',MCHPO2)
      CALL LEKTAB(PDOMA,'FACEL'   ,MELEFE)
      CALL LEKTAB(PDOMA,'ELTFA'   ,MELEMA)
      CALL LEKTAB(PDOMA,'XXNORMAE',MCHEL1)
      IF (IERR.NE.0) RETURN
C
      SEGACT MELEMA
      NBSOUS = MELEMA.LISOUS(/1)
      NBNN   = MELEMA.NUM(/1)
      NBELEM = MELEMA.NUM(/2)
      NBREF  = MELEMA.LISREF(/1)
      IF (NBSOUS.EQ.0) NBSOUS=1
      NBPART = NBSOUS
C
C- Lecture de la viscosité
C
      IXV(1) = MELEMC
      IXV(2) = 1
      IXV(3) = 0
      IRET   = 0
      CALL LEKCOF('OPERATEUR LAPN :',
     &            PKIZX,PINCO,1,IXV,MCHPO3,MPOVA3,NPT3,NC3,IK3,IRET)
      IF (IRET.EQ.0) RETURN
C
C- Récupération du nom de l'inconnue
C
      TYPE='LISTMOTS'
      CALL ACMO(PKIZX,'LISTINCO',TYPE,MLMOTS)
      SEGACT MLMOTS
      NBINC = MOTS(/2)
      NOMI  = MOTS(1)
      NOMA  = NOMI
      IF (NBINC.EQ.2) NOMA=MOTS(2)
      SEGDES MLMOTS
C
C- Récupération de l'inconnue duale
C
      TYPE = ' '
      CALL ACMO(PINCO,NOMA,TYPE,MCHPOI)
      IF (TYPE.NE.'CHPOINT ') THEN
C        Indice %m1:8 : ne contient pas un objet de type %m9:16
         MOTERR( 1: 8) = 'INC '//NOMA
         MOTERR( 9:16) = 'CHPOINT '
         CALL ERREUR(800)
         RETURN
      ELSE
         CALL LICHT(MCHPOI,MPOVAL,TYPC,MELEME)
         NINKO = VPOCHA(/2)
         IF (NINKO.NE.1.AND.NINKO.NE.IDIM) THEN
C        Indice %m1:8 : Le %m9:16 n'a pas le bon nombre de composantes
            MOTERR( 1: 8) = 'INC '//NOMA
            MOTERR( 9:16) = 'CHPOINT '
            CALL ERREUR(784)
            RETURN
         ENDIF
      ENDIF
C
C- Vérification de la compatibilité des supports
C
      CALL KRIPAD(MELEME,MLENT1)
      CALL VERPAD(MLENT1,MELEMC,IRET)
      IF (IRET.NE.0) THEN
C     Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
         MOTERR( 1: 8) = 'INC '//NOMA
         MOTERR( 9:16) = 'CHPOINT '
         CALL ERREUR(784)
      ENDIF
      SEGSUP MLENT1
C
C --------------------------------------------
C TRAITEMENT DU SEGMENT DE STOKAGE MATRIK
C DE LA MATRICE ELEMENTAIRE.
C --------------------------------------------
C
      NRIGE  = 7
      NMATRI = 1
      NKID   = 9
      NKMT   = 7
      SEGINI MATRIK
      NBME   = NINKO
      NBSOUS = NBPART
      SEGINI IMATRI
      IRIGEL(4,1) = IMATRI
      IRIGEL(7,1) = 0
      KSPGP = MELEMC
      KSPGD = MELEMC
      IF (NBME.EQ.1) THEN
         LISPRI(1)=NOMI(1:4)//'    '
         LISDUA(1)=NOMA(1:4)//'    '
      ELSE
         DO I=1,NBME
            WRITE(NOM,FMT='(I1,A7)')I,NOMI(1:7)
            LISPRI(I)=NOM(1:4)//'    '
            WRITE(NOM,FMT='(I1,A7)')I,NOMA(1:7)
            LISDUA(I)=NOM(1:4)//'    '
         ENDDO
      ENDIF
C
C- Création des connectivités entre inconnues primales
C
      IF (NBPART.GT.1) THEN
         NBNN    = 0
         NBELEM  = 0
         NBSOUS  = NBPART
         NBREF   = 0
      ENDIF
      SEGINI MELEMP
C
C- Construction des matrices élémentaires associées à chaque LISOUS
C
C  NUTOEL : Nombre d'éléments déjà traité
C
      NUTOEL= 0
      CALL KRIPAD(MELEMF,IPADF)
      CALL KRIPAD(MELEMC,IPADC)
      SEGACT MELEMC,MELEMF,MELEFE,MELEMA
      CALL LICHT(MCHPO1,MPOVA1,TYPC,MELEME)
      CALL LICHT(MCHPO2,MPOVA2,TYPC,MELEME)
      SEGACT MCHEL1
      DO L=1,NBPART
         IPT1= MELEMA
         IF (NBSOUS.GT.1) THEN
            IPT1= MELEMA.LISOUS(L)
         ENDIF
         SEGACT IPT1
         NBEL   = IPT1.NUM(/2)
         MCHAM1 = MCHEL1.ICHAML(L)
         SEGACT MCHAM1
         MELVA1 = MCHAM1.IELVAL(1)
         SEGACT MELVA1
         CALL LAPVF2(MPOVA1,MPOVA2,MPOVA3,IK3,MELEMC,MELEMF,MELEFE,
     &               IPT1,MELVA1,IPADF,IPADC,L,NUTOEL,
     &               MATRIK,IMATRI,MELEMP)
         SEGDES MELVA1
         SEGDES MCHAM1
         SEGDES IPT1
         NUTOEL = NUTOEL + NBEL
      ENDDO
      SEGDES MCHEL1
      CALL ECMO(PKIZX,'MATELM','MATRIK',MATRIK)
C
C- Ménage
C
      SEGSUP IPADF,IPADC
      SEGDES MATRIK,IMATRI
      SEGDES MPOVA1,MPOVA2,MPOVA3
      SEGDES MELEMC,MELEMF,MELEFE
      IF (NBSOUS.EQ.1) SEGDES MELEMA
C
      RETURN
      END
 
 
 
 
 
 
 
 
 
 
 
 

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