Télécharger cakizd.eso

Retour à la liste

cakizd
C CAKIZD    SOURCE    GOUNAND   23/07/31    21:15:03     11713          
      SUBROUTINE CAKIZD
C************************************************************************
C   OBJET :
C     Cet operateur construit une table KIZD
C   SYNTAXE
C     kdia RV ;
C************************************************************************
C
C Aout 96 : correction  d'erreurs pour le calcul de la matrice masse
C           diagonale dans le cas d'un CHPO centre sans C.L
C           (testé uniquement dans ce cas : P.Galon)
C
C 26/10/98 : lecture d'une table domaine OU d'un objet modèle
C************************************************************************
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-INC SMCOORD
-INC PPARAM
-INC CCOPTIO
-INC CCREEL
-INC SMTABLE
      POINTEUR MTABD.MTABLE,INCO.MTABLE
      POINTEUR KIZD.MTABLE
C
-INC SMCHPOI
      POINTEUR IPHI.MPOVAL
      POINTEUR IZD.MCHPOI ,IZD0.MCHPOI
      POINTEUR IZDD.MPOVAL,IZDD0.MPOVAL
C
-INC SMLMOTS
      POINTEUR MINCOG.MLMOTS
C
-INC SMELEME
      POINTEUR MELEMI.MELEME
C
-INC SMLENTI
      POINTEUR IZIPAD.MLENTI
C
      PARAMETER (NTB=1)
      DIMENSION   KTAB(NTB)
      CHARACTER*8 LTAB(NTB)
      DATA LTAB/'EQEX    '/
C
      CHARACTER*8 TYPE,TYP0,TYPC
      CHARACTER*(LOCOMP) NOC,NOMCP(9),NOMI,NOM,NOMZ
C
      NTO=1
Cne sert jamais      IAXI=0
Cne sert jamais      IF(IFOMOD.EQ.0)IAXI=2
C
C ---- Lecture de la Table "RV"
C      -----------------------
      CALL LITABS(LTAB,KTAB,NTB,NTO,IRET)
      IF(IRET.EQ.0)RETURN
C
      MTABLE=KTAB(1)
      SEGACT MTABLE
C
C ----- Lecture de la Table DOMINC
C       --------------------------
      TYPE=' '
      CALL ACMO(MTABLE,'DOMINC',TYPE,MDOMC)
      IF(TYPE.NE.'TABLE')THEN
         MOTERR(1:40)='On ne trouve pas DOMINC ds la Table EQEX'
         CALL ERREUR(-301)
         RETURN
      ENDIF
C
C ----- Lecture de la Table INCO
C       ------------------------
      TYPE=' '
      CALL ACMO(MTABLE,'INCO',TYPE,INCO)
      IF(TYPE.NE.'TABLE')THEN
         MOTERR(1:40)='On ne trouve pas INCO ds la Table EQEX  '
         CALL ERREUR(-301)
         RETURN
      ENDIF
C
C ----- Lecture de la liste des inconnues
C       ---------------------------------
      TYPE=' '
      CALL ACMO(MTABLE,'LISTINCO',TYPE,MLMOT2)
      IF(TYPE.NE.'LISTMOTS')THEN
         MOTERR(1:40)='On ne trouve pas LISTINCO dans EQEX     '
         CALL ERREUR(-301)
         RETURN
      ENDIF
C
      SEGACT MLMOT2
      NBINC1=MLMOT2.MOTS(/2)
C
C ----- Lecture du CHPO des conditions limites (facultatif)
C       --------------------------------------
      TYPE=' '
      CALL ACMO(MTABLE,'CLIM',TYPE,MCHPOI)
      IF(TYPE.NE.'CHPOINT')THEN
         KCLIM=0
      ELSE
         KCLIM=1
         SEGACT MCHPOI
         NSOUPO=IPCHP(/1)
      ENDIF
C
C ----- Creation de la Table KIZD
C       -------------------------
      CALL CRTABL(KIZD)
      CALL ECMM(KIZD,'SOUSTYPE','KIZD')
      CALL ECMO(MTABLE,'KIZD','TABLE   ',KIZD)
C
C ----- On Boucle sur la liste des inconnues
C       ====================================
C
C     WRITE(IOIMP,*)' NBINC1=',nbinc1
      SEGACT,MCOORD
      DO 1 L=1,NBINC1
         NOMI=MLMOT2.MOTS(L)
C     WRITE(IOIMP,*)' CAKIZD : NOMI=',nomi
C
C ----- lecture de la table domaine ou de l'objet modèle N-Stokes
C       ---------------------------------------------------------
         TYPE=' '
         CALL ACMO(MDOMC,NOMI,TYPE,MTABD)
*      WRITE(IOIMP,*)' KDIA nomi,type=',nomi,type
         IF(TYPE.NE.'TABLE')THEN
            IF (TYPE.EQ.'MMODEL') THEN
               CALL LEKMOD(MTABD,MTABD2,INEFMD)
               MTABD=MTABD2
            ELSE
               MOTERR(1:40)='On ne trouve pas la Table Domaine       '
               CALL ERREUR(-301)
               RETURN
            ENDIF
         ENDIF
