Télécharger toconv.eso

Retour à la liste

toconv
C TOCONV    SOURCE    CB215821  20/11/25    13:41:07     10792          
      SUBROUTINE TOCONV (IPTAB1)
C
C***********************************************************************
C
C
C FONCTION:
C ---------
C
C     en "0D/1D" sur des éléments de type POINT.
C
C
C ENTREE :
C -------
C
C     TAB1            : TABLE de pointeur IPTAB1 (soustype 'OPER_0D')
C                       contenant les indices suivants :
C
C     TAB1 . 'GEOINF' : TABLE des informations géométriques de soustype
C                       'GEOINF' (type ENTIER).
C     TAB1 . 'INCO'   : TABLE de soustype 'INCO' contenant l'ensemble
C                       des champs à l'itération précédant l'itération
C                       courante (type ENTIER).
C     TAB1 . 'MULT1'  : Valeurs du champ multiplicateur (type CHPOINT ou
C                       MOT) (de support 'CELL')
C     TAB1 . 'FLUX'   : Nom de la composante débit de masse (type MOT)
C                       (doit être un indice de la table 'INCO').
C                       (de support 'JUNCTION' ou 'JULIQ')
C     TAB1 . 'OPTION' : Traitement centré ou décentré de l'opération
C                       (type MOT = 'CENTRE' ou 'DECENTRE')
C     TAB1 . 'DUAL'   : Nom de l'inconnue duale (doit être un indice de
C                       la table de soustype 'INCO') (type MOT).
C                       (de support 'CELL')
C    (TAB1 . 'PRIMAL'): Nom de l'inconnue primale (doit être un indice
C                       de la table de soustype 'INCO')
C                       (type MOT) (indice facultatif).
C                       (de support 'CELL')
C
C
C RESULTAT :
C ---------
C
C     TAB1 . 'LHS' : Matrice élémentaire associée à l'opération
C                       (type RIGIDITE).
C
C AUTEUR, DATE DE CREATION:
C -------------------------
C
C     Laurent DADA      décembre 1996
C
C
C LANGAGE:
C --------
C
C     ESOPE + FORTRAN77
C
C
C SUBROUTINES APPELEES :
C ---------------------
C
C     TCONVC, TCONVD
C
C***********************************************************************
C
C  Variables internes :
C  -------------------
C
C  MPOVA1 : pointeur sur MPOVAL du CHPO MULT1
C  MPOVA2 : pointeur sur MPOVAL du CHPO FLUX
C  IPTJUN : pointeur sur maillage JUNCTION ou JULIQ
C  IPTD1  : pointeur sur maillage DUAL
C  IPTP1  : pointeur sur maillage PRIMAL
C  IPJUCE : pointeur sur maillage des connectivités JUNCTION/CELL
C  NOMDU1 : nom de l'inconnue DUAL
C  NOMPR1 : nom de l'inconnue PRIMAL
C  NOMFL1 : nom de l'inconnue FLUX
C
C***********************************************************************
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C
 
-INC PPARAM
-INC CCOPTIO
-INC SMTABLE
-INC SMCHPOI
-INC SMELEME
      POINTEUR IPTD1.MELEME,IPTJUN.MELEME,IPJUCE.MELEME
-INC SMRIGID
 
C
      CHARACTER*8 TYPE,MOTI,MOT1,NOMPR1,NOMDU1,NOSUP1,NOSUD1,NOMMU1
      CHARACTER*8 NOMFL1,NOSUF1,NOOPT1,JCEL
      LOGICAL     LPRIMA
C
C Lecture de la table GEOINF dans la table OPER_0D
C
      TYPE = 'TABLE   '
      CALL ACMO (IPTAB1,'GEOINF',TYPE,IPTABG)
      IF (IERR.NE.0) RETURN
C
      MOTI = 'SOUSTYPE'
      CALL ACMM (IPTABG,MOTI,MOT1)
      IF (IERR.NE.0) RETURN
      IF (MOT1(1:6).NE.'GEOINF') THEN
        MOTERR(1:8)  = 'GEOINF  '
        MOTERR(9:16) = 'GEOINF  '
        CALL ERREUR (790)
        RETURN
      ENDIF
C
C Lecture de la table INCO dans la table OPER_0D
C
      TYPE = 'TABLE   '
      CALL ACMO (IPTAB1,'INCO',TYPE,IPTAB2)
      IF (IERR.NE.0) RETURN
