Télécharger kcha1.eso

Retour à la liste

kcha1
C KCHA1     SOURCE    PV090527  25/01/07    14:42:46     12115          
      SUBROUTINE KCHA1(MTRAV,IPGEOM,IPRESU)
C-----------------------------------------------------------------------
C Transforme un CHPO de support CENTRE en un MCHAML constant par élément
C Le maillage IPGEOM est le maillage à partir duquel les points CENTRE
C sont créés (verification faite dans kcha.eso).
C-----------------------------------------------------------------------
C
C---------------------------
C Paramètres Entrée/Sortie :
C---------------------------
C
C E/  MTRAV   : Segment de travail du CHPO de support centre.
C               Les valeurs du ième point de MTRAV sont
C               à affecter au ième élément de IPGEOM.
C E/  IPGEOM  : Support du MCHAML
C  /S IPRESU  : Contient le MCHAML résultat de support IPGEOM
C
C----------------------
C Variables en COMMON :
C----------------------
C
C E/  IFOUR   : cf CCOPTIO
C E/  NIFOUR  : cf CCOPTIO
C
C-----------------------------------------------------------------------
C
C Langage : ESOPE + FORTRAN77
C
C Auteurs :  F.DABBENE
C
C-----------------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C
 
-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
-INC SMCHAML
-INC SMCHPOI
-INC SMELEME
-INC TMTRAV
C
C- Initialisations
C
      IELEM  = 0
      ISTOP  = 0
      MELEME = IPGEOM
      SEGACT MELEME
      NBSOUS = LISOUS(/1)
      IF (NBSOUS.EQ.0) NBSOUS=1
C
C - Création du MCHELM
C
C - Récupération du nombre total de composantes dans MTRAV
C - Approximation d'une seule harmonique.
C
      SEGACT MTRAV
      NNIN = IBIN(/1)
C
C - Création par zone élémentaire
C
      L1 = 8
      N1 = NBSOUS
      N3 = 6
      SEGINI MCHELM
      IPRESU = MCHELM
      TITCHE = 'SCALAIRE'
      IFOCHE = IFOUR
      IF (NBSOUS.EQ.1) THEN
         NBNN = NUM(/1)
         MELE = ITYPEL
         IELE = NUMGEO(MELE)
         IMACHE(1) = MELEME
         N2        = NNIN
         SEGINI MCHAML
         DO 5 ICOMP=1,NNIN
            NOMCHE(ICOMP) = INCO(ICOMP)
 5       CONTINUE
         ICHAML(1) = MCHAML
         CONCHE(1) = '                '
         INFCHE(1,1) = 0
         INFCHE(1,2) = 0
         INFCHE(1,3) = NIFOUR
         ISTOP       = ISTOP + 1
         CALL RESHPT(1,NBNN,IELE,MELE,0,MINTE,IRT1)
         IF (IRT1.EQ.0) GOTO 100
         INFCHE(1,4) = MINTE
         INFCHE(1,5) = 0
         INFCHE(1,6) = 2
         SEGACT MCHAML
      ELSE
         IPOS = 0
         DO 10 I=1,NBSOUS
             IPT1   = LISOUS(I)
             SEGACT IPT1
             NBNN   = IPT1.NUM(/1)
             NBELEM = IPT1.NUM(/2)
             MELE   = IPT1.ITYPEL
             IELE   = NUMGEO(MELE)
             IMACHE(I) = IPT1
             SEGACT IPT1
             CONCHE(I) = '                '
             N2     = NNIN
             SEGINI MCHAML
C - Recherche du nombre de composantes réellement dans la zone :
C   On ne conserve que les composantes ayant une valeur pour au moins un
C   point du sous-maillage
             IN2 = 0
             DO 20 ICOMP=1,NNIN
                DO 30 NEL=1,NBELEM
                   IF (IBIN(ICOMP,IPOS+NEL).EQ.1) THEN
                      IN2 = IN2 + 1
                      NOMCHE(IN2) = INCO(ICOMP)
                      GOTO 20
                   ENDIF
 30             CONTINUE
 20          CONTINUE
C            On ajuste la taille du MCHAML au nouveau nombre de composantes
             N2 = IN2
             SEGADJ MCHAML
             ICHAML(I) = MCHAML
             INFCHE(I,1) = 0
             INFCHE(I,2) = 0
             INFCHE(I,3) = NIFOUR
             ISTOP       = ISTOP + 1
             CALL RESHPT(1,NBNN,IELE,MELE,0,MINTE,IRT1)
             IF (IRT1.EQ.0) GOTO 100
             INFCHE(I,4) = MINTE
             INFCHE(I,5) = 0
             INFCHE(I,6) = 2
             SEGACT MCHAML
             IPOS = IPOS + NBELEM
 10      CONTINUE
      ENDIF
      SEGACT MELEME
C
C- Remplissage du MCHAML et du MELVAL de chaque sous zone
C
      DO 40 I=1,NBSOUS
         MELEME  = IMACHE(I)
         MCHAML  = ICHAML(I)
         SEGACT MELEME
         SEGACT MCHAML*MOD
         N2      = NOMCHE(/2)
         N1PTEL  = 1
         N1EL    = MELEME.NUM(/2)
         N2PTEL  = 0
         N2EL    = 0
 
         DO 50 ICOMP=1,N2
            SEGINI MELVAL
            TYPCHE(ICOMP) = 'REAL*8'
            IELVAL(ICOMP) = MELVAL
            IF (NBSOUS.EQ.1) THEN
               IPOS = ICOMP
            ELSE
               CALL PLACE(INCO,NNIN,IPOS,NOMCHE(ICOMP))
            ENDIF
            IPOS1 = IELEM
            DO 60 NEL=1,N1EL
               IPOS1 = IPOS1 + 1
               VELCHE(1,NEL) = BB(IPOS,IPOS1)
 60         CONTINUE
            SEGACT MELVAL
 50      CONTINUE
         SEGACT MCHAML
         SEGACT MELEME
         IELEM  = IELEM + N1EL
 40   CONTINUE
      SEGACT MCHELM
      SEGSUP MTRAV
      RETURN
C
C- Ménage en cas d'erreur
C
 100  CONTINUE
      SEGACT MCHAML
      SEGACT MCHELM
      SEGACT MELEME
      IPRESU = 0
C
      RETURN
      END
 
 
 
 
 
 
 

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