C
C ----- la table sous table INCO contient elle l'inconnue
C       -------------------------------------------------
 
         TYPE=' '
         CALL ACMO(INCO,NOMI,TYPE,MCHPHI)
*      WRITE(IOIMP,*)' KDIA nomi,type=',nomi,type
         IF(TYPE.NE.'CHPOINT ')THEN
            MOTERR(1:40)='L inconnue n est pas dans la Table INCO '
            CALL ERREUR(-301)
            MOTERR(1:40)='ou l inconnue n est pas un Champoint    '
            CALL ERREUR(-301)
            GO TO 1
         ELSE
            CALL LICHT(MCHPHI,IPHI,TYPC,IGEOM)
         ENDIF
C
         NPT=IPHI.VPOCHA(/1)
         NC=IPHI.VPOCHA(/2)
*      WRITE(IOIMP,*)' NPT,NC,TYPC=',NPT,NC,TYPC
         IF(TYPC.EQ.'SOMMET')THEN
C
C -----  On cree une diagonale 'SOMMET'
C        -----------------------------
            CALL ECROBJ('TABLE   ',MTABD)
            SEGACT,MCOORD
            CALL CADGSI
            SEGDES,MCOORD
            CALL LIROBJ('CHPOINT ',IZD0,1,IRET)
            CALL LICHT(IZD0,IZDD0,TYP0,IGEOM0)
         ELSEIF(TYPC.EQ.'CENTRE')THEN
C
C -----  On cree une diagonale 'CENTRE'
C        -----------------------------
            CALL LEKTAB(MTABD,'XXVOLUM',IZD0)
C
            IF(IZD0.EQ.0)RETURN
            CALL LICHT(IZD0,IZDD0,TYP0,IGEOM0)
         ELSE
            MOTERR(1:40)='CHPO CENTRE ou SOMMET pour l inconnue   '
            CALL ERREUR(-301)
            RETURN
         ENDIF
C
C -----  Creation des CHPO de la Table KIZD
C        ----------------------------------
         TYPE=' '
         CALL ACMO(KIZD,NOMI,TYPE,IZD)
C
         IF(TYPE.NE.'CHPOINT ')THEN
            IF(NC.EQ.1)THEN
               NOMCP(1)=NOMI
               CALL KRCHPT(TYP0,IGEOM0,NC,IZD,NOMCP)
            ELSE
               DO 15 I=1,NC
                  WRITE(NOMCP(I),FMT='(I1)')I
                  NOMCP(I)=NOMCP(I)(1:1)//NOMI(1:LOCOMP-1)
 15            CONTINUE
               CALL KRCHPT(TYP0,IGEOM0,NC,IZD,NOMCP)
            ENDIF
            CALL LICHT(IZD,IZDD,TYPC,IGEOM)
C
            DO 2 I=1,NC
               CALL RSETD(IZDD.VPOCHA(1,I),IZDD0.VPOCHA,NPT)
 2          CONTINUE
C
            CALL ECMO(KIZD,NOMI,'CHPOINT ',IZD)
         ELSE
            CALL LICHT(IZD,IZDD,TYPC,IGEOM)
         ENDIF
C
         CALL KRIPAD(IGEOM,IZIPAD)
C
C ----- Boucle sur les composantes du Champoint
C       =======================================
         DO 3 I=1,NC
            IF(NC.EQ.1)THEN
               NOC=NOMI
            ELSE
               WRITE(NOC,FMT='(I1)')I
               NOC=NOC(1:1)//NOMI(1:LOCOMP-1)
            ENDIF
C
C ---- Si pas de condition limite on ne fait rien de plus
C      --------------------------------------------------
            IF(KCLIM.EQ.0)GO TO 3
C     Grande valeur de penalisation mais pas trop grande car sinon on
C     peut depasser la valeur max.
 
            XBIG=SQRT(XGRAND)
            DO 10111 NSP=1,NSOUPO
C
               MSOUPO=IPCHP(NSP)
               SEGACT MSOUPO
               NCOMP=NOCOMP(/2)
C
               DO 10112 NCP=1,NCOMP
                  IF(NOCOMP(NCP).EQ.NOC)THEN
                     MELEMI=IGEOC
                     SEGACT MELEMI
                     LONG=MELEMI.NUM(/2)
                     CALL VERPAD(IZIPAD,MELEMI,IRET)
                     IF(IRET.NE.0)THEN
                        MOTERR(1:40)
     $                       ='C.Limites non incluses dans le domaine  '
                        CALL ERREUR(-301)
                        RETURN
                     ENDIF
                     CALL RSETX1
     &                    (IZDD.VPOCHA(1,I),MELEMI.NUM,LONG,XBIG
     $                    ,IZIPAD.LECT)
                  ENDIF
10112          CONTINUE
C
10111       CONTINUE
C
 3       CONTINUE
C
         SEGSUP IZIPAD
 1    CONTINUE
      SEGDES,MCOORD
C
C ----  FIN DE LA BOUCLE SUR LES INCONNUES
C       ----------------------------------
      SEGDES KIZD,INCO
      SEGDES MTABLE
      END
 
 

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