Télécharger ffmcha.eso

Retour à la liste

ffmcha
C FFMCHA    SOURCE    OF166741  24/10/03    21:15:14     12022          
C
C_________________________________________________________________
C    NOM       :   InterFace  Matrice->CHAmp par éléments
C_________________________________________________________________
C    OBJET     :
C               INTERFACE INTERVENANT EN THERMIQUE (RAYONNEMENT)
C_________________________________________________________________
C    FONCTION  :
C               PERMET DE PASSER D'UN MODELE (+ segment INFOEL)
C               ET DE LA MATRICE CONTENANT LES FACTEURS DE FORME
C               AU CHAMELEME CORRESPONDANT
C_________________________________________________________________
C    OPERANDES :
C
C    en entrée :
C    MYMOD  (MMODEL)   MODELE SUR LEQUEL REPOSE MATR
C    INFOEL            INFORMATIONS SUR LE TYPE DES ELEMENTS
C            !!!!!     si on ne doit pas tenir compte du cas des
C                      éléments COQ , ce pointeur doit être mis à 0 .
C    MATR   (IFACFO)   MATRICE CONTENANT LES FACTEURS DE FORME
C                      OU LA MATRICE DE RAYONNEMENT
C            !!!!!     chaque élément COQ donne lieu à 2 fois plus
C                      de facteurs de forme qu'un élément normal .
C                      de facteurs de forme qu'un élément normal .
C    LTITR             entier definissant le titre du MCHAML
C                          'FACTEURS DE FORME     '
C                      ou  'MATRICE DE RAYONNEMENT'
C    en sortie :
C    ICHFAC (MCHELM)   CHAMELEM CONTENANT LES FACTEURS DE FORME
C
C_________________________________________________________________
C
      SUBROUTINE FFMCHA(MYMOD,INFOEL,MATR,ICHFAC,LTITR)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
 
-INC SMCHAML
      POINTEUR ICHFAC.MCHELM,ICPEL.MCHELM
      POINTEUR MELVA7.MELVAL
-INC SMELEME
      POINTEUR ISSM.MELEME
-INC SMMODEL
      POINTEUR MYMOD.MMODEL
C       ___________________________________________________________
C       FACTEURS DE FORME   stockage sous forme matricielle
C           NNBEL1 = NOMBRE DE LIGNES + 1
C           NBEL2  = NOMBRE DE COLONNES
C       LFACT(NNBEL1) POINTE SUR LE TABLEAU DES SURFACES
C
      SEGMENT IFACFO
        INTEGER   LFACT(NNBEL1)
      ENDSEGMENT
      SEGMENT LFAC
        REAL*8    FACT(NBEL2)
      ENDSEGMENT
C
      POINTEUR PSUR.LFAC, PLIG.LFAC, PLIGI.LFAC, PLIGS.LFAC
      POINTEUR MATR.IFACFO
C       ___________________________________________________________
C       Stockage d'informations concernant le type des éléments des maillages
      SEGMENT,INFOEL
        LOGICAL KCOQ(N1),KQUAD(N1)
      ENDSEGMENT
C       ___________________________________________________________
C
      LOGICAL  ICOQ
      LOGICAL  LTEST1, LTEST2, LTEST3
C_________________________________________________________________
C
C   STRUCTURE DU CHAMELEM
C
C       MELVA3 : segment MELVAL , surface
C       -----1 : segment -----L   partie haute du CHAMELEM
C       -----4 : segment -----L   partie haute du CHAMELEM
C
C   CAS DES ELEMENTS COQ pour la partie haute
C       -- Partie 'haute' du CHAMELEM : boucle A --
C       MELVA1 : segment MELVAL , côté SUPE
C       MELVA2 : segment MELVAL , côté INFE
C       -- Partie 'basse' du CHAMELEM : boucle B --
C       MCHEL4 : segment MCHELM , côté SUPE
C       MCHEL5 : segment MCHELM , côté INFE
C       MCHAM4 : segment MCHAML , côté SUPE
C       MCHAM5 : segment MCHAML , côté INFE
C          CAS DES ÉLÉMENTS COQ pour la partie basse
C            MELVA4 : segment MELVAL , côté SUPE , relié à MCHAM4
C            MELVA5 : segment MELVAL , côté INFE , relié à MCHAM4
C            MELVA6 : segment MELVAL , côté SUPE , relié à MCHAM5
C            MELVA7 : segment MELVAL , côté INFE , relié à MCHAM5
C          sinon
C            MELVA4 : segment MELVAL , relié à MCHAM4
C            MELVA6 : segment MELVAL , relié à MCHAM5
C          -----
C_________________________________________________________________
C
C   NOTATIONS :
C
C       eA : élément de la boucle A (partie haute)
C       eB : élément de la boucle B (partie basse )
C       eA+,eB+ : côté SUPE de l'élément
C       eA-,eB- : côté INFE de l'élément
C_________________________________________________________________
C
      IF(IIMPI.GE.2) THEN
        WRITE (6,*) 'On est dans ffmcha'
      ENDIF
