Sources Esope | Cast3M

racoma
C RACOMA    SOURCE    CHAT      05/01/13    02:44:33     5004
      SUBROUTINE RACOMA(IFOUR,NIFOUR,IDIM,XE,CFPI,WORK,REL,LRE)
C=======================================================================
C
C      CALCULE LA MATRICE MASSE DE L ELEMENT DE RACCORD
C       LIQUIDE COQUE             CAS BIDIMENSIONNEL
C      (INTEGRE LE PRODUIT XPI*U AVEC U DEPLACEMENT NORMAL A LA COQUE)
C
C      ROUTINE FORTRAN PUR
C
C     JACQUELINE BROCHARD DECEMBRE 85
C=======================================================================
C      ENTREES
C         IFOUR  = IFOUR DE CCOPTIO
C         NIFOUR  = NIFOUR DE CCOPTIO
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      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,*),WORK(IDIM),REL(LRE,*)
      DATA EPSI/1.D-12/
C
C     CALCUL DES COMPOSANTES DU VECTEUR NORMAL A LA COQUE
C      ET COMPARAISON DE L ORIENTATION DE LA NORMALE SORTANTE AU FLUIDE
C      A CELLE DE LA COQUE
C
      ALFA=-(XE(2,4)-XE(2,3))
      BETA=XE(1,4)-XE(1,3)
      PSCAL=ALFA*WORK(1)+BETA*WORK(2)
      IF (ABS(PSCAL).LT.EPSI) GOTO 777
      SENS=PSCAL/ABS(PSCAL)
C     ----------   NORME
C ********** INCA SOMMME(COS**2)=1&lt; AQUAMODE SOMME(COS**2)=.5D0
      COEF=-SENS*CFPI
C     ----------   PRELIMINAIRES
      A=XE(1,1)+XE(1,2)
      B=XE(1,2)-XE(1,1)
      CP=XE(2,2)-XE(2,1)
      AL=SQRT(B*B+CP*CP)
      SP=B/AL
      CP=CP/AL
      AD=COEF*AL/120.D0
C   **** PLAN   *****
      IF( IFOUR.  GE.0)  GO TO 20
      A=2.D0
      B=0.D0
 20   CONTINUE
      IF(IFOUR.EQ.0.OR.(IFOUR.EQ.1.AND.
     +     NIFOUR.EQ.0))  THEN
         COEF=2*XPI
      ELSEIF(IFOUR.EQ.1.AND.NIFOUR.NE.0)  THEN
         COEF=XPI
      ELSE
         COEF=1.D0
      ENDIF
      A=A*AD*COEF
      B=B*AD*COEF
      ASP=A*SP
      BSP=B*SP
      ACP=A*CP
      BCP=B*CP
      AD=A*AL
      BD=B*AL
C     ----------   ON REMPLIT LA MATRICE
C     ----------   SEULS LES TERMES SUR XPI*UR XPI*UZ XPI*RT
C     ----------   NE SONT PAS NULS
      IF(IFOUR.LT.1) NCP=3
      IF(IFOUR.EQ.1) NCP=4
      IC1=4
      IC2=4+NCP
      REL(2,IC1+1)=21.D0*ACP-11.D0*BCP
      REL(2,IC1+2)=-21.D0*ASP+11.D0*BSP
      REL(2,IC1+NCP)=-3.D0*AD+BD
      REL(2,IC2+1)=9.D0*ACP+BCP
      REL(2,IC2+2)=-9.D0*ASP-BSP
      REL(2,IC2+NCP)=2.D0*AD
      REL(4,IC1+1)=9.D0*ACP-BCP
      REL(4,IC1+2)=-9.D0*ASP+BSP
      REL(4,IC1+NCP)=-REL(2,IC2+NCP)
      REL(4,IC2+1)=21.D0*ACP+11.D0*BCP
      REL(4,IC2+2)=-21.D0*ASP-11.D0*BSP
      REL(4,IC2+NCP)=3.D0*AD+BD
C
C     LE COUPLAGE LIQUIDE-COQUE LIENT LES NOEUDS 1-4 ET 2-3 ,
C     ON INVERSE DONC LES TERMES SUR LES NOEUDS 3 ET 4
C
      DO 1 IA=1,2
         JA=2*IA
         DO 11 IB=5,IC2
            ELT=REL(JA,IB)
            JB=IB+NCP
            REL(JA,IB)=REL(JA,JB)
            REL(JA,JB)=ELT
 11      CONTINUE
    1 CONTINUE
C     ----------   SYMETRISATION
      JB1=5
      JB2=4+2*NCP
      DO 40 IA=1,2
         JA=2*IA
         DO 41 JB=JB1,JB2
            REL(JB,JA)=REL(JA,JB)
 41      CONTINUE
 40   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