C FFMCHA SOURCE CB215821 20/11/04 21:17:22 10766 SUBROUTINE FFMCHA(MYMOD,INFOEL,MATR,ICHFAC,LTITR) C 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 C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C -INC PPARAM -INC CCOPTIO -INC SMCHAML -INC SMELEME -INC SMMODEL C 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 POINTEUR MYMOD.MMODEL POINTEUR ISSM.MELEME POINTEUR ICHFAC.MCHELM , ICPEL.MCHELM POINTEUR MELVA7.MELVAL 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 SEGACT MYMOD 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) SEGACT IMODE1 ICPEL.IMACHE(I) = IMODE1.IMAMOD ICPEL.CONCHE(I) = IMODE1.CONMOD ENDDO C 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