C
      IF (INFOEL.EQ.0) THEN
         ICOQ = .FALSE.
      ELSE
         ICOQ = .TRUE.
      ENDIF
C
C       On construit l'information maillage du CHAMELEM
      L1 = 22
      N3 = 6
      N1 = MYMOD.KMODEL(/1)
      IF (N1.EQ.0) THEN
        CALL ERREUR(21)
        RETURN
      ENDIF
C
      SEGINI,ICPEL
 
C       IF (LTITR.EQ.1) THEN
C        ICPEL.TITCHE = 'FACTEURS DE FORME     '
C       ELSE
         ICPEL.TITCHE = 'MATRICE DE RAYONNEMENT'
C       ENDIF
 
        IF (IFOMOD.NE.0) THEN
           IF (IDIM.EQ.3) THEN
              ICPEL.IFOCHE = 2
           ELSE
              ICPEL.IFOCHE = -1
           ENDIF
        ELSE
              ICPEL.IFOCHE = 0
        ENDIF
        DO I=1,N1
           IMODE1 = MYMOD.KMODEL(I)
           ICPEL.IMACHE(I) = IMODE1.IMAMOD
           ICPEL.CONCHE(I) = IMODE1.CONMOD
           ICPEL.INFCHE(I,6) = 1
        ENDDO
C
C------------------------------------------------------------
C
C       On récupère le nombre total d'éléments .
C       On vérifiera que le maillage et la matrice
C       portent sur le même nombre d'éléments .
        SEGACT MATR
        NNBEL1 = MATR.LFACT(/1)
        NBEL2  = NNBEL1 - 1
        PSUR = MATR.LFACT(NNBEL1)
        SEGACT PSUR
C
        SEGINI,ICHFAC=ICPEL
        NUMA = 0
C
        IF (ICOQ) SEGACT INFOEL
C       Pour les tests avenirs , on sait que FORTRAN évalue la partie
C       gauche d'une expression booléenne avant la partie droite ,
C       et donc :
C            dans le cas d'un .AND. si la partie gauche est fausse
C            la partie droite ne sera pas évaluée .
C ... La remarque ci-dessus s'est avérée fausse dans le cas de
C     certains compilateurs (DEC Alpha OSF ), d'où l'introduction des
C     variables logiques LTEST1, LTEST2  et LTEST3 qui permettent de se
C     passer de cette hypothèse (MB & LB 13/03/96) ...
 
C
C       -----------------------------------------------------
        DO NSMA=1,N1
C       On boucle sur les sous-champs
C
           ISSM = ICHFAC.IMACHE(NSMA)
           SEGACT ISSM
C          NBPTA = ISSM.NUM(/1)
           NBELA = ISSM.NUM(/2)
           N1EL   = NBELA
           N1PTEL = 1
           N2EL   = 0
           N2PTEL = 0
           SEGINI MELVA3
           N1EL   = 0
           N1PTEL = 0
           N2EL   = NBELA
           N2PTEL = 1
C
           LTEST1=.FALSE.
           IF(ICOQ) THEN
              IF(KCOQ(NSMA)) LTEST1=.TRUE.
           ENDIF
           IF (LTEST1) THEN
C
C             Cas des COQ pour la partie haute
              N2 = 3
              SEGINI ,MCHAM1
              ICHFAC.ICHAML(NSMA) = MCHAM1
              SEGINI ,MELVA1,MELVA2
              MCHAM1.NOMCHE(1) = 'SUPE'
              MCHAM1.TYPCHE(1) = 'POINTEURMCHAML'
              MCHAM1.IELVAL(1) = MELVA1
              MCHAM1.NOMCHE(2) = 'INFE'
              MCHAM1.TYPCHE(2) = 'POINTEURMCHAML'
              MCHAM1.IELVAL(2) = MELVA2
              MCHAM1.NOMCHE(3) = 'SURF'
              MCHAM1.TYPCHE(3) = 'REAL*8'
              MCHAM1.IELVAL(3) = MELVA3
 
C             ----------------------------------------------
              DO NELMA=1,NBELA
