Sources Esope | Cast3M

raye1
C RAYE1     SOURCE    CHAT      12/06/07    21:15:55     7389
        SUBROUTINE RAYE1(ICHFAC, INFOEL, MATR)
 
C **********************************************************
C ****  SUBROUTINE D'INTERFACAGE CHAMELEM --> MATRICE   ****
C ****  POUR LES FACTEURS DE FORME                      ****
C ****                                                  ****
C ****  En entree : ICHFAC matrice des facteurs de      ****
C ****                     de type CHAMELEM             ****
C ****              INFOEL segment qui contient la      ****
C ****              structure COQ ou QUAdratique de la  ****
C ****              zone étudiée                        ****
C ****                                                  ****
C ****  En sortie : MATR matrice des facteurs de forme  ****
C ****                   exploitable par le programme   ****
C ****                   de calcul RAYE3.ESO            ****
C ****                                                  ****
C **********************************************************
 
      IMPLICIT INTEGER(I-N)
        IMPLICIT REAL*8 (A-H,O-Z)
 
-INC SMCHAML
-INC SMELEME
 
-INC PPARAM
-INC CCOPTIO
 
C **********************************************************
C ****  Declaration de la structure des facteurs        ****
C ****  de forme                                        ****
C **********************************************************
 
        SEGMENT IFACFO
         INTEGER   LFACT(NBEL1)
        ENDSEGMENT
        SEGMENT LFAC
         REAL*8    FACT(NBEL2)
        ENDSEGMENT
 
        SEGMENT INFOEL
         LOGICAL KCOQ(N1), KQUAD(N1)
        ENDSEGMENT
 
C **********************************************************
C ****  Declaration des variables du probleme           ****
C **********************************************************
 
        POINTEUR PSUR.LFAC, PLIGI.LFAC, PLIGS.LFAC, PLIG.LFAC
        POINTEUR MATR.IFACFO
 
        POINTEUR ISSM.MELEME
        POINTEUR ICHFAC.MCHELM
        POINTEUR IMCHFA.MCHAML
        POINTEUR ISURF.MELVAL
 
C ****  Cas des elements COQ en haut                    ****
 
        POINTEUR IFFAS.MELVAL, IFFAI.MELVAL
        POINTEUR ISSCHI.MCHELM, ISSCHS.MCHELM
        POINTEUR ICHFBI.MCHAML, ICHFBS.MCHAML
 
C ****  Cas des elements COQ en haut et en bas          ****
 
        POINTEUR IFFBII.MELVAL, IFFBIS.MELVAL
        POINTEUR IFFBSI.MELVAL, IFFBSS.MELVAL
 
C ****  Cas des elements COQ en haut seulement          ****
 
        POINTEUR IFFBIM.MELVAL, IFFBSM.MELVAL
 
 
 
 
C ****  Pas d'elements COQ en haut                      ****
 
        POINTEUR IFFA.MELVAL
        POINTEUR ISSCH.MCHELM
        POINTEUR ICHFB.MCHAML
 
C ****  Cas des elements COQ en bas seulement           ****
 
        POINTEUR IFFBI.MELVAL, IFFBS.MELVAL
 
C ****  Cas ou il n'y a pas d'elements COQ              ****
 
        POINTEUR IFFB.MELVAL
 
C **********************************************************
C ****  Recherche de la position du pointeur donnant    ****
C ****  les surfaces des elements                       ****
C **********************************************************
 
        IF (IIMPI.GE.4) WRITE(6,*) 'DEBUT DE RAYE1.ESO'
 
        SEGACT ICHFAC
        NBS = ICHFAC.IMACHE(/1)
C ****  NBS designe le nombre de sous maillages de type ****
C ****  tri3, qua4 ...                                  ****
 
        SEGACT INFOEL
        NBEL = 0
        DO 10 I = 1, NBS
                ISSM = ICHFAC.IMACHE(I)
                SEGACT ISSM
                NBEL = NBEL + ISSM.NUM(/2)
                IF (KCOQ(I)) THEN