C
      MOTI = 'SOUSTYPE'
      CALL ACMM (IPTAB2,MOTI,MOT1)
      IF (IERR.NE.0) RETURN
      IF (MOT1(1:4).NE.'INCO') THEN
        MOTERR(1:8)  = 'INCO    '
        MOTERR(9:16) = 'INCO    '
        CALL ERREUR (790)
        RETURN
      ENDIF
C
C Lecture de la table SUPPORT dans la table INCO
C
      TYPE = 'TABLE   '
      CALL ACMO (IPTAB2,'SUPPORT',TYPE,IPTABS)
      IF (IERR.NE.0) RETURN
C
C Récupération du CHPOINT multiplicateur
C
      TYPE = '        '
      CALL ACMO (IPTAB1,'MULT1',TYPE,IPR1)
      IF (IERR.NE.0) RETURN
      IF (TYPE.EQ.'MOT     ') THEN
        CALL ACMM (IPTAB1,'MULT1',NOMMU1)
        IF (IERR.NE.0) RETURN
C récupération du CHPOINT multiplicateur dans la table INCO
        TYPE = 'CHPOINT '
        CALL ACMO (IPTAB2,NOMMU1,TYPE,IPCH1)
        IF (IERR.NE.0) RETURN
      ELSEIF (TYPE.EQ.'CHPOINT ') THEN
        IPCH1 = IPR1
      ELSE
        MOTERR(1:8)  = 'MULT1   '
        MOTERR(9:16) = TYPE
        CALL ERREUR (787)
        RETURN
      ENDIF
C
C Test du CHPOINT multiplicateur
C
      MCHPOI = IPCH1
      SEGACT MCHPOI
      MSOUPO = IPCHP(1)
      SEGDES MCHPOI
      SEGACT MSOUPO
      NC = NOHARM(/1)
      IF (NC.NE.1) THEN
        MOTERR(1:8)  = 'MULT1   '
        MOTERR(9:16) = 'CHPOINT '
        CALL ERREUR (784)
        SEGDES MSOUPO
        RETURN
      ENDIF
      IPT1   = IGEOC
      MPOVA1 = IPOVAL
      SEGDES MSOUPO
C
C Lecture de la composante FLUX
C
      TYPE = '        '
      CALL ACMO (IPTAB1,'FLUX',TYPE,IFLU1)
      IF (TYPE.EQ.'MOT     ') THEN
        CALL ACMM (IPTAB1,'FLUX',NOMFL1)
        IF (IERR.NE.0) RETURN
      ELSE
        MOTERR(1:8)  = 'FLUX    '
        MOTERR(9:16) = TYPE
        CALL ERREUR (787)
        RETURN
      ENDIF
C
C Lecture de l'inconnue DUAL
C
      TYPE = '        '
      CALL ACMO (IPTAB1,'DUAL',TYPE,IDU1)
      IF (TYPE.EQ.'MOT     ') THEN
        CALL ACMM (IPTAB1,'DUAL',NOMDU1)
        IF (IERR.NE.0) RETURN
      ELSE
        MOTERR(1:8)  = 'DUAL    '
        MOTERR(9:16) = TYPE
        CALL ERREUR (787)
        RETURN
      ENDIF
C
C Lecture éventuelle de l'inconnue PRIMAL
C
      NOMPR1 = ' '
      LPRIMA = .FALSE.
      TYPE = '        '
      CALL ACMO (IPTAB1,'PRIMAL',TYPE,IPR1)
      IF (TYPE.EQ.'MOT     ') THEN
        LPRIMA = .TRUE.
        CALL ACMM (IPTAB1,'PRIMAL',NOMPR1)
        IF (IERR.NE.0) RETURN
      ENDIF
C
C Lecture du nom du support de la composante FLUX
C Arrêt si différent de 'JUNCTION' ou de 'JULIQ'
C Lecture du MAILLAGE de l'inconnue FLUX
C Lecture des valeurs CHPOINT de composante FLUX
C
      CALL ACMM (IPTABS,NOMFL1,NOSUF1)
      IF (IERR.NE.0) RETURN
      IF (NOSUF1.EQ.'JUNCTION') THEN
         JCEL = 'JUNCEL  '
      ELSEIF (NOSUF1.EQ.'JULIQ   ') THEN
         JCEL = 'JULCEL  '
      ELSE
        MOTERR(1:8)  = 'FLUX    '
        MOTERR(9:16) = 'CHPOINT '
        CALL ERREUR (788)
        RETURN
      ENDIF