C             On boucle sur les éléments du sous-champs NSMA
C
C
                 NUMA = NUMA + 1
                 MELVA3.VELCHE(1,NELMA) = PSUR.FACT(NUMA)
                 PLIGI = MATR.LFACT(NUMA)
                 NUMA = NUMA + 1
                 MELVA3.VELCHE(1,NELMA) = PSUR.FACT(NUMA)
                 PLIGS = MATR.LFACT(NUMA)
                 SEGACT ,PLIGI,PLIGS
                 SEGINI ,MCHEL4=ICPEL
                 MELVA1.IELCHE(1,NELMA) = MCHEL4
                 SEGINI ,MCHEL5=ICPEL
                 MELVA2.IELCHE(1,NELMA) = MCHEL5
                 NUMB = 0
C
C                --------------------------------------------
                 DO NSMB=1,N1
C                On boucle sur les sous-champs
C
                    ISSM = ICHFAC.IMACHE(NSMB)
                    SEGACT ISSM
C                   NBPTB = ISSM.NUM(/1)
                    NBELB = ISSM.NUM(/2)
                    N1EL   = NBELB
                    N1PTEL = 1
                    N2EL   = 0
                    N2PTEL = 0
C
                    LTEST2 = .FALSE.
                    IF(ICOQ) THEN
                       IF(KCOQ(NSMB)) LTEST2 = .TRUE.
                    ENDIF
                    IF (LTEST2) THEN
C
C                       Cas des COQ pour la partie basse
                        N2 = 2
                        SEGINI ,MCHAM4,MCHAM5
                        MCHEL4.ICHAML(NSMB) = MCHAM4
                        MCHEL5.ICHAML(NSMB) = MCHAM5
C
                        SEGINI ,MELVA4,MELVA5
                        MCHAM4.NOMCHE(1) = 'SUPE'
                        MCHAM4.TYPCHE(1) = 'REAL*8'
                        MCHAM4.IELVAL(1) = MELVA4
                        MCHAM4.NOMCHE(2) = 'INFE'
                        MCHAM4.TYPCHE(2) = 'REAL*8'
                        MCHAM4.IELVAL(2) = MELVA5
 
                        SEGINI ,MELVA6,MELVA7
                        MCHAM5.NOMCHE(1) = 'SUPE'
                        MCHAM5.TYPCHE(1) = 'REAL*8'
                        MCHAM5.IELVAL(1) = MELVA6
                        MCHAM5.NOMCHE(2) = 'INFE'
                        MCHAM5.TYPCHE(2) = 'REAL*8'
                        MCHAM5.IELVAL(2) = MELVA7
C
C                       ---------------------------------------
                        DO NELMB=1,NBELB
C                       On boucle sur les éléments du sous-champs NSMB
C
C                          On copie la donnée facteur de forme
                           NUMB = NUMB + 1
C                          FF(eA+,eB+)
                           MELVA4.VELCHE(1,NELMB) = PLIGI.FACT(NUMB)
C                          FF(eA-,eB+)
                           MELVA6.VELCHE(1,NELMB) = PLIGS.FACT(NUMB)
                           NUMB = NUMB + 1
C                          FF(eA+,eB-)
                           MELVA5.VELCHE(1,NELMB) = PLIGI.FACT(NUMB)
C                          FF(eA-,eB-)
                           MELVA7.VELCHE(1,NELMB) = PLIGS.FACT(NUMB)
C
                        ENDDO
C                       fin NELMB ----------------------------
C
C
                    ELSE
C
C                       Partie basse : pas d'éléments COQ
                        N2 = 1
                        SEGINI MCHAM4,MCHAM5
                        MCHEL4.ICHAML(NSMB) = MCHAM4
                        MCHEL5.ICHAML(NSMB) = MCHAM5
                        SEGINI ,MELVA4,MELVA5
                        MCHAM4.NOMCHE(1) = 'MIDL'
                        MCHAM4.TYPCHE(1) = 'REAL*8'
                        MCHAM4.IELVAL(1) = MELVA4
                        MCHAM5.NOMCHE(1) = 'MIDL'
                        MCHAM5.TYPCHE(1) = 'REAL*8'
                        MCHAM5.IELVAL(1) = MELVA5
C
C                       ---------------------------------------
                        DO NELMB=1,NBELB
C                       On boucle sur les éléments du sous-champs NSMB
C
C                          On copie la donnée facteur de forme
                           NUMB = NUMB + 1
C                          FF(eA+,eB)
                           MELVA4.VELCHE(1,NELMB) = PLIGI.FACT(NUMB)
C                          FF(eA-,eB)
                           MELVA5.VELCHE(1,NELMB) = PLIGS.FACT(NUMB)
C
                        ENDDO
C                       fin NELMB -----------------------------
C
C
                    ENDIF
C
C
                 ENDDO
C                fin NSMB -------------------------------------
C
                 SEGDES ,PLIGI,PLIGS
