Sources Esope | Cast3M

lic4ma
C LIC4MA    SOURCE    PV        18/06/20    21:15:06     9860           
      SUBROUTINE LIC4MA(NBPGAU,IDIM,NBNN,NDDL,XE,CFPI,WORK,POIGAU,
     1         QSIGAU,ETAGAU,SHPTOT,REL,LRE,IER246)
C=======================================================================
C
C      CALCULE LA MATRICE MASSE DE L ELEMENT DE RACCORD
C       LIQUIDE-COQUE 4 NOEUDS     CAS TRIDIMENSIONNEL
C      (INTEGRE LE PRODUIT PI*U AVEC U DEPLACEMENT NORMAL A LA PAROI
C         DU SOLIDE)
C
C      ROUTINE FORTRAN PUR
C
C     BERTRAND BEAUFILS AOUT 92  ( D'APRES ROUTINE LICOMA)
C=======================================================================
C      ENTREES
C         NBPGAU = NB DE PTS DE GAUSS
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 PI
C         WORK(IDIM) = COMPOSANTES DE LA NORMALE SORTANTE AU FLUIDE
C         POIGAU(NBPGAU) = POIDS DE GAUSS
C         QSIGAU(NBPGAU),ETAGAU(NBPGAU) = COORDONNEES DES PTS 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)
      DIMENSION XE(3,*),WORK(IDIM),POIGAU(NBPGAU),QSIGAU(NBPGAU)
      DIMENSION ETAGAU(NBPGAU),SHPTOT(6,NBNN,*),SHP(6,4)
      DIMENSION XEL(3,4),BPSS(3,3),VME(32,32)
      DIMENSION REL(LRE,*)
      DATA EPSI/1.D-12/
      DATA XZER/0.D0/
      IER246=0
C
C     MATRICE DE PASSAGE ET COORDONNEES LOCALES
C
      CALL CQ4LOC(XE,XEL,BPSS,NOQUAL,0)
C
C     MISE A 0 DE LA MATRICE DE MASSE
C
      CALL ZERO(VME,LRE,LRE)
C
C     ON COMPARE L ORIENTATION DE LA NORMALE SORTANTE AU FLUIDE
C       A CELLE DE LA PAROI
C
      NBNNL=NBNN/2
      ID=NBNNL+1
      VNQSI1=XZER
      VNQSI2=XZER
      VNQSI3=XZER
      VNETA1=XZER
      VNETA2=XZER
      VNETA3=XZER
      ALFA=XZER
      BETA=XZER
      GAMMA=XZER
      DO 20 J=ID,NBNN
      VNQSI1=VNQSI1+SHPTOT(2,J,1)*XE(1,J)
      VNQSI2=VNQSI2+SHPTOT(2,J,1)*XE(2,J)
      VNQSI3=VNQSI3+SHPTOT(2,J,1)*XE(3,J)
      VNETA1=VNETA1+SHPTOT(3,J,1)*XE(1,J)
      VNETA2=VNETA2+SHPTOT(3,J,1)*XE(2,J)
      VNETA3=VNETA3+SHPTOT(3,J,1)*XE(3,J)
 20   CONTINUE
      ALFA=VNQSI2*VNETA3-VNQSI3*VNETA2
      BETA=VNQSI3*VNETA1-VNQSI1*VNETA3
      GAMMA=VNQSI1*VNETA2-VNQSI2*VNETA1
      PSCAL=ALFA*WORK(1)+BETA*WORK(2)+GAMMA*WORK(3)
      IF (ABS(PSCAL).LT.EPSI) GOTO 777
      SENS=PSCAL/ABS(PSCAL)
C
C     CALCUL DES TERMES DE LA MATRICE : INTEGRATION NUMERIQUE
C       NL : NUMERO D UN NOEUD LIQUIDE
C       IGAU : NUMERO DU POINT DE GAUSS
C       J : NUMERO D UN NOEUD DE COQUE
C       K INDICE SUR LA COMPOSANTE W , RX , OU RY
C
        COEF2=SENS*CFPI
      DO 100 NL=1,NBNNL
        IL=2*NL
        DO 80 IGAU=1,NBPGAU
C
C      CALCUL DU JACOBIEN
C
         DO 250 NP=1,NBNNL
           SHP(1,NP)=SHPTOT(1,NP,IGAU)
           SHP(2,NP)=SHPTOT(2,NP,IGAU)
           SHP(3,NP)=SHPTOT(3,NP,IGAU)
 250     CONTINUE
         CALL JACOBI(XEL,SHP,2,NBNNL,DJAC)
C
C
          COEF1=COEF2*DJAC
           DO 200 NS=ID,NBNN
              IC1=(2*NBNNL)+((NS-ID)*NDDL)+3
              VME(IL,IC1)=VME(IL,IC1)-(COEF1*SHPTOT(1,NL,IGAU)
     1                        *POIGAU(IGAU)*SHPTOT(1,NS,IGAU))
 
 200       CONTINUE
 80     CONTINUE
C
C     CHANGEMENT DE REPERE ET SYMETRISATION
C
        DO 50 J=ID,NBNN
          INDM=2*NBNNL+(J-ID)*NDDL
          INDF=INDM+3
          DO 55 I=1,3
            DO 56 IP=1,3
              REL(IL,INDM+I)=REL(IL,INDM+I)+BPSS(IP,I)*VME(IL,INDM+IP)
              REL(IL,INDF+I)=REL(IL,INDF+I)+BPSS(IP,I)*VME(IL,INDF+IP)
  56        CONTINUE
  55      CONTINUE
          DO 40 K=1,6
            IC=INDM+K
            REL(IC,IL)=REL(IL,IC)
 40       CONTINUE
 50     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   IER246=246
666   CONTINUE
      RETURN
      END