C ****          S'il y a des elements COQ, on rajoute   ****
C ****          une ligne.                              ****
                        NBEL = NBEL + ISSM.NUM(/2)
                ENDIF
 
                SEGDES ISSM
 10     CONTINUE
        SEGDES INFOEL
 
C ****  NBEL designe le nombre total d'elements sur la  ****
C ****  frontiere du maillage                           ****
 
        NBEL1 = NBEL + 1
C ****  On rajoute une dimension a la matrice MATR pour ****
C ****  stocker la ligne donnant la surface des elements****
C ****  On a donc une matrice de taille NBEL*(NBEL+1)   ****
 
        SEGINI MATR
 
C **********************************************************
C ****  Interface CHAMELEM --> MATRICE                  ****
C **********************************************************
 
C **********************************************************
C ****  PASSAGE DES VALEURS DES SURFACES                ****
C ****  On calcule d'abord la dimension du vecteur PSUR ****
C ****  Theoriquement, on doit trouver Nbel. Par        ****
C ****  precaution, on le verifie.                      ****
C **********************************************************
 
        SEGACT INFOEL
        NBEL2 = 0
 
        DO 20 NSMA = 1, NBS
                IMCHFA = ICHFAC.ICHAML(NSMA)
                meleme=ichfac.imache(NSMA)
                segact meleme
                nbela= num(/2)
                SEGACT IMCHFA
                IF (KCOQ(NSMA)) then
                  nbela=nbela*2
                  ISURF = IMCHFA.IELVAL(3)
 
                else
                  ISURF = IMCHFA.IELVAL(2)
                endif
                SEGDES IMCHFA
                nbel2=nbel2+nbela
   20   continue
C **********************************************************
C ****  Si on a des elements COQ                        ****
C **********************************************************
*                        SEGACT IMCHFA
*                        ISURF = IMCHFA.IELVAL(3)
*                       SEGDES IMCHFA
*
*                        SEGACT ISURF
*                        NBELA = ISURF.VELCHE(/2)
C Rajout du doublement des surfaces
*                        NBELA = NBELA + NBELA
*                        SEGDES ISURF
*
C               SI KCOQ(NSMA) = FALSE
*                ELSE
*
C **********************************************************
C ****  Si on n'a pas d'elements COQ                    ****
C **********************************************************
*
*                        SEGACT IMCHFA
*                        ISURF = IMCHFA.IELVAL(2)
*                       SEGDES IMCHFA
*
*                        SEGACT ISURF
*                        NBELA = ISURF.VELCHE(/2)
*                        SEGDES ISURF
*
*                ENDIF
*
*                NBEL2 = NBEL2 + NBELA
*
* 20     CONTINUE
        IF (IIMPI.GE.4.AND.NBEL.NE.NBEL2) THEN
                WRITE(6,*) 'Dimensions incompatibles'
        ENDIF
 
        SEGINI PSUR
 
        K = 0
 
C ****  Apres avoir verifie les dimensions, on passe    ****
C ****  les valeurs dans le vecteur PSUR.               ****
 
        DO 30 NSMA = 1, NBS
                IMCHFA = ICHFAC.ICHAML(NSMA)
                meleme= ICHFAC.imache(nsma)
 
                IF (KCOQ(NSMA)) THEN
 
C **********************************************************
C ****  Si on a des elements COQ                        ****
C **********************************************************
 
                SEGACT IMCHFA
                ISURF = IMCHFA.IELVAL(3)
                SEGDES IMCHFA
                SEGACT ISURF
                NBELA = ISURF.VELCHE(/2)
 
                DO 40 I = 1, Num(/2)
                        K = K + 1
                        ima= min ( i,nbela)
                        PSUR.FACT(K) = ISURF.VELCHE(1,Ima)
                        K = K + 1
                        ima= min ( i,nbela)
                        PSUR.FACT(K) = ISURF.VELCHE(1,Ima)
                        IF (IIMPI.GE.4) THEN
                          WRITE(6,*) 'SURF = ', ISURF.VELCHE(1,Ima)
                       ENDIF
 40             CONTINUE
                SEGDES ISURF
 