C
C      TYPE = 'MAILLAGE'
C      CALL ACMO (IPTABG,NOSUF1,TYPE,IPTJUN)
C      IF (IERR.NE.0) RETURN
C
      TYPE = 'CHPOINT '
      CALL ACMO (IPTAB2,NOMFL1,TYPE,IPCH2)
      IF (IERR.NE.0) RETURN
      MCHPOI = IPCH2
      SEGACT MCHPOI
      MSOUPO = IPCHP(1)
      SEGDES MCHPOI
      SEGACT MSOUPO
      IPTJUN = IGEOC
      MPOVA2 = IPOVAL
      SEGDES MSOUPO
C
C Lecture du nom du support de l'inconnue DUAL
C Lecture du MAILLAGE de l'inconnue DUAL
C
      CALL ACMM (IPTABS,NOMDU1,NOSUD1)
      IF (IERR.NE.0) RETURN
C
      TYPE = 'MAILLAGE'
      CALL ACMO (IPTABG,NOSUD1,TYPE,IPTD1)
      IF (IERR.NE.0) RETURN
C
C Lecture éventuelle du nom du support de l'inconnue PRIMAL
C
      NOSUP1 = ' '
      IF (LPRIMA) THEN
        CALL ACMM (IPTABS,NOMPR1,NOSUP1)
        IF (IERR.NE.0) RETURN
C
        TYPE = 'MAILLAGE'
        CALL ACMO (IPTABG,NOSUP1,TYPE,IPTP1)
        IF (IERR.NE.0) RETURN
      ENDIF
C
C Lecture du MAILLAGE des connectivités JCEL de la table GEOINF
C Arrêt si les éléments ne sont pas des SEG3
C
      TYPE = 'MAILLAGE'
      CALL ACMO (IPTABG,JCEL,TYPE,IPJUCE)
      IF (IERR.NE.0) RETURN
      SEGACT IPJUCE
      IF ((IPJUCE.ITYPEL).NE.3) THEN
        MOTERR(1:8)  = JCEL(1:8)
        MOTERR(9:16) = 'MAILLAGE'
        CALL ERREUR (787)
        SEGDES IPJUCE
        RETURN
      ENDIF
      SEGDES IPJUCE
C
C Lecture de l'option centrée ou décentrée
C
      TYPE = '        '
      CALL ACMO (IPTAB1,'OPTION',TYPE,IOP1)
      IF (TYPE.EQ.'MOT     ') THEN
        CALL ACMM (IPTAB1,'OPTION',NOOPT1)
        IF (IERR.NE.0) RETURN
      ELSE
        MOTERR(1:8)  = 'OPTION  '
        MOTERR(9:16) = TYPE
        CALL ERREUR (787)
        RETURN
      ENDIF
C
C Calcul de la RIGIDITE
C
      IF (NOOPT1.EQ.'CENTRE') THEN
        CALL TCONVC (MRIGID,LPRIMA,IPTD1,NOMPR1,NOMDU1,IPJUCE,
     &               MPOVA1,IPT1,IPTP1,MPOVA2,NOMFL1,IPTJUN,
     &               NOSUP1,NOSUD1)
      ELSEIF (NOOPT1.EQ.'DECENTRE') THEN
C Arrêt si supports DUAL et PRIMAL différents de 'CELL'
        IF (NOSUD1.NE.'CELL') THEN
          MOTERR(1:8)  = 'DUAL    '
          MOTERR(9:16) = 'CHPOINT '
          CALL ERREUR (788)
          RETURN
        ENDIF
        IF (LPRIMA) THEN
          IF (NOSUP1.NE.'CELL') THEN
            MOTERR(1:8)  = 'PRIMAL  '
            MOTERR(9:16) = 'CHPOINT '
            CALL ERREUR (788)
            RETURN
          ENDIF
        ENDIF
C
        CALL TCONVD (MRIGID,IPTD1,LPRIMA,NOMPR1,NOMDU1,IPJUCE,MPOVA1,
     &IPT1,IPTJUN,MPOVA2)
      ELSE
        MOTERR(1:8)  = 'OPTION  '
        MOTERR(9:16) = NOOPT1
        CALL ERREUR (787)
        RETURN
      ENDIF
C
C Ecriture du résultat
C
      TYPE = 'RIGIDITE'
      CALL ECMO (IPTAB1,'LHS',TYPE,MRIGID)
      IF (IERR.NE.0) RETURN
C
      END
 
 
 
 
 
 
 
 
 
 
 

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