C
              ENDDO
C             fin NELMA ---------------------------------------
C
C
           ELSE
C
C             Partie haute : pas d'éléments COQ
              SEGINI ,MELVA1
              N2 = 2
              SEGINI MCHAM1
              ICHFAC.ICHAML(NSMA) = MCHAM1
              MCHAM1.NOMCHE(1) = 'MIDL'
              MCHAM1.TYPCHE(1) = 'POINTEURMCHAML'
              MCHAM1.IELVAL(1) = MELVA1
              MCHAM1.NOMCHE(2) = 'SURF'
              MCHAM1.TYPCHE(2) = 'REAL*8'
              MCHAM1.IELVAL(2) = MELVA3
C
C             ----------------------------------------------
              DO NELMA=1,NBELA
C             On boucle sur les éléments du sous-champs NSMA
C
C
                 NUMA = NUMA + 1
                 MELVA3.VELCHE(1,NELMA) = PSUR.FACT(NUMA)
                 PLIG = MATR.LFACT(NUMA)
                 SEGACT PLIG
                 SEGINI ,MCHEL4=ICPEL
                 MELVA1.IELCHE(1,NELMA) = MCHEL4
                 NUMB = 0
C
C                --------------------------------------------
                 DO NSMB=1,N1
C                On boucle sur les sous-champs
C
                    ISSM = ICHFAC.IMACHE(NSMB)
                    SEGACT ISSM
C                   NBPTB = ISSM.NUM(/1)
                    NBELB = ISSM.NUM(/2)
                    N1EL   = NBELB
                    N1PTEL = 1
                    N2EL   = 0
                    N2PTEL = 0
C
                    LTEST3 = .FALSE.
                    IF(ICOQ) THEN
                       IF(KCOQ(NSMB)) LTEST3 = .TRUE.
                    ENDIF
                    IF (LTEST3) THEN
 
C
C                       Cas des COQ pour la partie basse
                        N2 = 2
                        SEGINI ,MCHAM4
                        MCHEL4.ICHAML(NSMB) = MCHAM4
                        SEGINI ,MELVA4,MELVA5
                        MCHAM4.NOMCHE(1) = 'SUPE'
                        MCHAM4.TYPCHE(1) = 'REAL*8'
                        MCHAM4.IELVAL(1) = MELVA4
                        MCHAM4.NOMCHE(2) = 'INFE'
                        MCHAM4.TYPCHE(2) = 'REAL*8'
                        MCHAM4.IELVAL(2) = MELVA5
C
C                       ---------------------------------------
                        DO NELMB=1,NBELB
C                       On boucle sur les éléments du sous-champs NSMB
C
C                          On copie la donnée facteur de forme
                           NUMB = NUMB + 1
C                          FF(eA,eB+)
                           MELVA4.VELCHE(1,NELMB) = PLIG.FACT(NUMB)
                           NUMB = NUMB + 1
C                          FF(eA,eB-)
                           MELVA5.VELCHE(1,NELMB) = PLIG.FACT(NUMB)
C
                        ENDDO
C                       fin NELMB -----------------------------
C
C
                    ELSE
C
C                       Partie basse : pas d'éléments COQ
                        N2 = 1
                        SEGINI MCHAM4
                        MCHEL4.ICHAML(NSMB) = MCHAM4
                        SEGINI ,MELVA4
                        MCHAM4.NOMCHE(1) = 'MIDL'
                        MCHAM4.TYPCHE(1) = 'REAL*8'
                        MCHAM4.IELVAL(1) = MELVA4
C
C                       ---------------------------------------
                        DO NELMB=1,NBELB
C                       On boucle sur les éléments du sous-champs NSMB
C
C                          On copie la donnée facteur de forme
                           NUMB = NUMB + 1
C                          FF(eA,eB)
                           MELVA4.VELCHE(1,NELMB) = PLIG.FACT(NUMB)
C
                        ENDDO
C                       fin NELMB -----------------------------
C
C
                    ENDIF
C
C
                 ENDDO
C                fin NSMB -------------------------------------
C
                 SEGDES ,PLIG
C
              ENDDO
C             fin NELMA ---------------------------------------
C
C
           ENDIF
C
        ENDDO
C       fin NSMA ----------------------------------------------
C
C
        SEGDES MATR , PSUR
        SEGSUP ICPEL
C
        IF (ICOQ) SEGDES INFOEL
C
        IF (NUMA.NE.NBEL2) THEN
           CALL ERREUR(21)
C          WRITE (6,*) 'Le maillage et la matrice portent sur un nombre'
C    #             ,' différent d éléments .'
        ENDIF
 
        END
 
 
 

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