C               SI KCOQ(NSMA) = FALSE
                ELSE
 
C **********************************************************
C ****  Si on n'a pas d'elements COQ                    ****
C **********************************************************
 
                SEGACT IMCHFA
                ISURF = IMCHFA.IELVAL(2)
                SEGDES IMCHFA
 
                SEGACT ISURF
                NBELA = ISURF.VELCHE(/2)
                DO 45 I = 1, Num(/2)
                        K = K + 1
                        ima= min( i,nbela)
                        PSUR.FACT(K) = ISURF.VELCHE(1,Ima)
                        IF (IIMPI.GE.4) THEN
                          WRITE(6,*) 'SURF 2= ', ISURF.VELCHE(1,Ima)
                        ENDIF
 45             CONTINUE
                SEGDES ISURF
                ENDIF
 
 30     CONTINUE
 
C ****  Le vecteur PSUR est de dimension K et est place ****
C ****  en derniere ligne de MATR.                      ****
 
        IF (IIMPI.GE.4.AND.K.NE.NBEL2) THEN
                WRITE(6,*) 'K = ',K ,'NBEL2 = ', NBEL2
                WRITE(6,*) 'Ces deux nombres doivent etre egaux'
        ENDIF
 
        MATR.LFACT(NBEL1) = PSUR
 
        SEGDES PSUR
 
C **********************************************************
C ****  PASSAGE DES VALEURS DES FACTEURS DE FORME       ****
C **********************************************************
 
C **********************************************************
C ****  On se positionne d'abord dans un sous-domaine   ****
C **********************************************************
 
        I = 0
 
C ****  I designe l'indice de la ligne I de la matrice  ****
C ****  MATR.                                           ****
 
        DO 50 NSMA = 1, NBS
                IMCHFA = ICHFAC.ICHAML(NSMA)
 
                IF (IIMPI.GE.4) THEN
                   WRITE(6,*) 'DIM INFOEL =', INFOEL.KCOQ(/1)
                   WRITE(6,*) 'KCOQ = ', KCOQ(NSMA)
               ENDIF
 
                IF (KCOQ(NSMA)) THEN
 
C **********************************************************
C ****  Si on a des elements COQ dans la partie sup     ****
C **********************************************************
 
                SEGACT IMCHFA
                IFFAS = IMCHFA.IELVAL(1)
                IFFAI = IMCHFA.IELVAL(2)
                SEGDES IMCHFA
 
                SEGACT IFFAS, IFFAI
                NBELA = IFFAS.IELCHE(/2)
 
                IF (IIMPI.GE.4) THEN
                   WRITE(6,*) 'NBELA = ',NBELA
                ENDIF
 
C ****  NBELA designe le nombre d'elements du sous      ****
C ****  domaine d'indice NSMA.                          ****
 
C **********************************************************
C ****  Puis, on pointe sur les numeros des elements du ****
C ****  maillage                                        ****
C **********************************************************
 
                DO 60 NELMA = 1, NBELA
                        I = I + 1
                        ISSCHS = IFFAS.IELCHE(1,NELMA)
                        ISSCHI = IFFAI.IELCHE(1,NELMA)
 
                        SEGINI PLIGI, PLIGS
                        SEGACT ISSCHS
                        NBS2 = ISSCHS.ICHAML(/1)
 
                        SEGACT ISSCHI
                        NBS3 = ISSCHI.ICHAML(/1)
                        IF (NBS2.NE.NBS3) THEN
                                WRITE(6,*) 'Erreur de dimension'
                        ENDIF
 
                        J = 0
 
C ****  J designe l'indice de la colonne J de la        ****
C ****  matrice MATR.                                   ****
 
                        DO 70 NSMB = 1, NBS2
                                IF (KCOQ(NSMB)) THEN
 
