Sources Esope | Cast3M

racmas
C RACMAS    SOURCE    CHAT      05/01/13    02:44:30     5004
      SUBROUTINE RACMAS(NBPGAU,IFOUR,NIFOUR,IDIM,NBNN,XE,CFPI,WORK,
     1     POIGAU,SHPTOT,REL,LRE)
C=======================================================================
C
C      CALCULE LA MATRICE MASSE DE L ELEMENT DE RACCORD
C       LIQUIDE MASSIF LINEAIRE   CAS BIDIMENSIONNEL
C      (INTEGRE LE PRODUIT XPI*U AVEC U DEPLACEMENT NORMAL A LA PAROI
C         DU SOLIDE)
C
C      ROUTINE FORTRAN PUR
C
C     JACQUELINE BROCHARD OCTOBRE 85
C=======================================================================
C      ENTREES
C         NBPGAU = NB DE PTS DE GAUSS
C         IFOUR  = IFOUR DE CCOPTIO
C         NBNN   = NB DE NOEUDS DE L ELEMENT DE RACCORD
C         XE(3,NBNN) = COORDONNEES LOCALES DE L ELEMENT
C         CFPI   = COEFFICIENT DE NORMALISATION SUR XPI
C         WORK(IDIM) = COMPOSANTES DE LA NORMALE SORTANTE AU FLUIDE
C         POIGAU(NBPGAU) = POIDS DE GAUSS
C         SHPTOT(6,NBNN,NBPGAU) = FONCTIONS DE FORME ET DERIVEES DE
C            L ELEMENT DE RACCORD
C      SORTIES
C         REL(LRE,LRE) = MATRICE DE MASSE
C=======================================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C    Include contenant quelques constantes dont XPI :
-INC CCREEL
      DIMENSION XE(3,1),WORK(IDIM),POIGAU(NBPGAU),SHPTOT(6,NBNN,1)
      DIMENSION REL(LRE,1)
      DATA EPSI/1.D-12/
C
C     BOUCLE SUR LES NOEUDS LIQUIDE ET INTEGRATION NUMERIQUE
C
      NBNNL=NBNN/2
      DO 100 NL=1,NBNNL
         DO 80 IGAU=1,NBPGAU
C
C     CALCUL DU RAYON ET DES COMPOSANTES DU VECTEUR NORMAL A LA PAROI
C
            R=XZERO
            ALFA=XZERO
            BETA=XZERO
            ID=NBNNL+1
            DO 20 J=ID,NBNN
               JJ=J-NBNNL
               R=R+XE(1,J)*SHPTOT(1,JJ,IGAU)
               ALFA=ALFA-SHPTOT(2,JJ,IGAU)*XE(2,J)
               BETA=BETA+SHPTOT(2,JJ,IGAU)*XE(1,J)
 20         CONTINUE
            IF(IFOUR.EQ.0.OR.(IFOUR.EQ.1.AND.NIFOUR.EQ.0)) THEN
               R=R*2*XPI
            ELSEIF(IFOUR.EQ.1.AND.NIFOUR.NE.0) THEN
               R=R*XPI
            ELSE
               R=1.D0
            ENDIF
C
C     ON COMPARE L ORIENTATION DE LA NORMALE SORTANTE AU FLUIDE
C       A CELLE DE LA PAROI
C
            PSCAL=ALFA*WORK(1)+BETA*WORK(2)
            IF (ABS(PSCAL).LT.EPSI) GOTO 777
            SENS=PSCAL/ABS(PSCAL)
C
C     ON REMPLIT LA MATRICE
C
            IF(IFOUR.LT.1) NCP=2
            IF(IFOUR.EQ.1) NCP=3
            DO 30 J=ID,NBNN
               JJ=J-NBNNL
               IL=2*NL
               IC1=2*NBNNL+(J-ID)*NCP+1
               IC2=IC1+1
               REL(IL,IC1)=REL(IL,IC1)-SENS*CFPI*SHPTOT(1,NL,IGAU)
     1              *POIGAU(IGAU)*R*ALFA*SHPTOT(1,JJ,IGAU)
               REL(IL,IC2)=REL(IL,IC2)-SENS*CFPI*SHPTOT(1,NL,IGAU)
     1              *POIGAU(IGAU)*R*BETA*SHPTOT(1,JJ,IGAU)
 30         CONTINUE
 80      CONTINUE
C
C     LE COUPLAGE LIQUIDE-MASSIF 2D LIE LES NOEUDS
C     (1,NBNN)  (2,NBNN-1) ETC , ON INVERSE DONC LES TERMES
C     DE LA MATRICE
C
         IL=2*NL
         DO 35 I=1,NCP
            IB=2*NBNNL+I
            ELT=REL(IL,IB)
            JB=2*NBNNL+(NBNNL-1)*NCP+I
            REL(IL,IB)=REL(IL,JB)
            REL(IL,JB)=ELT
 35      CONTINUE
C
C     SYMETRISATION
C
         DO 40 J=ID,NBNN
            IL=2*NL
            IC1=2*NBNNL+(J-ID)*NCP+1
            IC2=IC1+1
            REL(IC1,IL)=REL(IL,IC1)
            REL(IC2,IL)=REL(IL,IC2)
 40      CONTINUE
 100  CONTINUE
      GOTO 666
C
C     ERREUR    LE VECTEUR PERMETTANT D ORIENTER L ELEMENT DE RACCORD
C     EST NUL OU PARALLELE A LA FRONTIERE DU FLUIDE
C
 777  CALL ERREUR(246)
 666  CONTINUE
      RETURN
      END