C ****  S'il y a des elements COQ dans la partie inf    ****
 
                                ICHFBI = ISSCHI.ICHAML(NSMB)
                                ICHFBS = ISSCHS.ICHAML(NSMB)
 
                                SEGACT ICHFBI
                                IFFBII = ICHFBI.IELVAL(1)
                                IFFBIS = ICHFBI.IELVAL(2)
                                SEGDES ICHFBI
 
                                SEGACT ICHFBS
 
                                IFFBSI = ICHFBS.IELVAL(1)
                                IFFBSS = ICHFBS.IELVAL(2)
                                SEGDES ICHFBS
 
                                SEGACT IFFBII, IFFBIS
                                SEGACT IFFBSI, IFFBSS
                                NBELB = IFFBSI.VELCHE(/2)
C **********************************************************
C ****  Et enfin, on pointe sur une surface de ce       ****
C ****  deuxieme domaine.                               ****
C **********************************************************
 
                                DO 80 NELB = 1, NBELB
                                 J = J + 1
                                 PLIGI.FACT(J) = IFFBIS.VELCHE(1,NELB)
                                 PLIGS.FACT(J) = IFFBSS.VELCHE(1,NELB)
                                 J = J + 1
                                 PLIGI.FACT(J) = IFFBII.VELCHE(1,NELB)
                                 PLIGS.FACT(J) = IFFBSI.VELCHE(1,NELB)
 80                             CONTINUE
 
                                SEGDES IFFBII, IFFBIS
                                SEGDES IFFBSI, IFFBSS
 
C ****  On a boucle sur tous les elements du sous       ****
C ****  maillage d'indice NSMB.                         ****
 
 
C ****                          si KCOQ(NSMB) = FALSE   ****
 
                                ELSE
 
C ****  S'il n'y a pas d'elements COQ dans la partie inf****
 
                                ICHFBI = ISSCHI.ICHAML(NSMB)
                                ICHFBS = ISSCHS.ICHAML(NSMB)
 
                                SEGACT ICHFBI
                                IFFBIM = ICHFBI.IELVAL(1)
                                SEGDES ICHFBI
 
                                SEGACT ICHFBS
                                IFFBSM = ICHFBS.IELVAL(1)
                                SEGDES ICHFBS
 
 
                                SEGACT IFFBSM, IFFBIM
                                NBELB = IFFBSM.VELCHE(/2)
                                DO 90 NELB = 1, NBELB
                                 J = J + 1
                                 PLIGI.FACT(J) = IFFBIM.VELCHE(1,NELB)
                                 PLIGS.FACT(J) = IFFBSM.VELCHE(1,NELB)
 90                             CONTINUE
 
                                SEGDES IFFBIM, IFFBSM
 
                                ENDIF
 
 70                     CONTINUE
 
C ****  Test de verification                            ****
 
                        IF (IIMPI.GE.4) THEN
                         WRITE(6,*) 'Dimension du vecteur fforme =',J
                        ENDIF
 
C ****  On a boucle sur tous les sous maillages.        ****
 
                        SEGDES ISSCHS, ISSCHI
 
                        MATR.LFACT(I) = PLIGS
                        I = I + 1
                        MATR.LFACT(I) = PLIGI
 
                        SEGDES PLIGI, PLIGS
 
 60             CONTINUE
 
                SEGDES IFFAI, IFFAS
 
C ****          si KCOQ(NSMA) = FALSE                   ****
 
                ELSE
 
                IF (IIMPI.GE.4) THEN
                   WRITE(6,*) 'il n''y a pas d''elements COQ en haut'
                ENDIF
 
C **********************************************************
C ****  SI ON N'A PAS D'ELEMENTS COQ DANS LA PARTIE SUP ****
C **********************************************************
 
                SEGACT IMCHFA
                IFFA = IMCHFA.IELVAL(1)
                SEGDES IMCHFA
 
                SEGACT IFFA
                NBELA = IFFA.IELCHE(/2)
 
                IF (IIMPI.GE.4) THEN
                   WRITE(6,*) 'NBELA = ',NBELA
                ENDIF
 
C ****  NBELA designe le nombre d'elements du sous      ****
C ****  domaine d'indice NSMA.                          ****
 
C **********************************************************
C ****  Puis, on pointe sur les numeros des elements du ****
C ****  maillage                                        ****
C **********************************************************
 
                DO 160 NELMA = 1, NBELA
                        I = I + 1
                        ISSCH = IFFA.IELCHE(1,NELMA)
 
                        SEGINI PLIG
 
                        SEGACT ISSCH
                        J = 0
 
C ****  J designe l'indice de la colonne J de la        ****
C ****  matrice MATR.                                   ****
 
                        NBS2 = ISSCH.ICHAML(/1)
 
C ****  Theoriquement, NBS2 = NBS.                      ****
 
                        IF (IIMPI.GE.4.AND.NBS.NE.NBS2) THEN
                                WRITE(6,*) 'Probleme de dimension'
                        ENDIF
 
                        DO 170 NSMB = 1, NBS2
                                ICHFB = ISSCH.ICHAML(NSMB)
 
                                IF (KCOQ(NSMB)) THEN
 
C ****  S'il y a des elements COQ dans la partie inf    ****
 
                                SEGACT ICHFB
                                IFFBI = ICHFB.IELVAL(1)
                                IFFBS = ICHFB.IELVAL(2)
                                SEGDES ICHFB
 
                                SEGACT IFFBI
                                NBELB = IFFBI.VELCHE(/2)
                                SEGACT IFFBS
                                DO 180 NELB = 1, NBELB
                                 J = J + 1
                                 PLIG.FACT(J) = IFFBS.VELCHE(1,NELB)
                                 J = J + 1
                                 PLIG.FACT(J) = IFFBI.VELCHE(1,NELB)
 180                            CONTINUE
 
                                SEGDES IFFBI, IFFBS
 
C ****  On a boucle sur tous les elements du sous       ****
C ****  maillage d'indice NSMB.                         ****
 
C ****                          si KCOQ(NSMB) = FALSE   ****
 
                                ELSE
 
C ****  S'il n'y a pas d'elements COQ dans la partie inf****
 
                                SEGACT ICHFB
                                IFFB = ICHFB.IELVAL(1)
                                SEGDES ICHFB
 
                                SEGACT IFFB
                                NBELB = IFFB.VELCHE(/2)
                                DO 190 NELB = 1, NBELB
                                 J = J + 1
                                 PLIG.FACT(J) = IFFB.VELCHE(1,NELB)
 190                            CONTINUE
 
                                SEGDES IFFB
 
                                ENDIF
 
 170                    CONTINUE
 
C ****  Test de verification                            ****
 
                        IF (J.NE.NBEL2) THEN
                                WRITE(6,*) 'Erreur de dimension'
                        ENDIF
 
C ****  On a boucle sur tous les sous maillages.        ****
 
                        SEGDES ISSCH
                        MATR.LFACT(I) = PLIG
                        SEGDES PLIG
 
 160            CONTINUE
 
 
C ****  On a boucle sur tous les elements du sous       ****
C ****  maillage d'indice NSMA.                         ****
 
                SEGDES IFFA
                ENDIF
 
 50     CONTINUE
 
C ****  Test de verification                            ****
 
        IF (IIMPI.GE.4.AND.I.NE.NBEL2) THEN
                WRITE(6,*) 'Erreur de dimension'
        ENDIF
 
C ****  On a boucle sur tous les sous maillages.        ****
 
C **********************************************************
C ****  Desactivation des segments inutiles             ****
C **********************************************************
 
 
        SEGDES MATR, INFOEL
        SEGDES ICHFAC
 
        SEGDES IMCHFA
 
        IF (IIMPI.GE.4) WRITE(6,*) 'FIN DE RAYE1.ESO OK'
 
        RETURN
        END